mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-27 10:54:40 +00:00
Code Issues Releases Activity

kmacro: Represent it as an OClosure

Browse Source 
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.
This commit is contained in:
Stefan Monnier 2022-04-01 20:07:33 -04:00
parent a15f9d4e58
commit c75f65442d
4 changed files with 145 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
etc/NEWS
View File

@ -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

155
lisp/kmacro.el
View File

@ -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)))
(declare (obsolete nil "29.1"))
(when (kmacro-p mac)
(list (kmacro--keys mac)
(kmacro--counter mac)
(kmacro--format mac))))
(defalias 'kmacro-p #'kmacro-extract-lambda
"Return non-nil if MAC is a kmacro keyboard macro.")
(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])

91
lisp/macros.el
View File

@ -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)

17
test/lisp/kmacro-tests.el
View File

@ -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'.