[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master c75f65442d: kmacro: Represent it as an OClosure
|
From: |
Stefan Monnier |
|
Subject: |
master c75f65442d: kmacro: Represent it as an OClosure |
|
Date: |
Fri, 1 Apr 2022 20:07:41 -0400 (EDT) |
branch: master
commit c75f65442ddfd2427d95278c44214c0cf1d5a2ee
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
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.
---
etc/NEWS | 6 ++
lisp/kmacro.el | 157 +++++++++++++++++++++++++++-------------------
lisp/macros.el | 91 ++++++++++-----------------
test/lisp/kmacro-tests.el | 17 ++++-
4 files changed, 146 insertions(+), 125 deletions(-)
diff --git a/etc/NEWS b/etc/NEWS
index e2998de002..3df326aa5b 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 9bbaaa666d..8a9d89929e 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 "<APPEND>"
"<INSERT>")) 'face 'region)
+ (if kmacro-step-edit-appending
+ "<APPEND>" "<INSERT>"))
+ '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 35d34d2e33..0baf380433 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 c62a2a501b..75d700070a 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 <backspace> <backspace>\")"))
+ (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 <backspace> <backspace>\" 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'.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master c75f65442d: kmacro: Represent it as an OClosure,
Stefan Monnier <=