From ffc81ebc4b5d6cfc827e6a08679da55134f73fb5 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 8 Aug 2022 15:52:19 +0200 Subject: [PATCH] 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 8e8cc5fd9c0..8265e58210e 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 9370bd3a097..4a2860cd43d 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 ab9ac17ed9c..cac0edf43ac 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 ffa3b231eb5..dfc479284c0 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 d964fc3c1f3..5a633fdc2bd 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 -- 2.39.2