Mercurial > emacs
comparison lisp/obsolete/sun-curs.el @ 49598:0d8b17d428b5
Trailing whitepace deleted.
author | Juanma Barranquero <lekktu@gmail.com> |
---|---|
date | Tue, 04 Feb 2003 13:24:35 +0000 |
parents | 9a10bb9ac325 |
children | 695cf19ef79e d7ddb3e565de |
comparison
equal
deleted
inserted
replaced
49597:e88404e8f2cf | 49598:0d8b17d428b5 |
---|---|
37 | 37 |
38 (eval-and-compile | 38 (eval-and-compile |
39 (defvar sc::cursors nil "List of known cursors")) | 39 (defvar sc::cursors nil "List of known cursors")) |
40 | 40 |
41 (defmacro defcursor (name x y string) | 41 (defmacro defcursor (name x y string) |
42 (if (not (memq name sc::cursors)) | 42 (if (not (memq name sc::cursors)) |
43 (setq sc::cursors (cons name sc::cursors))) | 43 (setq sc::cursors (cons name sc::cursors))) |
44 (list 'defconst name (list 'vector x y string))) | 44 (list 'defconst name (list 'vector x y string))) |
45 | 45 |
46 ;;; push should be defined in common lisp, but if not use this: | 46 ;;; push should be defined in common lisp, but if not use this: |
47 ;(defmacro push (v l) | 47 ;(defmacro push (v l) |
106 (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*)) | 106 (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*)) |
107 (move-to-column (1+ (min 15 (current-column))) t) | 107 (move-to-column (1+ (min 15 (current-column))) t) |
108 (delete-char -1) | 108 (delete-char -1) |
109 (insert char) | 109 (insert char) |
110 (sc::goto-hotspot)) | 110 (sc::goto-hotspot)) |
111 | 111 |
112 (defun sc::menu-function (window x y) | 112 (defun sc::menu-function (window x y) |
113 (sun-menu-evaluate window (1+ x) y sc::menu)) | 113 (sun-menu-evaluate window (1+ x) y sc::menu)) |
114 | 114 |
115 (defmenu sc::menu | 115 (defmenu sc::menu |
116 ("Cursor Menu") | 116 ("Cursor Menu") |
117 ("Pack & Use" sc::pack-buffer-to-cursor) | 117 ("Pack & Use" sc::pack-buffer-to-cursor) |
118 ("Pack to Icon" sc::pack-buffer-to-icon | 118 ("Pack to Icon" sc::pack-buffer-to-icon |
119 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) | 119 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
120 ("New Icon" call-interactively 'sc::make-cursor) | 120 ("New Icon" call-interactively 'sc::make-cursor) |
121 ("Edit Icon" sc:edit-cursor | 121 ("Edit Icon" sc:edit-cursor |
122 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) | 122 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
123 ("Set Cursor" sc:set-cursor | 123 ("Set Cursor" sc:set-cursor |
124 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) | 124 (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) |
125 ("Reset Cursor" sc:set-cursor nil) | 125 ("Reset Cursor" sc:set-cursor nil) |
126 ("Help" sc::edit-icon-help-menu) | 126 ("Help" sc::edit-icon-help-menu) |
127 ("Quit" sc::quit-edit) | 127 ("Quit" sc::quit-edit) |
128 ) | 128 ) |
129 | 129 |
151 (sc::pack-buffer-to-icon *edit-icon*) | 151 (sc::pack-buffer-to-icon *edit-icon*) |
152 (sc:set-cursor *edit-icon*)) | 152 (sc:set-cursor *edit-icon*)) |
153 | 153 |
154 (defun sc::menu-choose-cursor (window x y) | 154 (defun sc::menu-choose-cursor (window x y) |
155 "Presents a menu of cursor names, and returns one or nil" | 155 "Presents a menu of cursor names, and returns one or nil" |
156 (let ((curs sc::cursors) | 156 (let ((curs sc::cursors) |
157 (items)) | 157 (items)) |
158 (while curs | 158 (while curs |
159 (push (sc::menu-item-for-cursor (car curs)) items) | 159 (push (sc::menu-item-for-cursor (car curs)) items) |
160 (setq curs (cdr curs))) | 160 (setq curs (cdr curs))) |
161 (push (list "Choose Cursor") items) | 161 (push (list "Choose Cursor") items) |
198 (aset icon 0 (aref *edit-icon* 0)) | 198 (aset icon 0 (aref *edit-icon* 0)) |
199 (aset icon 1 (aref *edit-icon* 1)) | 199 (aset icon 1 (aref *edit-icon* 1)) |
200 (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) | 200 (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" "")) |
201 (sc::goto-hotspot) | 201 (sc::goto-hotspot) |
202 ) | 202 ) |
203 | 203 |
204 (defun sc::pack-one-line (dummy) | 204 (defun sc::pack-one-line (dummy) |
205 (let* (char chr1 chr2) | 205 (let* (char chr1 chr2) |
206 (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) | 206 (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char) |
207 (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char) | 207 (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char) |
208 (forward-line 1) | 208 (forward-line 1) |
210 )) | 210 )) |
211 | 211 |
212 (defun sc::pack-one-char (dummy) | 212 (defun sc::pack-one-char (dummy) |
213 "pack following char into char, unless eolp" | 213 "pack following char into char, unless eolp" |
214 (if (or (eolp) (char-equal (following-char) 32)) | 214 (if (or (eolp) (char-equal (following-char) 32)) |
215 (setq char (lsh char 1)) | 215 (setq char (lsh char 1)) |
216 (setq char (1+ (lsh char 1)))) | 216 (setq char (1+ (lsh char 1)))) |
217 (if (not (eolp))(forward-char))) | 217 (if (not (eolp))(forward-char))) |
218 | 218 |
219 (provide 'sun-curs) | 219 (provide 'sun-curs) |
220 | 220 |