From a69d03779c7736db1c7d78fd62a1c1aa01a9dc8b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 28 Dec 2021 12:03:44 -0500 Subject: [PATCH] kmacro.el: Unify the lambda and the list representations Kmacros used to be represented as a triplet (MAC COUNTER FORMAT), and then wrapped into a lambda to turn them into commands. Replace the triplet with an FCR so it's directly executable. Take advantage of the change to promote the key-description format where applicable. * lisp/kmacro.el (kmacro): New FCR type, to replace both `kmacro-function` and the (MAC COUNTER FORMAT) representation of kmacros. (kmacro-p): Adjust. (kmacro-ring-head): Use `kmacro` constructor. (kmacro-push-ring): Add backward compatibility code for old list representation. (kmacro-view-ring-2nd, kmacro-start-macro, kmacro-view-macro): (kmacro-split-ring-element): Adjust to new representation. (kmacro-exec-ring-item): Redefine as obsolete alias. (kmacro-call-ring-2nd, kmacro-end-or-call-macro): Simplify accordingly. (kmacro-function): Delete FCR type. (kmacro): Rename from `kmacro-lambda-form` and streamline calling convention. Use `execute-kbd-macro` rather than `kmacro-exec-ring-item`. (kmacro-lambda-form, kmacro-extract-lambda): Rewrite and mark as obsolete. (cl-print-object): Use the key-description format and skip the counter and format parts if they're trivial. (kmacro-bind-to-key, kmacro-name-last-macro): Simplify. * test/lisp/kmacro-tests.el (kmacro-tests-kmacro-bind-to-single-key): Suppress obsoletion warning. (kmacro-tests-name-last-macro-bind-and-rebind): Tighten the check a tiny bit. (kmacro-tests--cl-print): Adjust to the new key-description output. * lisp/macros.el (macro--string-to-vector): New function. (insert-kbd-macro): Use it, and change the generated code to use `kmacro` and the key-description format. * lisp/edmacro.el (edit-kbd-macro): Adjust to new representation. (edmacro-finish-edit): Use `kmacro` constructor. --- lisp/edmacro.el | 22 +++---- lisp/emacs-lisp/fcr.el | 5 +- lisp/kmacro.el | 125 ++++++++++++++++++++------------------ lisp/macros.el | 86 +++++++++----------------- test/lisp/kmacro-tests.el | 16 +++-- 5 files changed, 117 insertions(+), 137 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index be92cd03fb4..78faf46e307 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -99,8 +99,7 @@ With a prefix argument, format the macro in a more concise way." (when keys (let ((cmd (if (arrayp keys) (key-binding keys) keys)) (cmd-noremap (when (arrayp keys) (key-binding keys nil t))) - (mac nil) (mac-counter nil) (mac-format nil) - kmacro) + (mac nil) (mac-counter nil) (mac-format nil)) (cond (store-hook (setq mac keys) (setq cmd nil)) @@ -131,10 +130,10 @@ With a prefix argument, format the macro in a more concise way." (t (setq mac cmd) (setq cmd nil))) - (when (setq kmacro (kmacro-extract-lambda mac)) - (setq mac (car kmacro) - mac-counter (nth 1 kmacro) - mac-format (nth 2 kmacro))) + (when (kmacro-p mac) + (setq mac (kmacro--keys mac) + mac-counter (kmacro--counter mac) + mac-format (kmacro--format mac))) (unless (arrayp mac) (error "Key sequence %s is not a keyboard macro" (key-description keys))) @@ -313,10 +312,7 @@ or nil, use a compact 80-column format." (when cmd (if (= (length mac) 0) (fmakunbound cmd) - (fset cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form mac mac-counter mac-format) - mac)))) + (fset cmd (kmacro mac mac-counter mac-format)))) (if no-keys (when cmd (cl-loop for key in (where-is-internal cmd '(keymap)) do @@ -327,10 +323,8 @@ or nil, use a compact 80-column format." (cl-loop for key in keys do (global-set-key key (or cmd - (if (and mac-counter mac-format) - (kmacro-lambda-form - mac mac-counter mac-format) - mac)))))))))) + (kmacro mac mac-counter + mac-format)))))))))) (kill-buffer buf) (when (buffer-name obuf) (switch-to-buffer obuf)) diff --git a/lisp/emacs-lisp/fcr.el b/lisp/emacs-lisp/fcr.el index d14e325e314..f4be4fcc109 100644 --- a/lisp/emacs-lisp/fcr.el +++ b/lisp/emacs-lisp/fcr.el @@ -52,6 +52,8 @@ ;; (negate f) generally returns (lambda (x) (not (f x))) ;; but it can optimize (negate (negate f)) to f and (negate #'<) to ;; #'>=. +;; - Autoloads (tho currently our bytecode functions (and hence FCRs) +;; are too fat for that). ;; Related constructs: ;; - `funcallable-standard-object' (FSO) in Common-Lisp. These are different @@ -111,9 +113,10 @@ ;; store-conversion is indispensable, so if we want to avoid store-conversion ;; we'd have to disallow such capture. -;; FIXME: +;; TODO: ;; - `fcr-cl-defun', `fcr-cl-defsubst', `fcr-defsubst', `fcr-define-inline'? ;; - Use accessor in cl-defstruct +;; - Add pcase patterns for FCRs. (eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) ;For `named-let'. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index af13ebbb01d..8311c434048 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -362,9 +362,13 @@ information." ;;; 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'.") @@ -378,20 +382,23 @@ 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) @@ -481,21 +488,16 @@ Optional arg EMPTY is message to print if no macros are defined." ;;;###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) @@ -515,7 +517,7 @@ without repeating the prefix." "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) @@ -611,8 +613,7 @@ Use \\[kmacro-bind-to-key] to bind it to a key sequence." (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) @@ -748,9 +749,9 @@ With \\[universal-argument], call second macro in macro ring." (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 @@ -811,51 +812,58 @@ If kbd macro currently being defined end it before activating it." ;; 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) @@ -894,16 +902,15 @@ The ARG parameter is unused." (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) @@ -920,9 +927,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command 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 @@ -963,7 +968,7 @@ The ARG parameter is unused." (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 @@ -973,10 +978,10 @@ The ARG parameter is unused." 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 @@ -1123,7 +1128,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', ;; 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. @@ -1143,7 +1148,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (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)) @@ -1187,7 +1192,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', ((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) @@ -1237,7 +1242,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (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 () @@ -1281,7 +1286,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (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))))) @@ -1294,7 +1299,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (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]) diff --git a/lisp/macros.el b/lisp/macros.el index 89e38abab2d..cc0079adac1 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -46,6 +46,16 @@ " ") ?\])) +(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. @@ -75,63 +85,25 @@ use this command, and then save the file." (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) diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index 51108e033b0..9744854f080 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -583,8 +583,10 @@ This is a regression test for: Bug#3412, Bug#11817." ;; Check the bound key and run it and verify correct counter ;; and format. (should (equal (string-to-vector "\C-cxi") - (car (kmacro-extract-lambda - (key-binding "\C-x\C-kA"))))) + (car (with-suppressed-warnings + ((obsolete kmacro-extract-lambda)) + (kmacro-extract-lambda + (key-binding "\C-x\C-kA")))))) (kmacro-tests-should-insert "<5>" (funcall (key-binding "\C-x\C-kA"))))) @@ -608,7 +610,7 @@ This is a regression test for: Bug#3412, Bug#11817." (dotimes (i 2) (kmacro-tests-define-macro (make-vector (1+ i) (+ ?a i))) (kmacro-name-last-macro 'kmacro-tests-symbol-for-test) - (should (fboundp 'kmacro-tests-symbol-for-test))) + (should (commandp 'kmacro-tests-symbol-for-test))) ;; Now run the function bound to the symbol. Result should be the ;; second macro. @@ -827,8 +829,12 @@ This is a regression for item 7 in Bug#24991." (ert-deftest kmacro-tests--cl-print () (should (equal (cl-prin1-to-string - (kmacro-lambda-form [?a ?b backspace backspace] 0 "%d")) - "#"))) + (kmacro [?a ?b backspace backspace])) + "#f(kmacro \"a b \")")) + (should (equal (cl-prin1-to-string + (with-suppressed-warnings ((obsolete kmacro-lambda-form)) + (kmacro-lambda-form [?a ?b backspace backspace] 1 "%d"))) + "#f(kmacro \"a b \" 1 \"%d\")"))) (cl-defun kmacro-tests-run-step-edit (macro &key events sequences result macro-result) -- 2.39.5