Merge 'master' into noverlay

1 files changed, 62 insertions, 87 deletions

diff --git a/lisp/macros.el b/lisp/macros.el
index 34e81f693f5..0baf3804332 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,6 +1,6 @@
-;;; macros.el --- non-primitive commands for keyboard macros
+;;; macros.el --- non-primitive commands for keyboard macros -*- lexical-binding:t -*-
 
-;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2017 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2022 Free Software
 ;; Foundation, Inc.
 
 ;; Maintainer: emacs-devel@gnu.org
@@ -26,28 +26,35 @@
 
 ;; Extension commands for keyboard macros.  These permit you to assign
 ;; a name to the last-defined keyboard macro, expand and insert the
-;; lisp corresponding to a macro, query the user from within a macro,
+;; Lisp corresponding to a macro, query the user from within a macro,
 ;; or apply a macro to each line in the reason.
 
 ;;; Code:
 
+(require 'kmacro)
+
 ;;;###autoload
-(defun name-last-kbd-macro (symbol)
-  "Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid editor command."
-  (interactive "SName for last kbd macro: ")
-  (or last-kbd-macro
-      (user-error "No keyboard macro defined"))
-  (and (fboundp symbol)
-       (not (stringp (symbol-function symbol)))
-       (not (vectorp (symbol-function symbol)))
-       (user-error "Function %s is already defined and not a keyboard macro"
-	      symbol))
-  (if (string-equal symbol "")
-      (user-error "No command name given"))
-  (fset symbol last-kbd-macro))
+(defalias 'name-last-kbd-macro #'kmacro-name-last-macro)
+
+(defun macros--insert-vector-macro (definition)
+  "Print DEFINITION, a vector, into the current buffer."
+  (insert ?\[
+          (mapconcat (lambda (event)
+                       (or (prin1-char event)
+                           (prin1-to-string event)))
+                     definition
+                     " ")
+          ?\]))
+
+(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)
@@ -66,11 +73,7 @@ To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
 use this command, and then save the file."
   (interactive (list (intern (completing-read "Insert kbd macro (name): "
 					      obarray
-					      (lambda (elt)
-						(and (fboundp elt)
-						     (or (stringp (symbol-function elt))
-							 (vectorp (symbol-function elt))
-							 (get elt 'kmacro))))
+                                              #'kmacro-keyboard-macro-p
 					      t))
 		     current-prefix-arg))
   (let (definition)
@@ -79,69 +82,36 @@ 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)
-	  (let ((len (length definition)) (i 0) char)
-	    (while (< i len)
-	      (insert (if (zerop i) ?\[ ?\s))
-	      (setq char (aref definition i)
-		    i (1+ i))
-	      (if (not (numberp char))
-                  (prin1 char (current-buffer))
-                (princ (prin1-char char) (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 (where-is-internal (symbol-function macroname)
-                                           '(keymap))
+        (let ((keys (or (and (symbol-function macroname)
+                             (where-is-internal (symbol-function macroname)
+                                                '(keymap)))
                         (where-is-internal macroname '(keymap)))))
 	  (while keys
 	    (insert "(global-set-key ")
@@ -154,11 +124,16 @@ use this command, and then save the file."
 ;;;###autoload
 (defun kbd-macro-query (flag)
   "Query user during kbd macro execution.
-  With prefix argument, enters recursive edit, reading keyboard
-commands even within a kbd macro.  You can give different commands
-each time the macro executes.
-  Without prefix argument, asks whether to continue running the macro.
+
+With prefix argument FLAG, enter recursive edit, reading
+keyboard commands even within a kbd macro.  You can give
+different commands each time the macro executes.
+
+Without prefix argument, ask whether to continue running the
+macro.
+
 Your options are: \\<query-replace-map>
+
 \\[act]	Finish this iteration normally and continue with the next.
 \\[skip]	Skip the rest of this iteration, and start the next.
 \\[exit]	Stop the macro entirely right now.