(in-package :ccl)

#| ######################################################################

 Keyboard macros for FRED

Copyright © 1994-95 Michael Travers 

Permission is given to use and modify this code
as long as the copyright notice is preserved.

Send questions, comments, and fixes to mt@media.mit.edu.

-------------------------------------------------------------------------

Commands (based on Emacs)
c-x (:    start recording a keyboard macro
c-x ):    end a keyboard macro
c-x e:    play back the last recorded keyboard macro
c-x c-e:  display the macro in the listener
c-m-S:    search for the next occurance of the string defined by the region.

To do:  user indications, nested macros
        inserting option chars in a macro is broken (C-q M-8 should insert bullet, but
          on replay inserts 8)
        isearch echoing is slow in MCL3
        can't interrupt
        

History:
12/4/95 14:14  Added some support for saving and naming macros. Could use an interface.
               Added error handling (by advising ed-beep)
1/13/96 18:16  Made embolden work in MCL3

###################################################################### |#

(defvar *kbdmac-accumulator* nil)       
(defvar *current-kbdmac* nil)           ; the last one saved with C-x )
(defvar *running-kbdmac* nil)           ; the one running

(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 &optional (keystrokes *current-kbdmac*))
  (let ((ntimes (fred-prefix-numeric-value window) )
        (*running-kbdmac* keystrokes))
    (setf (fred-prefix-argument window) nil)
    (when (eq :beeped
              (catch 'beep 
                (dotimes (n ntimes)
                  (dolist (keystroke keystrokes)
                    (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)))))))
      (i-search-all-done window)
      (set-mini-buffer window "keyboard macro terminated by beeping"))))

(advise ed-beep (when *running-kbdmac* (throw 'beep :beeped)) 
        :when :after :name kbdmac)

(defun display-kbdmac (window)
  (declare (ignore window))
  (print (mapcar #'keystroke-name *current-kbdmac*) *top-listener*)
  (pprint `(defun cl-user::name-this-macro (window)
             (run-kbdmac window ',*current-kbdmac*))))

;;; Patched from lib;fred-additions.lisp -- original looked at event record rather than *current-keystroke*
#-CCL-3  
(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 won't
             (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")

;;; Search for the next occurance of the string in the region. This is a very
;;; useful command to use inside a macro.

(defmethod ed-search-for-next ((w fred-mixin) &aux (buf (fred-buffer w)))
  (multiple-value-bind (b e) (point-to-mark-range w)
    (unless (or (null e) (eq b e))
      (let ((string (buffer-substring buf b e))
            (end (max b e)))
        (frec-set-sel (frec w) end end)
        (window-search w string)))))

(comtab-set-key *comtab* '(:control :meta #\s) 'ed-search-for-next "Search for the next occurance of the string in the region")

;;; an example of a saved macro 

#-CCL-3   
(defun embolden (window)
  (run-kbdmac window '(627 40 100 101 102 27 870 614 544 2886 2882)))

#+CCL-3
(defun embolden (window) 
  (run-kbdmac window '(4211 13 40 100 101 102 27 2150 4198 4128 6685 6722 4197)))

(comtab-set-key *control-x-comtab* #\b 'embolden "Bold next definition name")