39 |
(defvar sc::cursors nil "List of known cursors")) |
(defvar sc::cursors nil "List of known cursors")) |
40 |
|
|
41 |
(defmacro defcursor (name x y string) |
(defmacro defcursor (name x y string) |
42 |
(if (not (memq name sc::cursors)) |
(if (not (memq name sc::cursors)) |
43 |
(setq sc::cursors (cons name sc::cursors))) |
(setq sc::cursors (cons name sc::cursors))) |
44 |
(list 'defconst name (list 'vector x y string))) |
(list 'defconst name (list 'vector x y string))) |
45 |
|
|
108 |
(delete-char -1) |
(delete-char -1) |
109 |
(insert char) |
(insert char) |
110 |
(sc::goto-hotspot)) |
(sc::goto-hotspot)) |
111 |
|
|
112 |
(defun sc::menu-function (window x y) |
(defun sc::menu-function (window x y) |
113 |
(sun-menu-evaluate window (1+ x) y sc::menu)) |
(sun-menu-evaluate window (1+ x) y sc::menu)) |
114 |
|
|
115 |
(defmenu sc::menu |
(defmenu sc::menu |
116 |
("Cursor Menu") |
("Cursor Menu") |
117 |
("Pack & Use" sc::pack-buffer-to-cursor) |
("Pack & Use" sc::pack-buffer-to-cursor) |
118 |
("Pack to Icon" sc::pack-buffer-to-icon |
("Pack to Icon" sc::pack-buffer-to-icon |
119 |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
120 |
("New Icon" call-interactively 'sc::make-cursor) |
("New Icon" call-interactively 'sc::make-cursor) |
121 |
("Edit Icon" sc:edit-cursor |
("Edit Icon" sc:edit-cursor |
122 |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
123 |
("Set Cursor" sc:set-cursor |
("Set Cursor" sc:set-cursor |
124 |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
125 |
("Reset Cursor" sc:set-cursor nil) |
("Reset Cursor" sc:set-cursor nil) |
126 |
("Help" sc::edit-icon-help-menu) |
("Help" sc::edit-icon-help-menu) |
127 |
("Quit" sc::quit-edit) |
("Quit" sc::quit-edit) |
153 |
|
|
154 |
(defun sc::menu-choose-cursor (window x y) |
(defun sc::menu-choose-cursor (window x y) |
155 |
"Presents a menu of cursor names, and returns one or nil" |
"Presents a menu of cursor names, and returns one or nil" |
156 |
(let ((curs sc::cursors) |
(let ((curs sc::cursors) |
157 |
(items)) |
(items)) |
158 |
(while curs |
(while curs |
159 |
(push (sc::menu-item-for-cursor (car curs)) items) |
(push (sc::menu-item-for-cursor (car curs)) items) |
200 |
(aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) |
(aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) |
201 |
(sc::goto-hotspot) |
(sc::goto-hotspot) |
202 |
) |
) |
203 |
|
|
204 |
(defun sc::pack-one-line (dummy) |
(defun sc::pack-one-line (dummy) |
205 |
(let* (char chr1 chr2) |
(let* (char chr1 chr2) |
206 |
(setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) |
(setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) |
212 |
(defun sc::pack-one-char (dummy) |
(defun sc::pack-one-char (dummy) |
213 |
"pack following char into char, unless eolp" |
"pack following char into char, unless eolp" |
214 |
(if (or (eolp) (char-equal (following-char) 32)) |
(if (or (eolp) (char-equal (following-char) 32)) |
215 |
(setq char (lsh char 1)) |
(setq char (lsh char 1)) |
216 |
(setq char (1+ (lsh char 1)))) |
(setq char (1+ (lsh char 1)))) |
217 |
(if (not (eolp))(forward-char))) |
(if (not (eolp))(forward-char))) |
218 |
|
|