Fix Bug#22557

[gnu-emacs] / lisp / kmacro.el

diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index c8dd05f7c4d1375b6d2d48b20bea01cd62511f77..a3683738fc635203b32229f6b0bd6a7c1553716e 100644 (file)
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,6 +1,6 @@
 ;;; kmacro.el --- enhanced keyboard macros
 
 ;;; kmacro.el --- enhanced keyboard macros
 

-;; Copyright (C) 2002-2012  Free Software Foundation, Inc.
+;; Copyright (C) 2002-2016 Free Software Foundation, Inc.

 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard convenience
 
 ;; Author: Kim F. Storm <storm@cua.dk>
 ;; Keywords: keyboard convenience


@@ -202,6 +202,7 @@ macro to be executed before appending to it."
     ;; naming and binding
     (define-key map "b"    'kmacro-bind-to-key)
     (define-key map "n"    'kmacro-name-last-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.")
 (defalias 'kmacro-keymap kmacro-keymap)
     map)
   "Keymap for keyboard macro commands.")
 (defalias 'kmacro-keymap kmacro-keymap)


@@ -231,12 +232,12 @@ macro to be executed before appending to it."
 ;;; Keyboard macro counter
 
 (defvar kmacro-counter 0
 ;;; Keyboard macro counter
 
 (defvar kmacro-counter 0

-  "*Current keyboard macro counter.")
+  "Current keyboard macro counter.")

 
 (defvar kmacro-default-counter-format "%d")
 
 (defvar kmacro-counter-format "%d"
 
 (defvar kmacro-default-counter-format "%d")
 
 (defvar kmacro-counter-format "%d"

-  "*Current keyboard macro counter format.")
+  "Current keyboard macro counter format.")

 
 (defvar kmacro-counter-format-start kmacro-counter-format
   "Macro format at start of macro execution.")
 
 (defvar kmacro-counter-format-start kmacro-counter-format
   "Macro format at start of macro execution.")


@@ -431,7 +432,7 @@ Optional arg EMPTY is message to print if no macros are defined."
       (setq last-input-event nil)))
   (when last-input-event
     (clear-this-command-keys t)
       (setq last-input-event nil)))
   (when last-input-event
     (clear-this-command-keys t)

-    (setq unread-command-events (list last-input-event))))
+    (push last-input-event unread-command-events)))

 
 
 (defun kmacro-get-repeat-prefix ()
 
 
 (defun kmacro-get-repeat-prefix ()


@@ -444,7 +445,8 @@ Optional arg EMPTY is message to print if no macros are defined."
 
 ;;;###autoload
 (defun kmacro-exec-ring-item (item arg)
 
 ;;;###autoload
 (defun kmacro-exec-ring-item (item arg)

-  "Execute item ITEM from the macro ring."
+  "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)))
   ;; Use counter and format specific to the macro on the ring!
   (let ((kmacro-counter (nth 1 item))
        (kmacro-counter-format-start (nth 2 item)))


@@ -481,7 +483,8 @@ without repeating the prefix."
 
 (defun kmacro-cycle-ring-next (&optional _arg)
   "Move to next keyboard macro in keyboard macro ring.
 
 (defun kmacro-cycle-ring-next (&optional _arg)
   "Move to next keyboard macro in keyboard macro ring.

-Displays the selected macro in the echo area."
+Displays the selected macro in the echo area.
+The ARG parameter is unused."

   (interactive)
   (unless (kmacro-ring-empty-p)
     (kmacro-push-ring)
   (interactive)
   (unless (kmacro-ring-empty-p)
     (kmacro-push-ring)


@@ -500,7 +503,8 @@ Displays the selected macro in the echo area."
 
 (defun kmacro-cycle-ring-previous (&optional _arg)
   "Move to previous keyboard macro in keyboard macro ring.
 
 (defun kmacro-cycle-ring-previous (&optional _arg)
   "Move to previous keyboard macro in keyboard macro ring.

-Displays the selected macro in the echo area."
+Displays the selected macro in the echo area.
+The ARG parameter is unused."

   (interactive)
   (unless (kmacro-ring-empty-p)
     (let ((keys (kmacro-get-repeat-prefix))
   (interactive)
   (unless (kmacro-ring-empty-p)
     (let ((keys (kmacro-get-repeat-prefix))


@@ -527,7 +531,8 @@ Displays the selected macro in the echo area."
 
 
 (defun kmacro-delete-ring-head (&optional _arg)
 
 
 (defun kmacro-delete-ring-head (&optional _arg)

-  "Delete current macro from keyboard macro ring."
+  "Delete current macro from keyboard macro ring.
+The ARG parameter is unused."

   (interactive)
   (unless (kmacro-ring-empty-p t)
     (if (null kmacro-ring)
   (interactive)
   (unless (kmacro-ring-empty-p t)
     (if (null kmacro-ring)


@@ -613,9 +618,10 @@ An argument of zero means repeat until error."
 
 
 ;;;###autoload
 
 
 ;;;###autoload

-(defun kmacro-call-macro (arg &optional no-repeat end-macro)
-  "Call the last keyboard macro that you defined with \\[kmacro-start-macro].
+(defun kmacro-call-macro (arg &optional no-repeat end-macro macro)
+  "Call the keyboard MACRO that you defined with \\[kmacro-start-macro].

 A prefix argument serves as a repeat count.  Zero means repeat until error.
 A prefix argument serves as a repeat count.  Zero means repeat until error.

+MACRO defaults to `last-kbd-macro'.

 
 When you call the macro, you can call the macro again by repeating
 just the last key in the key sequence that you used to call this
 
 When you call the macro, you can call the macro again by repeating
 just the last key in the key sequence that you used to call this


@@ -625,13 +631,15 @@ for details on how to adjust or disable this behavior.
 To make a macro permanent so you can call it even after defining
 others, use \\[kmacro-name-last-macro]."
   (interactive "p")
 To make a macro permanent so you can call it even after defining
 others, use \\[kmacro-name-last-macro]."
   (interactive "p")

-  (let ((repeat-key (and (null no-repeat)
-                        (> (length (this-single-command-keys)) 1)
-                        last-input-event))
-       repeat-key-str)
+  (let ((repeat-key (and (or (and (null no-repeat)
+                                  (> (length (this-single-command-keys)) 1))
+                             ;; Used when we're in the process of repeating.
+                             (eq no-repeat 'repeating))
+                        last-input-event)))

     (if end-macro
     (if end-macro

-       (kmacro-end-macro arg)
-      (call-last-kbd-macro arg #'kmacro-loop-setup-function))
+       (kmacro-end-macro arg)          ; modifies last-kbd-macro
+      (let ((last-kbd-macro (or macro last-kbd-macro)))
+       (call-last-kbd-macro arg #'kmacro-loop-setup-function)))

     (when (consp arg)
       (setq arg (car arg)))
     (when (and (or (null arg) (> arg 0))
     (when (consp arg)
       (setq arg (car arg)))
     (when (and (or (null arg) (> arg 0))


@@ -639,25 +647,25 @@ others, use \\[kmacro-name-last-macro]."
                     (if (eq kmacro-call-repeat-key t)
                         repeat-key
                       kmacro-call-repeat-key)))
                     (if (eq kmacro-call-repeat-key t)
                         repeat-key
                       kmacro-call-repeat-key)))

-      (setq repeat-key-str (format-kbd-macro (vector repeat-key) nil))
-      (while repeat-key
-       ;; Issue a hint to the user, if the echo area isn't in use.
-       (unless (current-message)
-         (message "(Type %s to repeat macro%s)"
-                  repeat-key-str
-                  (if (and kmacro-call-repeat-with-arg
-                           arg (> arg 1))
-                      (format " %d times" arg) "")))
-       (if (equal repeat-key (read-event))
-           (progn
-             (clear-this-command-keys t)
-             (call-last-kbd-macro (and kmacro-call-repeat-with-arg arg)
-                                  #'kmacro-loop-setup-function)
-             (setq last-input-event nil))
-         (setq repeat-key nil)))
-      (when last-input-event
-       (clear-this-command-keys t)
-       (setq unread-command-events (list last-input-event))))))
+      ;; Issue a hint to the user, if the echo area isn't in use.
+      (unless (current-message)
+       (message "(Type %s to repeat macro%s)"
+                (format-kbd-macro (vector repeat-key) nil)
+                (if (and kmacro-call-repeat-with-arg
+                         arg (> arg 1))
+                    (format " %d times" arg) "")))
+      ;; Can't use the `keep-pred' arg because this overlay keymap
+      ;; needs to be removed during the next run of the kmacro
+      ;; (i.e. we must add and remove this map at each repetition).
+      (set-transient-map
+       (let ((map (make-sparse-keymap)))
+         (define-key map (vector repeat-key)
+           `(lambda () (interactive)
+              (kmacro-call-macro ,(and kmacro-call-repeat-with-arg arg)
+                                 'repeating nil ,(if end-macro
+                                                    last-kbd-macro
+                                                  (or macro last-kbd-macro)))))
+         map)))))

 
 
 ;;; Combined function key bindings:
 
 
 ;;; Combined function key bindings:


@@ -788,7 +796,8 @@ You can bind to any valid key sequence, but if you try to bind to
 a key with an existing command binding, you will be asked for
 confirmation whether to replace that binding.  Note that the
 binding is made in the `global-map' keymap, so the macro binding
 a key with an existing command binding, you will be asked for
 confirmation whether to replace that binding.  Note that the
 binding is made in the `global-map' keymap, so the macro binding

-may be shaded by a local key binding."
+may be shaded by a local key binding.
+The ARG parameter is unused."

   (interactive "p")
   (if (or defining-kbd-macro executing-kbd-macro)
       (if defining-kbd-macro
   (interactive "p")
   (if (or defining-kbd-macro executing-kbd-macro)
       (if defining-kbd-macro


@@ -837,9 +846,31 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
   (put symbol 'kmacro t))
 
 
   (put symbol 'kmacro t))
 
 

+(defun kmacro-execute-from-register (k)
+  (kmacro-call-macro current-prefix-arg nil nil k))
+
+(defun kmacro-to-register (r)
+  "Store the last keyboard macro in register R.
+
+Interactively, reads the register using `register-read-with-preview'."
+  (interactive
+   (progn
+     (or last-kbd-macro (error "No keyboard macro defined"))
+     (list (register-read-with-preview "Save to register: "))))
+  (set-register r (registerv-make
+                  last-kbd-macro
+                  :jump-func 'kmacro-execute-from-register
+                  :print-func (lambda (k)
+                                (princ (format "a keyboard macro:\n   %s"
+                                               (format-kbd-macro k))))
+                  :insert-func (lambda (k)
+                                 (insert (format-kbd-macro k))))))
+
+

 (defun kmacro-view-macro (&optional _arg)
   "Display the last keyboard macro.
 (defun kmacro-view-macro (&optional _arg)
   "Display the last keyboard macro.

-If repeated, it shows previous elements in the macro ring."
+If repeated, it shows previous elements in the macro ring.
+The ARG parameter is unused."

   (interactive)
   (cond
    ((or (kmacro-ring-empty-p)
   (interactive)
   (cond
    ((or (kmacro-ring-empty-p)


@@ -910,7 +941,6 @@ without repeating the prefix."
 (defvar kmacro-step-edit-inserting)     ;; inserting into macro
 (defvar kmacro-step-edit-appending)     ;; append to end of macro
 (defvar kmacro-step-edit-replace)       ;; replace orig macro when done
 (defvar kmacro-step-edit-inserting)     ;; inserting into macro
 (defvar kmacro-step-edit-appending)     ;; append to end of macro
 (defvar kmacro-step-edit-replace)       ;; replace orig macro when done

-(defvar kmacro-step-edit-prefix-index)   ;; index of first prefix arg key

 (defvar kmacro-step-edit-key-index)      ;; index of current key
 (defvar kmacro-step-edit-action)        ;; automatic action on next pre-command hook
 (defvar kmacro-step-edit-help)          ;; kmacro step edit help enabled
 (defvar kmacro-step-edit-key-index)      ;; index of current key
 (defvar kmacro-step-edit-action)        ;; automatic action on next pre-command hook
 (defvar kmacro-step-edit-help)          ;; kmacro step edit help enabled


@@ -945,11 +975,6 @@ 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'.")
 
 following additional answers: `insert', `insert-1', `replace', `replace-1',
 `append', `append-end', `act-repeat', `skip-end', `skip-keep'.")
 

-(defvar kmacro-step-edit-prefix-commands
-  '(universal-argument universal-argument-more universal-argument-minus
-                      digit-argument negative-argument)
-  "Commands which build up a prefix arg for the current command.")
-

 (defun kmacro-step-edit-prompt (macro index)
   ;; Show step-edit prompt
   (let ((keys (and (not kmacro-step-edit-appending)
 (defun kmacro-step-edit-prompt (macro index)
   ;; Show step-edit prompt
   (let ((keys (and (not kmacro-step-edit-appending)


@@ -1053,21 +1078,13 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
       ;; Handle prefix arg, or query user
       (cond
        (act act) ;; set above
       ;; Handle prefix arg, or query user
       (cond
        (act act) ;; set above

-       ((memq this-command kmacro-step-edit-prefix-commands)
-       (unless kmacro-step-edit-prefix-index
-         (setq kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
-       (setq act 'universal-argument))
-       ((eq this-command 'universal-argument-other-key)
-       (setq act 'universal-argument))

        (t
        (t

-       (kmacro-step-edit-prompt macro (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+       (kmacro-step-edit-prompt macro kmacro-step-edit-key-index)

        (setq act (lookup-key kmacro-step-edit-map
                              (vector (with-current-buffer (current-buffer) (read-event))))))))
 
     ;; Resume macro execution and perform the action
     (cond
        (setq act (lookup-key kmacro-step-edit-map
                              (vector (with-current-buffer (current-buffer) (read-event))))))))
 
     ;; Resume macro execution and perform the action
     (cond

-     ((eq act 'universal-argument)
-      nil)

      ((cond
        ((eq act 'act)
        t)
      ((cond
        ((eq act 'act)
        t)


@@ -1079,7 +1096,6 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
        (setq kmacro-step-edit-active 'ignore)
        nil)
        ((eq act 'skip)
        (setq kmacro-step-edit-active 'ignore)
        nil)
        ((eq act 'skip)

-       (setq kmacro-step-edit-prefix-index nil)

        nil)
        ((eq act 'skip-keep)
        (setq this-command 'ignore)
        nil)
        ((eq act 'skip-keep)
        (setq this-command 'ignore)


@@ -1092,12 +1108,11 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
        (setq act t)
        t)
        ((member act '(insert-1 insert))
        (setq act t)
        t)
        ((member act '(insert-1 insert))

-       (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+       (setq executing-kbd-macro-index kmacro-step-edit-key-index)

        (setq kmacro-step-edit-inserting (if (eq act 'insert-1) 1 t))
        nil)
        ((member act '(replace-1 replace))
        (setq kmacro-step-edit-inserting (if (eq act 'replace-1) 1 t))
        (setq kmacro-step-edit-inserting (if (eq act 'insert-1) 1 t))
        nil)
        ((member act '(replace-1 replace))
        (setq kmacro-step-edit-inserting (if (eq act 'replace-1) 1 t))

-       (setq kmacro-step-edit-prefix-index nil)

        (if (= executing-kbd-macro-index (length executing-kbd-macro))
            (setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
                  kmacro-step-edit-appending t))
        (if (= executing-kbd-macro-index (length executing-kbd-macro))
            (setq executing-kbd-macro (vconcat executing-kbd-macro [nil])
                  kmacro-step-edit-appending t))


@@ -1117,19 +1132,19 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
        (setq act t)
        t)
        ((eq act 'help)
        (setq act t)
        t)
        ((eq act 'help)

-       (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+       (setq executing-kbd-macro-index kmacro-step-edit-key-index)

        (setq kmacro-step-edit-help (not kmacro-step-edit-help))
        nil)
        (t ;; Ignore unknown responses
        (setq kmacro-step-edit-help (not kmacro-step-edit-help))
        nil)
        (t ;; Ignore unknown responses

-       (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+       (setq executing-kbd-macro-index kmacro-step-edit-key-index)

        nil))
        nil))

-      (if (> executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index))
+      (if (> executing-kbd-macro-index kmacro-step-edit-key-index)

          (setq kmacro-step-edit-new-macro
                (vconcat kmacro-step-edit-new-macro
                         (substring executing-kbd-macro
          (setq kmacro-step-edit-new-macro
                (vconcat kmacro-step-edit-new-macro
                         (substring executing-kbd-macro

-                                   (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)
-                                   (if (eq act t) nil executing-kbd-macro-index)))
-               kmacro-step-edit-prefix-index nil))
+                                   kmacro-step-edit-key-index
+                                   (if (eq act t) nil
+                                      executing-kbd-macro-index)))))

       (if restore-index
          (setq executing-kbd-macro-index restore-index)))
      (t
       (if restore-index
          (setq executing-kbd-macro-index restore-index)))
      (t


@@ -1144,12 +1159,10 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
        (executing-kbd-macro nil)
        (defining-kbd-macro nil)
        cmd keys next-index)
        (executing-kbd-macro nil)
        (defining-kbd-macro nil)
        cmd keys next-index)

-    (setq executing-kbd-macro-index (or kmacro-step-edit-prefix-index kmacro-step-edit-key-index)
-         kmacro-step-edit-prefix-index nil)
+    (setq executing-kbd-macro-index kmacro-step-edit-key-index)

     (kmacro-step-edit-prompt macro nil)
     ;; Now, we have read a key sequence from the macro, but we don't want
     ;; to execute it yet.  So push it back and read another sequence.
     (kmacro-step-edit-prompt macro nil)
     ;; Now, we have read a key sequence from the macro, but we don't want
     ;; to execute it yet.  So push it back and read another sequence.

-    (reset-this-command-lengths)

     (setq keys (read-key-sequence nil nil nil nil t))
     (setq cmd (key-binding keys t nil))
     (if (cond
     (setq keys (read-key-sequence nil nil nil nil t))
     (setq cmd (key-binding keys t nil))
     (if (cond


@@ -1170,28 +1183,12 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
                    unread-command-events nil)))
          (setq cmd 'ignore)
          nil)
                    unread-command-events nil)))
          (setq cmd 'ignore)
          nil)

-        ((memq cmd kmacro-step-edit-prefix-commands)
-         (setq universal-argument-num-events 0)
-         (reset-this-command-lengths)
-         nil)
-        ((eq cmd 'universal-argument-other-key)
-         (setq kmacro-step-edit-action t)
-         (setq universal-argument-num-events 0)
-         (reset-this-command-lengths)
-         (if (numberp kmacro-step-edit-inserting)
-             (setq kmacro-step-edit-inserting nil))
-         nil)

         ((numberp kmacro-step-edit-inserting)
          (setq kmacro-step-edit-inserting nil)
          nil)
         ((equal keys "\C-j")
          (setq kmacro-step-edit-inserting nil)
          (setq kmacro-step-edit-action nil)
         ((numberp kmacro-step-edit-inserting)
          (setq kmacro-step-edit-inserting nil)
          nil)
         ((equal keys "\C-j")
          (setq kmacro-step-edit-inserting nil)
          (setq kmacro-step-edit-action nil)

-         ;; Forget any (partial) prefix arg from next command
-         (setq kmacro-step-edit-prefix-index nil)
-         (reset-this-command-lengths)
-         (setq overriding-terminal-local-map nil)
-         (setq universal-argument-num-events nil)

          (setq next-index kmacro-step-edit-key-index)
          t)
         (t nil))
          (setq next-index kmacro-step-edit-key-index)
          t)
         (t nil))


@@ -1250,7 +1247,6 @@ To customize possible responses, change the \"bindings\" in `kmacro-step-edit-ma
        (kmacro-step-edit-inserting nil)
        (kmacro-step-edit-appending nil)
        (kmacro-step-edit-replace t)
        (kmacro-step-edit-inserting nil)
        (kmacro-step-edit-appending nil)
        (kmacro-step-edit-replace t)

-       (kmacro-step-edit-prefix-index nil)

        (kmacro-step-edit-key-index 0)
        (kmacro-step-edit-action nil)
        (kmacro-step-edit-help nil)
        (kmacro-step-edit-key-index 0)
        (kmacro-step-edit-action nil)
        (kmacro-step-edit-help nil)