diff options
Diffstat (limited to 'lisp/kmacro.el')
| -rw-r--r-- | lisp/kmacro.el | 288 |
1 files changed, 156 insertions, 132 deletions
diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 7478e97134f..92118ad1433 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -129,7 +129,7 @@ Set to nil if no mouse binding is desired." (defcustom kmacro-ring-max 8 "Maximum number of keyboard macros to save in macro ring." - :type 'integer) + :type 'natnum) (defcustom kmacro-execute-before-append t @@ -164,43 +164,41 @@ macro to be executed before appending to it." ;; Keymap -(defvar kmacro-keymap - (let ((map (make-sparse-keymap))) - ;; Start, end, execute macros - (define-key map "s" #'kmacro-start-macro) - (define-key map "\C-s" #'kmacro-start-macro) - (define-key map "\C-k" #'kmacro-end-or-call-macro-repeat) - (define-key map "r" #'apply-macro-to-region-lines) - (define-key map "q" #'kbd-macro-query) ;; Like C-x q - (define-key map "d" #'kmacro-redisplay) - - ;; macro ring - (define-key map "\C-n" #'kmacro-cycle-ring-next) - (define-key map "\C-p" #'kmacro-cycle-ring-previous) - (define-key map "\C-v" #'kmacro-view-macro-repeat) - (define-key map "\C-d" #'kmacro-delete-ring-head) - (define-key map "\C-t" #'kmacro-swap-ring) - (define-key map "\C-l" #'kmacro-call-ring-2nd-repeat) - - ;; macro counter - (define-key map "\C-f" #'kmacro-set-format) - (define-key map "\C-c" #'kmacro-set-counter) - (define-key map "\C-i" #'kmacro-insert-counter) - (define-key map "\C-a" #'kmacro-add-counter) - - ;; macro editing - (define-key map "\C-e" #'kmacro-edit-macro-repeat) - (define-key map "\r" #'kmacro-edit-macro) - (define-key map "e" #'edit-kbd-macro) - (define-key map "l" #'kmacro-edit-lossage) - (define-key map " " #'kmacro-step-edit-macro) - - ;; naming and binding - (define-key map "b" #'kmacro-bind-to-key) - (define-key map "n" #'kmacro-name-last-macro) - (define-key map "x" #'kmacro-to-register) - map) - "Keymap for keyboard macro commands.") +(defvar-keymap kmacro-keymap + :doc "Keymap for keyboard macro commands." + ;; Start, end, execute macros + "s" #'kmacro-start-macro + "C-s" #'kmacro-start-macro + "C-k" #'kmacro-end-or-call-macro-repeat + "r" #'apply-macro-to-region-lines + "q" #'kbd-macro-query ;; Like C-x q + "d" #'kmacro-redisplay + + ;; macro ring + "C-n" #'kmacro-cycle-ring-next + "C-p" #'kmacro-cycle-ring-previous + "C-v" #'kmacro-view-macro-repeat + "C-d" #'kmacro-delete-ring-head + "C-t" #'kmacro-swap-ring + "C-l" #'kmacro-call-ring-2nd-repeat + + ;; macro counter + "C-f" #'kmacro-set-format + "C-c" #'kmacro-set-counter + "C-i" #'kmacro-insert-counter + "C-a" #'kmacro-add-counter + + ;; macro editing + "C-e" #'kmacro-edit-macro-repeat + "RET" #'kmacro-edit-macro + "e" #'edit-kbd-macro + "l" #'kmacro-edit-lossage + "SPC" #'kmacro-step-edit-macro + + ;; naming and binding + "b" #'kmacro-bind-to-key + "n" #'kmacro-name-last-macro + "x" #'kmacro-to-register) (defalias 'kmacro-keymap kmacro-keymap) ;;; Provide some binding for startup: @@ -362,9 +360,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 +380,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 +486,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 +515,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 +611,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 +747,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 @@ -812,46 +811,72 @@ If kbd macro currently being defined end it before activating it." ;; 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) + ;; 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)))) + +(cl-defmethod oclosure-interactive-form ((_ kmacro)) '(interactive "p")) + +;;;###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. -The key sequences `C-x C-k 0' through `C-x C-k 9' and `C-x C-k A' -through `C-x C-k Z' are reserved for user bindings, and to bind to +The key sequences \\`C-x C-k 0' through \\`C-x C-k 9' and \\`C-x C-k A' +through \\`C-x C-k Z' are reserved for user bindings, and to bind to one of these sequences, just enter the digit or letter, rather than the whole sequence. @@ -884,16 +909,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 +934,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 @@ -930,7 +952,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command (cl-defmethod register-val-describe ((data kmacro-register) _verbose) (princ (format "a keyboard macro:\n %s" - (format-kbd-macro (kmacro-register-macro data))))) + (key-description (kmacro-register-macro data))))) (cl-defmethod register-val-insert ((data kmacro-register)) (insert (format-kbd-macro (kmacro-register-macro data)))) @@ -953,7 +975,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 +985,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 @@ -980,7 +1002,7 @@ The ARG parameter is unused." "Display the last keyboard macro. If repeated, it shows previous elements in the macro ring. To execute the displayed macro ring item without changing the macro ring, -just enter C-k. +just enter \\`C-k'. This is like `kmacro-view-macro', but allows repeating macro commands without repeating the prefix." (interactive) @@ -1025,34 +1047,30 @@ without repeating the prefix." (defvar kmacro-step-edit-help) ;; kmacro step edit help enabled (defvar kmacro-step-edit-num-input-keys) ;; to ignore duplicate pre-command hook -(defvar kmacro-step-edit-map - (let ((map (make-sparse-keymap))) - ;; query-replace-map answers include: `act', `skip', `act-and-show', - ;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', - ;; `automatic', `backup', `exit-prefix', and `help'.") - ;; Also: `quit', `edit-replacement' - - (set-keymap-parent map query-replace-map) - - (define-key map "\t" 'act-repeat) - (define-key map [tab] 'act-repeat) - (define-key map "\C-k" 'skip-rest) - (define-key map "c" 'automatic) - (define-key map "f" 'skip-keep) - (define-key map "q" 'quit) - (define-key map "d" 'skip) - (define-key map "\C-d" 'skip) - (define-key map "i" 'insert) - (define-key map "I" 'insert-1) - (define-key map "r" 'replace) - (define-key map "R" 'replace-1) - (define-key map "a" 'append) - (define-key map "A" 'append-end) - map) - "Keymap that defines the responses to questions in `kmacro-step-edit-macro'. +(defvar-keymap kmacro-step-edit-map + :doc "Keymap that defines the responses to questions in `kmacro-step-edit-macro'. This keymap is an extension to the `query-replace-map', allowing the following additional answers: `insert', `insert-1', `replace', `replace-1', -`append', `append-end', `act-repeat', `skip-end', `skip-keep'.") +`append', `append-end', `act-repeat', `skip-end', `skip-keep'." + ;; query-replace-map answers include: `act', `skip', `act-and-show', + ;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', + ;; `automatic', `backup', `exit-prefix', and `help'.") + ;; Also: `quit', `edit-replacement' + :parent query-replace-map + "TAB" 'act-repeat + "<tab>" 'act-repeat + "C-k" 'skip-rest + "c" 'automatic + "f" 'skip-keep + "q" 'quit + "d" 'skip + "C-d" 'skip + "i" 'insert + "I" 'insert-1 + "r" 'replace + "R" 'replace-1 + "a" 'append + "A" 'append-end) (defun kmacro-step-edit-prompt (macro index) ;; Show step-edit prompt @@ -1068,21 +1086,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 +1137,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 +1157,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 +1201,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 +1251,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 +1295,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 +1308,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]) |