Package: emacs;
Reported by: Stefan Monnier <monnier <at> iro.umontreal.ca>
Date: Fri, 8 Apr 2022 20:35:01 UTC
Severity: normal
Found in version 29.0.50
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 54802 <at> debbugs.gnu.org Subject: bug#54802: OClosure: Make `interactive-form` a generic function Date: Tue, 19 Apr 2022 13:52:10 -0400
> Thanks. A few minor comments below:
See updated patch after my sig.
> I think oclosure-interactive-form should be documented in more detail,
> since we will probably see it used more and more in the future. E.g.,
> we should say something about all those "additional methods" that are
> only hinted above.
I tried to do that. Let me know if that fits your expectations.
> So suppose we'd like later to modify the interactive form of kmacro to
> use Lisp code instead of just the "p" thing -- how should we go about
> that? Does oclosure-interactive-form accept everything that
> 'interactive' accepts?
Currently, it is fundamentally defined not by the syntax of the
`interactive` thingy in source code but by what `call-interactively`
expects as return value of `interactive-form`.
So yes, it can return `(interactive (list <foo> <bar>))` just fine.
OTOH it currently doesn't offer any way to have an OClosure with
a non-nil `command-modes`.
I.e. if you return (interactive (list <foo> gomoku-mode)) the
`gomoku-mode` part will not be understood as a `commands-mode` spec and
may even cause trouble since `interactive-form` is not expected to
return something of this form (tho most callers just extract the
form with `cadr` and just ignore any extra elements).
Maybe you're right that we should define the return value as "whatever is
accepted in the `interactive` source thingy", and then arrange for
`command-modes` to delegate to `oclosure-interactive-mode`?
> Does it use the same syntax, or will we need
> to use some special quoting there?
No special quoting, no.
> I also wonder whether this will make commands harder to spot just by
> looking at their code than it is now.
Indeed, it is better not to abuse it.
>> + else if (PVSIZE (fun) > COMPILED_DOC_STRING)
>> + {
>> + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
>> + if (!(NILP (doc) || VALID_DOCSTRING_P (doc)))
>> + genfun = true;
>> + }
>
> There should be a comment there explaining the significance of
> comparison with COMPILED_DOC_STRING and why this turns on the genfun
> flag.
Added.
>> + bool genfun = false; /* If true, we should consult `interactive-form`. */
> Please don't use Markdown-style quoting in code comments.
Duh, sorry, they were "everywhere".
>> /* Lists may represent commands. */
>> - if (!CONSP (fun))
>> + else if (!CONSP (fun))
>> return Qnil;
>
> I don't understand why you replace 'if' with 'else if' here: are they
> just stylistic preferences? If so, I'd prefer to leave the original
> code intact where it doesn't have to be changed.
That was a left over from an earlier code reorg.
Stefan
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ace0c025512..6c60216796c 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -312,6 +312,25 @@ Using Interactive
specifies how to compute its arguments. Otherwise, the value is
@code{nil}. If @var{function} is a symbol, its function definition is
used.
+When called on an OClosure, the work is delegated to the generic
+function @code{oclosure-interactive-form}.
+@end defun
+
+@defun oclosure-interactive-form function
+Just like @code{interactive-form}, this function takes a command and
+returns its interactive form. The difference is that it is a generic
+function and it is only called when @var{function} is an OClosure.
+The purpose is to make it possible for some OClosure types to compute
+their interactive forms dynamically instead of carrying it in one of
+their slots.
+
+This is used for example for @code{kmacro} functions in order to
+reduce their memory size, since they all share the same interactive
+form. It is also used for @code{advice} functions, where the
+interactive form is computed from the interactive forms of its
+components, so as to make this computation more lazily and to
+correctly adjust the interactive form when one of its component's
+is redefined.
@end defun
@node Interactive Codes
diff --git a/etc/NEWS b/etc/NEWS
index 3442ebd81b3..62b7128fea5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1292,6 +1292,11 @@ remote host are shown. Alternatively, the user option
Allows the creation of "functions with slots" or "function objects"
via the macros 'oclosure-define' and 'oclosure-lambda'.
+*** New generic function 'oclosure-interactive-form'.
+Used by 'interactive-form' when called on an OClosure.
+This allows specific OClosure types to compute their interactive specs
+on demand rather than precompute them when created.
+
---
** New theme 'leuven-dark'.
This is a dark version of the 'leuven' theme.
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 8a9d89929eb..5476c2395ca 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -820,13 +820,14 @@ kmacro
(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))))
+(cl-defmethod oclosure-interactive-form ((_ kmacro)) '(interactive "p"))
+
;;;###autoload
(defun kmacro-lambda-form (mac &optional counter format)
;; Apparently, there are two different ways this is called:
diff --git a/lisp/simple.el b/lisp/simple.el
index 7e964c9d1d5..ead973d45e0 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2389,6 +2389,15 @@ function-documentation
(cl-defmethod function-documentation ((function accessor))
(oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
+;; This should be in `oclosure.el' but that file is loaded before `cl-generic'.
+(cl-defgeneric oclosure-interactive-form (_function)
+ "Return the interactive form of FUNCTION or nil if none.
+This is called by `interactive-form' when invoked on OClosures.
+Add your methods to this generic function, but always call `interactive-form'
+instead."
+ ;; (interactive-form function)
+ nil)
+
(defun command-execute (cmd &optional record-flag keys special)
;; BEWARE: Called directly from the C code.
"Execute CMD as an editor command.
diff --git a/src/callint.c b/src/callint.c
index 31919d6bb81..92bfaf8d397 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -315,7 +315,7 @@ DEFUN ("call-interactively", Fcall_interactively, Scall_interactively, 1, 3, 0,
Lisp_Object up_event = Qnil;
/* Set SPECS to the interactive form, or barf if not interactive. */
- Lisp_Object form = Finteractive_form (function);
+ Lisp_Object form = call1 (Qinteractive_form, function);
if (! CONSP (form))
wrong_type_argument (Qcommandp, function);
Lisp_Object specs = Fcar (XCDR (form));
diff --git a/src/data.c b/src/data.c
index 72af8a6648e..e9aad75f59b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1072,6 +1072,7 @@ DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
(Lisp_Object cmd)
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
+ bool genfun = false;
if (NILP (fun))
return Qnil;
@@ -1113,6 +1114,12 @@ DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
/* Old form -- just the interactive spec. */
return list2 (Qinteractive, form);
}
+ else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+ {
+ Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
+ /* An invalid "docstring" is a sign that we have an OClosure. */
+ genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
+ }
}
#ifdef HAVE_MODULES
else if (MODULE_FUNCTIONP (fun))
@@ -1135,13 +1142,21 @@ DEFUN ("interactive-form", Finteractive_form, Sinteractive_form, 1, 1, 0,
if (EQ (funcar, Qclosure))
form = Fcdr (form);
Lisp_Object spec = Fassq (Qinteractive, form);
- if (NILP (Fcdr (Fcdr (spec))))
+ if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form)))
+ /* A "docstring" is a sign that we may have an OClosure. */
+ genfun = true;
+ else if (NILP (Fcdr (Fcdr (spec))))
return spec;
else
return list2 (Qinteractive, Fcar (Fcdr (spec)));
}
}
- return Qnil;
+ if (genfun
+ /* Avoid burping during bootstrap. */
+ && !NILP (Fsymbol_function (Qoclosure_interactive_form)))
+ return call1 (Qoclosure_interactive_form, fun);
+ else
+ return Qnil;
}
DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0,
@@ -4123,6 +4138,7 @@ syms_of_data (void)
DEFSYM (Qchar_table_p, "char-table-p");
DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p");
DEFSYM (Qfixnum_or_symbol_with_pos_p, "fixnum-or-symbol-with-pos-p");
+ DEFSYM (Qoclosure_interactive_form, "oclosure-interactive-form");
DEFSYM (Qsubrp, "subrp");
DEFSYM (Qunevalled, "unevalled");
diff --git a/src/doc.c b/src/doc.c
index 5326195c6a0..71e66853b08 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -469,9 +469,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
if (PVSIZE (fun) > COMPILED_DOC_STRING
/* Don't overwrite a non-docstring value placed there,
* such as the symbols used for Oclosures. */
- && (FIXNUMP (AREF (fun, COMPILED_DOC_STRING))
- || STRINGP (AREF (fun, COMPILED_DOC_STRING))
- || CONSP (AREF (fun, COMPILED_DOC_STRING))))
+ && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING)))
ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset));
else
{
diff --git a/src/eval.c b/src/eval.c
index 37bc03465cc..1de59518381 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2032,8 +2032,7 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
(Lisp_Object function, Lisp_Object for_call_interactively)
{
register Lisp_Object fun;
- register Lisp_Object funcar;
- Lisp_Object if_prop = Qnil;
+ bool genfun = false; /* If true, we should consult `interactive-form'. */
fun = function;
@@ -2041,52 +2040,89 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
if (NILP (fun))
return Qnil;
- /* Check an `interactive-form' property if present, analogous to the
- function-documentation property. */
- fun = function;
- while (SYMBOLP (fun))
- {
- Lisp_Object tmp = Fget (fun, Qinteractive_form);
- if (!NILP (tmp))
- if_prop = Qt;
- fun = Fsymbol_function (fun);
- }
-
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
if (SUBRP (fun))
- return XSUBR (fun)->intspec.string ? Qt : if_prop;
-
+ {
+ if (XSUBR (fun)->intspec.string)
+ return Qt;
+ }
/* Bytecode objects are interactive if they are long enough to
have an element whose index is COMPILED_INTERACTIVE, which is
where the interactive spec is stored. */
else if (COMPILEDP (fun))
- return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
+ {
+ if (PVSIZE (fun) > COMPILED_INTERACTIVE)
+ return Qt;
+ else if (PVSIZE (fun) > COMPILED_DOC_STRING)
+ {
+ Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING);
+ /* An invalid "docstring" is a sign that we have an OClosure. */
+ genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc));
+ }
+ }
#ifdef HAVE_MODULES
/* Module functions are interactive if their `interactive_form'
field is non-nil. */
else if (MODULE_FUNCTIONP (fun))
- return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
- ? if_prop
- : Qt;
+ {
+ if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))))
+ return Qt;
+ }
#endif
/* Strings and vectors are keyboard macros. */
- if (STRINGP (fun) || VECTORP (fun))
+ else if (STRINGP (fun) || VECTORP (fun))
return (NILP (for_call_interactively) ? Qt : Qnil);
/* Lists may represent commands. */
if (!CONSP (fun))
return Qnil;
- funcar = XCAR (fun);
- if (EQ (funcar, Qclosure))
- return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))))
- ? Qt : if_prop);
- else if (EQ (funcar, Qlambda))
- return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop;
- else if (EQ (funcar, Qautoload))
- return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop;
+ else
+ {
+ Lisp_Object funcar = XCAR (fun);
+ if (EQ (funcar, Qautoload))
+ {
+ if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))))
+ return Qt;
+ }
+ else
+ {
+ Lisp_Object body = CDR_SAFE (XCDR (fun));
+ if (EQ (funcar, Qclosure))
+ body = CDR_SAFE (body);
+ else if (!EQ (funcar, Qlambda))
+ return Qnil;
+ if (!NILP (Fassq (Qinteractive, body)))
+ return Qt;
+ else if (VALID_DOCSTRING_P (CAR_SAFE (body)))
+ /* A "docstring" is a sign that we may have an OClosure. */
+ genfun = true;
+ }
+ }
+
+ /* By now, if it's not a function we already returned nil. */
+
+ /* Check an `interactive-form' property if present, analogous to the
+ function-documentation property. */
+ fun = function;
+ while (SYMBOLP (fun))
+ {
+ Lisp_Object tmp = Fget (fun, Qinteractive_form);
+ if (!NILP (tmp))
+ error ("Found an 'interactive-form' property!");
+ fun = Fsymbol_function (fun);
+ }
+
+ /* If there's no immediate interactive form but it's an OClosure,
+ then delegate to the generic-function in case it has
+ a type-specific interactive-form. */
+ if (genfun)
+ {
+ Lisp_Object iform = call1 (Qinteractive_form, fun);
+ return NILP (iform) ? Qnil : Qt;
+ }
else
return Qnil;
}
diff --git a/src/lisp.h b/src/lisp.h
index 75f369f5245..1ad89fc4689 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2185,6 +2185,16 @@ XSUBR (Lisp_Object a)
return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s;
}
+/* Return whether a value might be a valid docstring.
+ Used to distinguish the presence of non-docstring in the docstring slot,
+ as in the case of OClosures. */
+INLINE bool
+VALID_DOCSTRING_P (Lisp_Object doc)
+{
+ return FIXNUMP (doc) || STRINGP (doc)
+ || (CONSP (doc) && STRINGP (XCAR (doc)) && FIXNUMP (XCDR (doc)));
+}
+
enum char_table_specials
{
/* This is the number of slots that every char table must have. This
diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el
index b6bdebc0a2b..1af40bcdab4 100644
--- a/test/lisp/emacs-lisp/oclosure-tests.el
+++ b/test/lisp/emacs-lisp/oclosure-tests.el
@@ -106,6 +106,27 @@ oclosure-test-limits
(and (eq 'error (car err))
(string-match "Duplicate slot: fst$" (cadr err)))))))
+(cl-defmethod oclosure-interactive-form ((ot oclosure-test))
+ (let ((snd (oclosure-test--snd ot)))
+ (if (stringp snd) (list 'interactive snd))))
+
+(ert-deftest oclosure-test-interactive-form ()
+ (should (equal (interactive-form
+ (oclosure-lambda (oclosure-test (fst 1) (snd 2))
+ () fst))
+ nil))
+ (should (equal (interactive-form
+ (oclosure-lambda (oclosure-test (fst 1) (snd 2))
+ ()
+ (interactive "r")
+ fst))
+ '(interactive "r")))
+ (should (equal (interactive-form
+ (oclosure-lambda (oclosure-test (fst 1) (snd "P"))
+ ()
+ fst))
+ '(interactive "P"))))
+
(oclosure-define (oclosure-test-mut
(:parent oclosure-test)
(:copier oclosure-test-mut-copy))
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.