Re: Keyboard macros?

[Michael Travers <mt@media.mit.edu>]

I've written a rather simple keyboard macro facility which will run in
MCL 2.0 final (and probably earlier versions).  It's short enough to
include here, and will also be in the CD-ROM library.  It doesn't
support naming macros or editing them, but that wouldn't be hard to
add.

-----  kbd-macros.lisp
(in-package :ccl)
;;; Keyboard Macros
;;; Michael Travers (mt@media.mit.edu)

#|
Commands (after EMACS)
c-x (:  start a keyboard macro
c-x ):  end a keyboard macro
c-x e:  play back a keyboard macro
c-x c-e:  display the macro in the listener

 Todo:  error handling (should terminate execution),
        user indications, nested macros, named macros
|#

(defvar *kbdmac-accumulator* nil)
(defvar *current-kbdmac* nil)

(defun start-kbdmac (window) 
  (declare (ignore window))
  (setq *kbdmac-accumulator* (list :start)))

(advise run-fred-command 
        (when *kbdmac-accumulator*
          (push *current-keystroke* *kbdmac-accumulator*))
        :when :after :name kbdmac-recorder)

(defun end-kbdmac (window)
  (declare (ignore window))
  ;; Trims off various crapola
  (setq *current-kbdmac* (cddr (nreverse (cdr *kbdmac-accumulator*)))
        *kbdmac-accumulator* nil))

(defun run-kbdmac (window)
  (let ((ntimes (fred-prefix-numeric-value window) ))
    (setf (fred-prefix-argument window) nil)
    (dotimes (n ntimes)
      (dolist (keystroke *current-kbdmac*)
        (let* ((*current-keystroke* keystroke)
               (keystroke-name (keystroke-name keystroke))
               (*current-character* (if (listp keystroke-name) 
                                      (car (last keystroke-name))
                                      keystroke-name))
               (*last-command* nil))   ; probably wrong
          (run-fred-command window (keystroke-function window keystroke)))))))

(defun display-kbdmac (window)
  (declare (ignore window))
  (print (mapcar #'keystroke-name *current-kbdmac*) *top-listener*))

;;; Patched from lib;fred-additions.lisp -- original looked at event record rather than *current-keystroke*
(defun i-search-do-keystroke (w)
  (declare (special *default-command-p*))
  (let* ((key-code *current-keystroke*)
         (key-name (keystroke-name key-code)))
    (if (and (or (%i> key-code 32)
                 (eq key-code (char-code #\return))
                 (eq key-code (char-code #\tab))
                 (eq key-code (char-code #\space)))
             (neq key-name #\rubout)
             (characterp key-name))
           (i-search-add-char w key-name)
           (progn
             (ed-push-mark w (car *i-search-original-pos*))
             (remove-shadowing-comtab w)
             ;(collapse-selection w t) ; I like this but Mac weenies probably wont
             (run-fred-command w (keystroke-function w key-code))
             (setq *default-command-p* t)
             (i-search-all-done w)))))

(comtab-set-key *control-x-comtab* #\( 'start-kbdmac "Start a keyboard macro")
(comtab-set-key *control-x-comtab* #\) 'end-kbdmac "End the current keyboard macro")
(comtab-set-key *control-x-comtab* #\e 'run-kbdmac "Run the current keyboard macro")
(comtab-set-key *control-x-comtab* '(:control #\e) 'display-kbdmac "Display the current keyboard macro")