master ffc81ebc4b 1/2: Allow specifying how args are to be stored in `command-history'

[Lars Ingebrigtsen]

branch: master
commit ffc81ebc4b5d6cfc827e6a08679da55134f73fb5
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Allow specifying how args are to be stored in `command-history'
    
    * doc/lispref/functions.texi (Declare Form): Document
    `interactive-args'
    * lisp/replace.el (replace-string): Store the correct interactive
    arguments (bug#45607).
    
    * lisp/emacs-lisp/byte-run.el (byte-run--set-interactive-args):
    New function.
    (defun-declarations-alist): Use it.
    
    * src/callint.c (fix_command): Remove the old hack (which now
    longer works since interactive specs are byte-compiled) and
    instead rely on `interactive-args'.
---
 doc/lispref/functions.texi  |   4 ++
 lisp/emacs-lisp/byte-run.el |  17 ++++++-
 lisp/replace.el             |   5 +-
 src/callint.c               | 113 ++++++++++++++------------------------------
 test/src/callint-tests.el   |  13 +++++
 5 files changed, 73 insertions(+), 79 deletions(-)

diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 8e8cc5fd9c..8265e58210 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -2498,6 +2498,10 @@ the current buffer.
 Specify that this command is meant to be applicable for @var{modes}
 only.
 
+@item (interactive-args @var{arg} ...)
+Specify the arguments that should be stored for @code{repeat-command}.
+Each @var{arg} is on the form @code{@var{argument-name} @var{form}}.
+
 @item (pure @var{val})
 If @var{val} is non-@code{nil}, this function is @dfn{pure}
 (@pxref{What Is a Function}).  This is the same as the @code{pure}
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9370bd3a09..4a2860cd43 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -236,6 +236,20 @@ The return value of this function is not used."
       (list 'function-put (list 'quote f)
             ''command-modes (list 'quote val))))
 
+(defalias 'byte-run--set-interactive-args
+  #'(lambda (f args &rest val)
+      (setq args (remove '&optional (remove '&rest args)))
+      (list 'function-put (list 'quote f)
+            ''interactive-args
+            (list
+             'quote
+             (mapcar
+              (lambda (elem)
+                (cons
+                 (seq-position args (car elem))
+                 (cadr elem)))
+              val)))))
+
 ;; Add any new entries to info node `(elisp)Declare Form'.
 (defvar defun-declarations-alist
   (list
@@ -255,7 +269,8 @@ If `error-free', drop calls even if 
`byte-compile-delete-errors' is nil.")
    (list 'indent #'byte-run--set-indent)
    (list 'speed #'byte-run--set-speed)
    (list 'completion #'byte-run--set-completion)
-   (list 'modes #'byte-run--set-modes))
+   (list 'modes #'byte-run--set-modes)
+   (list 'interactive-args #'byte-run--set-interactive-args))
   "List associating function properties to their macro expansion.
 Each element of the list takes the form (PROP FUN) where FUN is
 a function.  For each (PROP . VALUES) in a function's declaration,
diff --git a/lisp/replace.el b/lisp/replace.el
index ab9ac17ed9..cac0edf43a 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -664,7 +664,10 @@ which will run faster and will not set the mark or print 
anything.
 \(You may need a more complex loop if FROM-STRING can match the null string
 and TO-STRING is also null.)"
   (declare (interactive-only
-           "use `search-forward' and `replace-match' instead."))
+           "use `search-forward' and `replace-match' instead.")
+           (interactive-args
+           (start (if (use-region-p) (region-beginning)))
+           (end (if (use-region-p) (region-end)))))
   (interactive
    (let ((common
          (query-replace-read-args
diff --git a/src/callint.c b/src/callint.c
index ffa3b231eb..dfc479284c 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -161,10 +161,8 @@ check_mark (bool for_region)
     xsignal0 (Qmark_inactive);
 }
 
-/* If the list of args INPUT was produced with an explicit call to
-   `list', look for elements that were computed with
-   (region-beginning) or (region-end), and put those expressions into
-   VALUES instead of the present values.
+/* If FUNCTION has an `interactive-args' spec, replace relevant
+   elements in VALUES with those forms instead.
 
    This function doesn't return a value because it modifies elements
    of VALUES to do its job.  */
@@ -172,62 +170,24 @@ check_mark (bool for_region)
 static void
 fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values)
 {
-  /* FIXME: Instead of this ugly hack, we should provide a way for an
-     interactive spec to return an expression/function that will re-build the
-     args without user intervention.  */
-  if (CONSP (input))
+  /* Quick exit if there's no values to alter.  */
+  if (!CONSP (values))
+    return;
+
+  Lisp_Object reps = Fget (function, Qinteractive_args);
+
+  if (!NILP (reps) && CONSP (reps))
     {
-      Lisp_Object car;
+      int i = 0;
+      Lisp_Object vals = values;
 
-      car = XCAR (input);
-      /* Skip through certain special forms.  */
-      while (EQ (car, Qlet) || EQ (car, Qletx)
-            || EQ (car, Qsave_excursion)
-            || EQ (car, Qprogn))
+      while (!NILP (vals))
        {
-         while (CONSP (XCDR (input)))
-           input = XCDR (input);
-         input = XCAR (input);
-         if (!CONSP (input))
-           break;
-         car = XCAR (input);
-       }
-      if (EQ (car, Qlist))
-       {
-         Lisp_Object intail, valtail;
-         for (intail = Fcdr (input), valtail = values;
-              CONSP (valtail);
-              intail = Fcdr (intail), valtail = XCDR (valtail))
-           {
-             Lisp_Object elt;
-             elt = Fcar (intail);
-             if (CONSP (elt))
-               {
-                 Lisp_Object presflag, carelt;
-                 carelt = XCAR (elt);
-                 /* If it is (if X Y), look at Y.  */
-                 if (EQ (carelt, Qif)
-                     && NILP (Fnthcdr (make_fixnum (3), elt)))
-                   elt = Fnth (make_fixnum (2), elt);
-                 /* If it is (when ... Y), look at Y.  */
-                 else if (EQ (carelt, Qwhen))
-                   {
-                     while (CONSP (XCDR (elt)))
-                       elt = XCDR (elt);
-                     elt = Fcar (elt);
-                   }
-
-                 /* If the function call we're looking at
-                    is a special preserved one, copy the
-                    whole expression for this argument.  */
-                 if (CONSP (elt))
-                   {
-                     presflag = Fmemq (Fcar (elt), preserved_fns);
-                     if (!NILP (presflag))
-                       Fsetcar (valtail, Fcar (intail));
-                   }
-               }
-           }
+         Lisp_Object rep = Fassq (make_fixnum (i), reps);
+         if (!NILP (rep))
+           Fsetcar (vals, XCDR (rep));
+         vals = XCDR (vals);
+         ++i;
        }
     }
 
@@ -235,31 +195,28 @@ fix_command (Lisp_Object input, Lisp_Object function, 
Lisp_Object values)
      optional, remove them from the list.  This makes navigating the
      history less confusing, since it doesn't contain a lot of
      parameters that aren't used.  */
-  if (CONSP (values))
+  Lisp_Object arity = Ffunc_arity (function);
+  /* We don't want to do this simplification if we have an &rest
+     function, because (cl-defun foo (a &optional (b 'zot)) ..)
+     etc.  */
+  if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity)))
     {
-      Lisp_Object arity = Ffunc_arity (function);
-      /* We don't want to do this simplification if we have an &rest
-        function, because (cl-defun foo (a &optional (b 'zot)) ..)
-        etc.  */
-      if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity)))
+      Lisp_Object final = Qnil;
+      ptrdiff_t final_i = 0, i = 0;
+      for (Lisp_Object tail = values;
+          CONSP (tail);
+          tail = XCDR (tail), ++i)
        {
-         Lisp_Object final = Qnil;
-         ptrdiff_t final_i = 0, i = 0;
-         for (Lisp_Object tail = values;
-              CONSP (tail);
-              tail = XCDR (tail), ++i)
+         if (!NILP (XCAR (tail)))
            {
-             if (!NILP (XCAR (tail)))
-               {
-                 final = tail;
-                 final_i = i;
-               }
+             final = tail;
+             final_i = i;
            }
-
-         /* Chop the trailing optional values.  */
-         if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1)
-           XSETCDR (final,  Qnil);
        }
