;;; Keyboard macro ring
+(fcr-defstruct kmacro
+ "Keyboard macro."
+ keys (counter :mutable t) format)
+
(defvar kmacro-ring nil
"The keyboard macro ring.
-Each element is a list (MACRO COUNTER FORMAT). Actually, the head of
+Each element is a `kmacro'. Actually, the head of
the macro ring (when defining or executing) is not stored in the ring;
instead it is available in the variables `last-kbd-macro', `kmacro-counter',
and `kmacro-counter-format'.")
(defun kmacro-ring-head ()
"Return pseudo head element in macro ring."
(and last-kbd-macro
- (list last-kbd-macro kmacro-counter kmacro-counter-format-start)))
+ (kmacro last-kbd-macro kmacro-counter kmacro-counter-format-start)))
(defun kmacro-push-ring (&optional elt)
"Push ELT or current macro onto `kmacro-ring'."
(when (setq elt (or elt (kmacro-ring-head)))
+ (when (consp elt)
+ (message "Converting obsolete list form of kmacro: %S" elt)
+ (setq elt (apply #'kmacro elt)))
(let ((history-delete-duplicates nil))
(add-to-history 'kmacro-ring elt kmacro-ring-max))))
(defun kmacro-split-ring-element (elt)
- (setq last-kbd-macro (car elt)
- kmacro-counter (nth 1 elt)
- kmacro-counter-format-start (nth 2 elt)))
+ (setq last-kbd-macro (kmacro--keys elt)
+ kmacro-counter (kmacro--counter elt)
+ kmacro-counter-format-start (kmacro--format elt)))
(defun kmacro-pop-ring1 (&optional raw)
;;;###autoload
-(defun kmacro-exec-ring-item (item arg)
+(define-obsolete-function-alias 'kmacro-exec-ring-item #'funcall "29.1"
"Execute item ITEM from the macro ring.
-ARG is the number of times to execute the item."
- ;; Use counter and format specific to the macro on the ring!
- (let ((kmacro-counter (nth 1 item))
- (kmacro-counter-format-start (nth 2 item)))
- (execute-kbd-macro (car item) arg #'kmacro-loop-setup-function)
- (setcar (cdr item) kmacro-counter)))
+ARG is the number of times to execute the item.")
(defun kmacro-call-ring-2nd (arg)
"Execute second keyboard macro in macro ring."
(interactive "P")
(unless (kmacro-ring-empty-p)
- (kmacro-exec-ring-item (car kmacro-ring) arg)))
+ (funcall (car kmacro-ring) arg)))
(defun kmacro-call-ring-2nd-repeat (arg)
"Display the second macro in the keyboard macro ring."
(interactive)
(unless (kmacro-ring-empty-p)
- (kmacro-display (car (car kmacro-ring)) nil "2nd macro")))
+ (kmacro-display (kmacro--keys (car kmacro-ring)) nil "2nd macro")))
(defun kmacro-cycle-ring-next (&optional _arg)
(let ((append (and arg (listp arg))))
(unless append
(if last-kbd-macro
- (kmacro-push-ring
- (list last-kbd-macro kmacro-counter kmacro-counter-format-start)))
+ (kmacro-push-ring))
(setq kmacro-counter (or (if arg (prefix-numeric-value arg))
kmacro-initial-counter-value
0)
(if kmacro-call-repeat-key
(kmacro-call-macro arg no-repeat t)
(kmacro-end-macro arg)))
- ((and (eq this-command 'kmacro-view-macro) ;; We are in repeat mode!
+ ((and (eq this-command #'kmacro-view-macro) ;; We are in repeat mode!
kmacro-view-last-item)
- (kmacro-exec-ring-item (car kmacro-view-last-item) arg))
+ (funcall (car kmacro-view-last-item) arg))
((and arg (listp arg))
(kmacro-call-ring-2nd 1))
(t
;; letters and digits, provided that we inhibit the keymap while
;; executing the macro later on (but that's controversial...)
-(fcr-defstruct kmacro-function
- "Function form of keyboard macros."
- mac)
+;;;###autoload
+(defun kmacro (keys &optional counter format)
+ "Create a `kmacro' for macro bound to symbol or key."
+ (fcr-lambda (kmacro (keys (if (stringp keys) (key-parse keys) keys))
+ (counter (or counter 0))
+ (format (or format "%d")))
+ (&optional arg)
+ (interactive "p")
+ ;; Use counter and format specific to the macro on the ring!
+ (let ((kmacro-counter counter)
+ (kmacro-counter-format-start format))
+ (execute-kbd-macro keys arg #'kmacro-loop-setup-function)
+ (setq counter kmacro-counter))))
;;;###autoload
(defun kmacro-lambda-form (mac &optional counter format)
- "Create lambda form for macro bound to symbol or key."
;; Apparently, there are two different ways this is called:
;; either `counter' and `format' are both provided and `mac' is a vector,
;; or only `mac' is provided, as a list (MAC COUNTER FORMAT).
;; The first is used from `insert-kbd-macro' and `edmacro-finish-edit',
;; while the second is used from within this file.
- (fcr-lambda (kmacro-function (mac (if counter (list mac counter format) mac)))
- (&optional arg)
- (interactive "p")
- (kmacro-exec-ring-item mac arg)))
+ (declare (obsolete kmacro "29.1"))
+ (cond
+ ((kmacro-p mac) mac)
+ ((and (null counter) (consp mac)) (apply #'kmacro mac))
+ (t (kmacro mac counter format))))
(defun kmacro-extract-lambda (mac)
"Extract kmacro from a kmacro lambda form."
+ (declare (obsolete nil "29.1"))
(when (kmacro-p mac)
- (let ((mac (kmacro-function--mac mac)))
- (and (consp mac)
- (= (length mac) 3)
- (arrayp (car mac))
- mac))))
+ (list (kmacro--keys mac)
+ (kmacro--counter mac)
+ (kmacro--format mac))))
(defun kmacro-p (x)
"Return non-nil if MAC is a kmacro keyboard macro."
- (cl-typep x 'kmacro-function))
+ (cl-typep x 'kmacro))
-(cl-defmethod cl-print-object ((object kmacro-function) stream)
+(cl-defmethod cl-print-object ((object kmacro) stream)
(princ "#f(kmacro " stream)
(require 'macros)
(declare-function macros--insert-vector-macro "macros" (definition))
- (pcase-let ((`(,vecdef ,counter ,format)
- (kmacro-extract-lambda object)))
- (princ
- (with-temp-buffer
- (macros--insert-vector-macro vecdef)
- (buffer-string))
- stream)
- (princ " " stream)
- (prin1 counter stream)
- (princ " " stream)
- (prin1 format stream)
+ (let ((vecdef (kmacro--keys object))
+ (counter (kmacro--counter object))
+ (format (kmacro--format object)))
+ (prin1 (key-description vecdef) stream)
+ (unless (and (equal counter 0) (equal format "%d"))
+ (princ " " stream)
+ (prin1 counter stream)
+ (princ " " stream)
+ (prin1 format stream))
(princ ")" stream)))
(defun kmacro-bind-to-key (_arg)
(yes-or-no-p (format "%s runs command %S. Bind anyway? "
(format-kbd-macro key-seq)
cmd))))
- (define-key global-map key-seq
- (kmacro-lambda-form (kmacro-ring-head)))
+ (define-key global-map key-seq (kmacro-ring-head))
(message "Keyboard macro bound to %s" (format-kbd-macro key-seq))))))
(defun kmacro-keyboard-macro-p (symbol)
"Return non-nil if SYMBOL is the name of some sort of keyboard macro."
(let ((f (symbol-function symbol)))
(when f
- (or (stringp f)
- (vectorp f)
+ (or (stringp f) ;FIXME: Really deprecated.
+ (vectorp f) ;FIXME: Deprecated.
(kmacro-p f)))))
(defun kmacro-name-last-macro (symbol)
symbol))
(if (string-equal symbol "")
(error "No command name given"))
- ;; FIXME: Use plain old `last-kbd-macro' for kmacros where it doesn't
- ;; make a difference?
- (fset symbol (kmacro-lambda-form (kmacro-ring-head)))
+ (fset symbol (kmacro-ring-head))
;; This used to be used to detect when a symbol corresponds to a kmacro.
;; Nowadays it's unused because we used `kmacro-p' instead to see if the
;; symbol's function definition matches that of a kmacro, which is more
(interactive)
(cond
((or (kmacro-ring-empty-p)
- (not (eq last-command 'kmacro-view-macro)))
+ (not (eq last-command #'kmacro-view-macro)))
(setq kmacro-view-last-item nil))
((null kmacro-view-last-item)
(setq kmacro-view-last-item kmacro-ring
kmacro-view-item-no (1+ kmacro-view-item-no)))
(t
(setq kmacro-view-last-item nil)))
- (setq this-command 'kmacro-view-macro
+ (setq this-command #'kmacro-view-macro
last-command this-command) ;; in case we repeat
(kmacro-display (if kmacro-view-last-item
- (car (car kmacro-view-last-item))
+ (kmacro--keys (car kmacro-view-last-item))
last-kbd-macro)
nil
(if kmacro-view-last-item
;; Handle commands which reads additional input using read-char.
(cond
- ((and (eq this-command 'quoted-insert)
+ ((and (eq this-command #'quoted-insert)
(not (eq kmacro-step-edit-action t)))
;; Find the actual end of this key sequence.
;; Must be able to backtrack in case we actually execute it.
(cond
((eq kmacro-step-edit-action t) ;; Reentry for actual command @ end of prefix arg.
(cond
- ((eq this-command 'quoted-insert)
+ ((eq this-command #'quoted-insert)
(clear-this-command-keys) ;; recent-keys actually
(let (unread-command-events)
(quoted-insert (prefix-numeric-value current-prefix-arg))
((eq act 'skip)
nil)
((eq act 'skip-keep)
- (setq this-command 'ignore)
+ (setq this-command #'ignore)
t)
((eq act 'skip-rest)
(setq kmacro-step-edit-active 'ignore)
(if restore-index
(setq executing-kbd-macro-index restore-index)))
(t
- (setq this-command 'ignore)))
+ (setq this-command #'ignore)))
(setq kmacro-step-edit-key-index next-index)))
(defun kmacro-step-edit-insert ()
(setq next-index kmacro-step-edit-key-index)
t)
(t nil))
- (setq this-command 'ignore)
+ (setq this-command #'ignore)
(setq this-command cmd)
(if (memq this-command '(self-insert-command digit-argument))
(setq last-command-event (aref keys (1- (length keys)))))
(when kmacro-step-edit-active
(cond
((eq kmacro-step-edit-active 'ignore)
- (setq this-command 'ignore))
+ (setq this-command #'ignore))
((eq kmacro-step-edit-active 'append-end)
(if (= executing-kbd-macro-index (length executing-kbd-macro))
(setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
" ")
?\]))
+(defun macro--string-to-vector (str)
+ "Convert an old-style string key sequence to the vector form."
+ (let ((vec (string-to-vector str)))
+ (unless (multibyte-string-p str)
+ (dotimes (i (length vec))
+ (let ((k (aref vec i)))
+ (when (> k 127)
+ (setf (aref vec i) (+ k ?\M-\C-@ -128))))))
+ vec))
+
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
"Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
(insert "(fset '"))
(prin1 macroname (current-buffer))
(insert "\n ")
- (if (stringp definition)
- (let ((beg (point)) end)
- (prin1 definition (current-buffer))
- (setq end (point-marker))
- (goto-char beg)
- (while (< (point) end)
- (let ((char (following-char)))
- (cond ((= char 0)
- (delete-region (point) (1+ (point)))
- (insert "\\C-@"))
- ((< char 27)
- (delete-region (point) (1+ (point)))
- (insert "\\C-" (+ 96 char)))
- ((= char ?\C-\\)
- (delete-region (point) (1+ (point)))
- (insert "\\C-\\\\"))
- ((< char 32)
- (delete-region (point) (1+ (point)))
- (insert "\\C-" (+ 64 char)))
- ((< char 127)
- (forward-char 1))
- ((= char 127)
- (delete-region (point) (1+ (point)))
- (insert "\\C-?"))
- ((= char 128)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-@"))
- ((= char (aref "\M-\C-\\" 0))
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-\\\\"))
- ((< char 155)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-" (- char 32)))
- ((< char 160)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-" (- char 64)))
- ((= char (aref "\M-\\" 0))
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\\\"))
- ((< char 255)
- (delete-region (point) (1+ (point)))
- (insert "\\M-" (- char 128)))
- ((= char 255)
- (delete-region (point) (1+ (point)))
- (insert "\\M-\\C-?"))))))
- (if (vectorp definition)
- (macros--insert-vector-macro definition)
- (pcase (kmacro-extract-lambda definition)
- (`(,vecdef ,counter ,format)
- (insert "(kmacro-lambda-form ")
- (macros--insert-vector-macro vecdef)
- (insert " ")
- (prin1 counter (current-buffer))
- (insert " ")
- (prin1 format (current-buffer))
- (insert ")"))
- (_ (prin1 definition (current-buffer))))))
+ (when (stringp definition)
+ (setq definition (macro--string-to-vector definition)))
+ (if (vectorp definition)
+ (setq definition (kmacro definition)))
+ (if (kmacro-p definition)
+ (let ((vecdef (kmacro--keys definition))
+ (counter (kmacro--counter definition))
+ (format (kmacro--format definition)))
+ (insert "(kmacro ")
+ (prin1 (key-description vecdef) (current-buffer))
+ ;; FIXME: Do we really want to store the counter?
+ (unless (and (equal counter 0) (equal format "%d"))
+ (insert " ")
+ (prin1 counter (current-buffer))
+ (insert " ")
+ (prin1 format (current-buffer)))
+ (insert ")"))
+ ;; FIXME: Shouldn't this signal an error?
+ (prin1 definition (current-buffer)))
(insert ")\n")
(if keys
(let ((keys (or (where-is-internal (symbol-function macroname)