comparison lisp/obsolete/sun-curs.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.

49597:e88404e8f2cf

(eval-and-compile
  (defvar sc::cursors nil "List of known cursors"))

(defmacro defcursor (name x y string)
  (if (not (memq name sc::cursors)) 
      (setq sc::cursors (cons name sc::cursors)))
  (list 'defconst name (list 'vector x y string)))

;;; push should be defined in common lisp, but if not use this:
;(defmacro push (v l)

  (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*))
  (move-to-column (1+ (min 15 (current-column))) t)
  (delete-char -1)
  (insert char)
  (sc::goto-hotspot))
    
(defun sc::menu-function (window x y)
  (sun-menu-evaluate window (1+ x) y sc::menu))

(defmenu sc::menu
  ("Cursor Menu")
  ("Pack & Use" sc::pack-buffer-to-cursor)
  ("Pack to Icon" sc::pack-buffer-to-icon 
		  (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
  ("New Icon" call-interactively 'sc::make-cursor)
  ("Edit Icon" sc:edit-cursor 
	       (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
  ("Set Cursor" sc:set-cursor
		(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) 
  ("Reset Cursor" sc:set-cursor nil)
  ("Help" sc::edit-icon-help-menu)
  ("Quit" sc::quit-edit)
  )

    (sc::pack-buffer-to-icon *edit-icon*)
    (sc:set-cursor *edit-icon*))

(defun sc::menu-choose-cursor (window x y)
  "Presents a menu of cursor names, and returns one or nil"
  (let ((curs sc::cursors) 
	(items))
    (while curs
      (push (sc::menu-item-for-cursor (car curs)) items)
      (setq curs (cdr curs)))
    (push (list "Choose Cursor") items)

  (aset icon 0 (aref *edit-icon* 0))
  (aset icon 1 (aref *edit-icon* 1))
  (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" ""))
  (sc::goto-hotspot)
  )
  
(defun sc::pack-one-line (dummy)
  (let* (char chr1 chr2)
    (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char)
    (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char)
    (forward-line 1)

    ))

(defun sc::pack-one-char (dummy)
  "pack following char into char, unless eolp"
  (if (or (eolp) (char-equal (following-char) 32))
      (setq char (lsh char 1)) 
    (setq char (1+ (lsh char 1))))
  (if (not (eolp))(forward-char)))

(provide 'sun-curs)

49598:0d8b17d428b5

(eval-and-compile
  (defvar sc::cursors nil "List of known cursors"))

(defmacro defcursor (name x y string)
  (if (not (memq name sc::cursors))
      (setq sc::cursors (cons name sc::cursors)))
  (list 'defconst name (list 'vector x y string)))

;;; push should be defined in common lisp, but if not use this:
;(defmacro push (v l)

  (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*))
  (move-to-column (1+ (min 15 (current-column))) t)
  (delete-char -1)
  (insert char)
  (sc::goto-hotspot))

(defun sc::menu-function (window x y)
  (sun-menu-evaluate window (1+ x) y sc::menu))

(defmenu sc::menu
  ("Cursor Menu")
  ("Pack & Use" sc::pack-buffer-to-cursor)
  ("Pack to Icon" sc::pack-buffer-to-icon
		  (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
  ("New Icon" call-interactively 'sc::make-cursor)
  ("Edit Icon" sc:edit-cursor
	       (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
  ("Set Cursor" sc:set-cursor
		(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
  ("Reset Cursor" sc:set-cursor nil)
  ("Help" sc::edit-icon-help-menu)
  ("Quit" sc::quit-edit)
  )

    (sc::pack-buffer-to-icon *edit-icon*)
    (sc:set-cursor *edit-icon*))

(defun sc::menu-choose-cursor (window x y)
  "Presents a menu of cursor names, and returns one or nil"
  (let ((curs sc::cursors)
	(items))
    (while curs
      (push (sc::menu-item-for-cursor (car curs)) items)
      (setq curs (cdr curs)))
    (push (list "Choose Cursor") items)

  (aset icon 0 (aref *edit-icon* 0))
  (aset icon 1 (aref *edit-icon* 1))
  (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" ""))
  (sc::goto-hotspot)
  )

(defun sc::pack-one-line (dummy)
  (let* (char chr1 chr2)
    (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char)
    (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char)
    (forward-line 1)

    ))

(defun sc::pack-one-char (dummy)
  "pack following char into char, unless eolp"
  (if (or (eolp) (char-equal (following-char) 32))
      (setq char (lsh char 1))
    (setq char (1+ (lsh char 1))))
  (if (not (eolp))(forward-char)))

(provide 'sun-curs)