/[emacs]/emacs/lisp/obsolete/sun-curs.el
ViewVC logotype

Diff of /emacs/lisp/obsolete/sun-curs.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by gerd, Thu Aug 30 07:31:09 2001 UTC revision 1.1.8.1 by miles, Fri Apr 4 06:20:31 2003 UTC
# Line 39  Line 39 
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    
# Line 108  Otherwise, ICON should be a vector or th Line 108  Otherwise, ICON should be a vector or th
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)
# Line 153  Otherwise, ICON should be a vector or th Line 153  Otherwise, ICON should be a vector or th
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)
# Line 200  Otherwise, ICON should be a vector or th Line 200  Otherwise, ICON should be a vector or th
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)
# Line 212  Otherwise, ICON should be a vector or th Line 212  Otherwise, ICON should be a vector or th
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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.8.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26