1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 10:31:37 -08:00

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'.
This commit is contained in:
Lars Ingebrigtsen 2022-08-08 15:52:19 +02:00
parent 498c5d26bb
commit ffc81ebc4b
5 changed files with 73 additions and 79 deletions

View file

@ -2498,6 +2498,10 @@ the current buffer.
Specify that this command is meant to be applicable for @var{modes} Specify that this command is meant to be applicable for @var{modes}
only. 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}) @item (pure @var{val})
If @var{val} is non-@code{nil}, this function is @dfn{pure} 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} (@pxref{What Is a Function}). This is the same as the @code{pure}

View file

@ -236,6 +236,20 @@ The return value of this function is not used."
(list 'function-put (list 'quote f) (list 'function-put (list 'quote f)
''command-modes (list 'quote val)))) ''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'. ;; Add any new entries to info node `(elisp)Declare Form'.
(defvar defun-declarations-alist (defvar defun-declarations-alist
(list (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 'indent #'byte-run--set-indent)
(list 'speed #'byte-run--set-speed) (list 'speed #'byte-run--set-speed)
(list 'completion #'byte-run--set-completion) (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. "List associating function properties to their macro expansion.
Each element of the list takes the form (PROP FUN) where FUN is Each element of the list takes the form (PROP FUN) where FUN is
a function. For each (PROP . VALUES) in a function's declaration, a function. For each (PROP . VALUES) in a function's declaration,

View file

@ -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 \(You may need a more complex loop if FROM-STRING can match the null string
and TO-STRING is also null.)" and TO-STRING is also null.)"
(declare (interactive-only (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 (interactive
(let ((common (let ((common
(query-replace-read-args (query-replace-read-args

View file

@ -161,10 +161,8 @@ check_mark (bool for_region)
xsignal0 (Qmark_inactive); xsignal0 (Qmark_inactive);
} }
/* If the list of args INPUT was produced with an explicit call to /* If FUNCTION has an `interactive-args' spec, replace relevant
`list', look for elements that were computed with elements in VALUES with those forms instead.
(region-beginning) or (region-end), and put those expressions into
VALUES instead of the present values.
This function doesn't return a value because it modifies elements This function doesn't return a value because it modifies elements
of VALUES to do its job. */ of VALUES to do its job. */
@ -172,62 +170,24 @@ check_mark (bool for_region)
static void static void
fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values) fix_command (Lisp_Object input, Lisp_Object function, Lisp_Object values)
{ {
/* FIXME: Instead of this ugly hack, we should provide a way for an /* Quick exit if there's no values to alter. */
interactive spec to return an expression/function that will re-build the if (!CONSP (values))
args without user intervention. */ return;
if (CONSP (input))
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); while (!NILP (vals))
/* Skip through certain special forms. */
while (EQ (car, Qlet) || EQ (car, Qletx)
|| EQ (car, Qsave_excursion)
|| EQ (car, Qprogn))
{ {
while (CONSP (XCDR (input))) Lisp_Object rep = Fassq (make_fixnum (i), reps);
input = XCDR (input); if (!NILP (rep))
input = XCAR (input); Fsetcar (vals, XCDR (rep));
if (!CONSP (input)) vals = XCDR (vals);
break; ++i;
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));
}
}
}
} }
} }
@ -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 optional, remove them from the list. This makes navigating the
history less confusing, since it doesn't contain a lot of history less confusing, since it doesn't contain a lot of
parameters that aren't used. */ 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); Lisp_Object final = Qnil;
/* We don't want to do this simplification if we have an &rest ptrdiff_t final_i = 0, i = 0;
function, because (cl-defun foo (a &optional (b 'zot)) ..) for (Lisp_Object tail = values;
etc. */ CONSP (tail);
if (FIXNUMP (XCAR (arity)) && FIXNUMP (XCDR (arity))) tail = XCDR (tail), ++i)
{ {
Lisp_Object final = Qnil; if (!NILP (XCAR (tail)))
ptrdiff_t final_i = 0, i = 0;
for (Lisp_Object tail = values;
CONSP (tail);
tail = XCDR (tail), ++i)
{ {
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 (&Scall_interactively);
defsubr (&Sfuncall_interactively); defsubr (&Sfuncall_interactively);
defsubr (&Sprefix_numeric_value); defsubr (&Sprefix_numeric_value);
DEFSYM (Qinteractive_args, "interactive-args");
} }

View file

@ -52,4 +52,17 @@
(call-interactively #'ignore t)) (call-interactively #'ignore t))
(should (= (length command-history) history-length)))) (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 ;;; callint-tests.el ends here