home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / functions / undo-with-space.el < prev    next >
Encoding:
Text File  |  1991-03-20  |  1.8 KB  |  52 lines
  1. ; From: narten@cs.albany.edu (Thomas Narten)
  2. ; Subject: Undo-with-space
  3. ; Date: 18 Oct 90 02:06:11 GMT
  4. ; Organization: Computer Science Department, SUNY at Albany, Albany, NY 12222
  5. ; 
  6. ; All this chatter about undo prompts me to post the following undo
  7. ; code.  I find it much more convenient for undoing things than the
  8. ; standard undo. When invoked, just keep in hitting space until you've
  9. ; gone back as far as you want.  One of those things from gosmacs that
  10. ; caused enormous withdrawal pains. :-)
  11. ; 
  12. (defun undo-with-space ()
  13.   (interactive)
  14.   (undo-start)
  15.   (undo-more 2)
  16.   (message "Hit <space> to undo more")
  17.   (let ((char (read-char)))
  18.     (while (= char 32)
  19.       (message "undoing..")
  20.       (undo-more 1)
  21.       (message "Hit <space> to undo more")
  22.       (setq char (read-char)))
  23.     (message "Finished undoing")
  24.     (if (not (= char search-exit-char))    ; make exit character the same as isearch
  25.     (undo-with-space-execute-key-binding char)))
  26. )
  27.  
  28. (defun undo-with-space-execute-key-binding (ch) "execute command associated with keystroke"
  29.     (interactive "cWhat Key? ")        ; only asks question if interactive
  30.     (setq str (char-to-string ch))
  31.     (cond
  32.         ((equal ch 24)            ; ^X prefix
  33.         (progn
  34.             (message "C-x-")
  35.         (setq str (concat str (char-to-string (read-char))))))
  36.         ((equal ch 3)            ; ^C prefix
  37.         (progn
  38.             (message "C-c-")
  39.         (setq str (concat str (char-to-string (read-char))))))
  40.         ((equal ch 27)            ; ESC prefix
  41.         (progn
  42.             (message "ESC-")
  43.         (setq str (concat str (char-to-string (read-char))))))
  44.     )
  45.     (setq cmd (key-binding str))
  46.     ;(print (symbol-name cmd))          ; for debugging
  47.     (if (equal (symbol-name cmd) "self-insert-command")
  48.         (insert-char ch 1)        ; doesn't work right otherwise
  49.         (command-execute (symbol-function cmd) t) ; put cmd in command-history
  50.     )
  51. )
  52.