+
+      /* Chop the trailing optional values.  */
+      if (final_i > 0 && final_i >= XFIXNUM (XCAR (arity)) - 1)
+       XSETCDR (final,  Qnil);
     }
 }
 
@@ -950,4 +907,6 @@ use `event-start', `event-end', and `event-click-count'.  
*/);
   defsubr (&Scall_interactively);
   defsubr (&Sfuncall_interactively);
   defsubr (&Sprefix_numeric_value);
+
+  DEFSYM (Qinteractive_args, "interactive-args");
 }
diff --git a/test/src/callint-tests.el b/test/src/callint-tests.el
index d964fc3c1f..5a633fdc2b 100644
--- a/test/src/callint-tests.el
+++ b/test/src/callint-tests.el
@@ -52,4 +52,17 @@
       (call-interactively #'ignore t))
     (should (= (length command-history) history-length))))
 
+(defun callint-test-int-args (foo bar &optional zot)
+  (declare (interactive-args
+            (bar 10)
+            (zot 11)))
+  (interactive (list 1 1 1))
+  (+ foo bar zot))
+
+(ert-deftest test-interactive-args ()
+  (let ((history-length 1)
+        (command-history ()))
+    (should (= (call-interactively 'callint-test-int-args t) 3))
+    (should (equal command-history '((callint-test-int-args 1 10 11))))))
+
 ;;; callint-tests.el ends here