From: Stefan Monnier Date: Sat, 2 Apr 2022 00:07:33 +0000 (-0400) Subject: kmacro: Represent it as an OClosure X-Git-Tag: emacs-29.0.90~1931^2~831 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c75f65442ddfd2427d95278c44214c0cf1d5a2ee;p=emacs.git kmacro: Represent it as an OClosure Merge the old lambda+list into a single OClosure object which plays both roles at the same time. Take advantage of it to provide a `cl-print-object` method so kmacro objects print nicely using the `key-parse` syntax. Also replace the old `kmacro-lambda-form` with a new `kmacro` constructor which takes a `key-parse` syntax, so that the code inserted with `insert-kbd-macro` is now more readable. * lisp/kmacro.el (kmacro): New OClosure type. (kmacro-ring-head): Use `kmacro` constructor. (kmacro-push-ring): Convert `elt` from old representation if needed. (kmacro-split-ring-element, kmacro-view-ring-2nd, kmacro-view-macro): Adapt to new representation. (kmacro-exec-ring-item): Turn into obsolete alias. (kmacro-call-ring-2nd, kmacro-end-or-call-macro): Adjust accordingly. (kmacro-start-macro): Simplify call to `kmacro-push-ring`. (kmacro): New constructor function. Replaces `kmacro-lambda-form`. (kmacro-lambda-form): Use it and declare obsolete. (kmacro-extract-lambda): Rewrite and declare obsolete. (kmacro-p): Rewrite. (cl-print-object): New method. (kmacro-bind-to-key, kmacro-name-last-macro): Simplify. * lisp/macros.el (macro--string-to-vector): New function. (insert-kbd-macro): Use it. Generate code using the `kmacro` constructor. * test/lisp/kmacro-tests.el (kmacro-tests-kmacro-bind-to-single-key): Silence warning. (kmacro-tests-name-last-macro-bind-and-rebind): Strengthen the test a bit. (kmacro-tests--cl-print): New test. --- diff --git a/etc/NEWS b/etc/NEWS index e2998de0029..3df326aa5b3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -576,6 +576,12 @@ This uses the Tai Tham script, whose support has been enhanced. * Changes in Specialized Modes and Packages in Emacs 29.1 +--- +** kmacro +Kmacros are now OClosures and have a new constructor 'kmacro' which +uses the 'key-parse' syntax. It replaces the old 'kmacro-lambda-form' +(which is now declared obsolete). + --- ** 'savehist.el' can now truncate variables that are too long. An element of 'savehist-additional-variables' can now be of the form diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 9bbaaa666da..8a9d89929eb 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -362,9 +362,13 @@ information." ;;; Keyboard macro ring +(oclosure-define 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,42 +812,67 @@ 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...) +;;;###autoload +(defun kmacro (keys &optional counter format) + "Create a `kmacro' for macro bound to symbol or key. +KEYS should be a vector or a string that obeys `key-valid-p'." + (oclosure-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. - (let ((mac (if counter (list mac counter format) mac))) - ;; FIXME: This should be a "funcallable struct"! - (lambda (&optional arg) - "Keyboard macro." - ;; We put an "unused prompt" as a special marker so - ;; `kmacro-extract-lambda' can see it's "one of us". - (interactive "pkmacro") - (if (eq arg 'kmacro--extract-lambda) - (cons 'kmacro--extract-lambda mac) - (kmacro-exec-ring-item mac arg))))) + (declare (obsolete kmacro "29.1")) + (if (kmacro-p mac) mac + (when (and (null counter) (consp mac)) + (setq format (nth 2 mac)) + (setq counter (nth 1 mac)) + (setq mac (nth 0 mac))) + (when (stringp mac) + ;; `kmacro' interprets a string according to `key-parse'. + (require 'macros) + (declare-function macro--string-to-vector "macros") + (setq mac (macro--string-to-vector mac))) + (kmacro mac counter format))) (defun kmacro-extract-lambda (mac) "Extract kmacro from a kmacro lambda form." - (let ((mac (cond - ((eq (car-safe mac) 'lambda) - (let ((e (assoc 'kmacro-exec-ring-item mac))) - (car-safe (cdr-safe (car-safe (cdr-safe e)))))) - ((and (functionp mac) - (equal (interactive-form mac) '(interactive "pkmacro"))) - (let ((r (funcall mac 'kmacro--extract-lambda))) - (and (eq (car-safe r) 'kmacro--extract-lambda) (cdr r))))))) - (and (consp mac) - (= (length mac) 3) - (arrayp (car mac)) - mac))) - -(defalias 'kmacro-p #'kmacro-extract-lambda - "Return non-nil if MAC is a kmacro keyboard macro.") + (declare (obsolete nil "29.1")) + (when (kmacro-p 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)) + +(cl-defmethod cl-print-object ((object kmacro) stream) + (princ "#f(kmacro " stream) + (require 'macros) + (declare-function macros--insert-vector-macro "macros" (definition)) + (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) "When not defining or executing a macro, offer to bind last macro to a key. @@ -884,16 +910,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) @@ -910,9 +935,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 @@ -953,7 +976,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 @@ -963,10 +986,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 @@ -1068,21 +1091,27 @@ following additional answers: `insert', `insert-1', `replace', `replace-1', (concat (format "Macro: %s%s%s%s%s\n" (format-kbd-macro kmacro-step-edit-new-macro 1) - (if (and kmacro-step-edit-new-macro (> (length kmacro-step-edit-new-macro) 0)) " " "") + (if (and kmacro-step-edit-new-macro + (> (length kmacro-step-edit-new-macro) 0)) + " " "") (propertize (if keys (format-kbd-macro keys) - (if kmacro-step-edit-appending "" "")) 'face 'region) + (if kmacro-step-edit-appending + "" "")) + 'face 'region) (if future " " "") (if future (format-kbd-macro future) "")) (cond ((minibufferp) (format "%s\n%s\n" (propertize "\ - minibuffer " 'face 'header-line) + minibuffer " + 'face 'header-line) (buffer-substring (point-min) (point-max)))) (curmsg (format "%s\n%s\n" (propertize "\ - echo area " 'face 'header-line) + echo area " + 'face 'header-line) curmsg)) (t "")) (if keys @@ -1113,7 +1142,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. @@ -1133,7 +1162,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)) @@ -1177,7 +1206,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) @@ -1227,7 +1256,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 () @@ -1271,7 +1300,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))))) @@ -1284,7 +1313,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 35d34d2e337..0baf3804332 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. @@ -72,66 +82,31 @@ use this command, and then save the file." (setq macroname 'last-kbd-macro definition last-kbd-macro) (insert "(setq ")) (setq definition (symbol-function macroname)) - (insert "(fset '")) + ;; Prefer `defalias' over `fset' since it additionally keeps + ;; track of the file where the users added it, and it interacts + ;; better with `advice-add' (and hence things like ELP). + (insert "(defalias '")) (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 (and (symbol-function macroname) diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index c62a2a501ba..75d700070aa 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -580,8 +580,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"))))) @@ -605,7 +607,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. @@ -822,6 +824,15 @@ This is a regression for item 7 in Bug#24991." :macro-result "x") (kmacro-tests-simulate-command '(beginning-of-line)))) +(ert-deftest kmacro-tests--cl-print () + (should (equal (cl-prin1-to-string + (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) "Set up and run a test of `kmacro-step-edit-macro'.