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.

1 files changed, 93 insertions, 64 deletions

diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 9bbaaa666da..8a9d89929eb 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
@@ -812,41 +813,66 @@ 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)
+    (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])