mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-30 08:09:04 +00:00
Code Issues Releases Activity

New generic function oclosure-interactive-form

Browse Source 
It's used by `interactive-form` when it encounters an OClosure.
This lets one compute the `interactive-form` of OClosures
dynamically by adding appropriate methods.
This does not include support for `command-modes` for Oclosures.

* lisp/simple.el (oclosure-interactive-form): New generic function.

* src/data.c (Finteractive_form): Delegate to
`oclosure-interactive-form` if the arg is an OClosure.
(syms_of_data): New symbol `Qoclosure_interactive_form`.
* src/eval.c (Fcommandp): Delegate to `interactive-form` if the arg is
an OClosure.

* src/lisp.h (VALID_DOCSTRING_P): New function, extracted from
`store_function_docstring`.
* src/doc.c (store_function_docstring): Use it.

* lisp/kmacro.el (kmacro): Don't carry any interactive form.
(oclosure-interactive-form) <kmacro>: New method, instead.

* test/lisp/emacs-lisp/oclosure-tests.el (oclosure-interactive-form)
<oclosure-test>: New method.
(oclosure-test-interactive-form): New test.

* doc/lispref/commands.texi (Using Interactive):
Document `oclosure-interactive-form`.
This commit is contained in:
Stefan Monnier 2022-04-26 10:36:52 -04:00
parent 756b7cf5d9
commit bffc4cb39d
10 changed files with 166 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
doc/lispref/commands.texi
View File

@ -312,6 +312,25 @@ If @var{function} is an interactively callable function
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

5
etc/NEWS
View File

@ -1345,6 +1345,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.

3
lisp/kmacro.el
View File

@ -820,13 +820,14 @@ KEYS should be a vector or a string that obeys `key-valid-p'."
(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:

11
lisp/simple.el
View File

@ -2389,6 +2389,17 @@ function as needed."
(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.
It should return either nil or a two-element list of the form (interactive FORM)
where FORM is like the first arg of the `interactive' special form.
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.

2
src/callint.c
View File

@ -315,7 +315,7 @@ invoke it (via an `interactive' spec that contains, for instance, an
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));

32
src/data.c
View File

@ -1072,6 +1072,7 @@ Value, if non-nil, is a list (interactive SPEC). */)
(Lisp_Object cmd)
{
Lisp_Object fun = indirect_function (cmd); /* Check cycles. */
bool genfun = false;
if (NILP (fun))
return Qnil;
@ -1104,15 +1105,17 @@ Value, if non-nil, is a list (interactive SPEC). */)
if (PVSIZE (fun) > COMPILED_INTERACTIVE)
{
Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE);
if (VECTORP (form))
/* The vector form is the new form, where the first
element is the interactive spec, and the second is the
command modes. */
return list2 (Qinteractive, AREF (form, 0));
else
/* Old form -- just the interactive spec. */
return list2 (Qinteractive, form);
/* The vector form is the new form, where the first
element is the interactive spec, and the second is the
command modes. */
return list2 (Qinteractive, VECTORP (form) ? AREF (form, 0) : 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 +1138,21 @@ Value, if non-nil, is a list (interactive SPEC). */)
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 +4134,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");

4
src/doc.c
View File

@ -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
{

112
src/eval.c
View File

@ -2032,8 +2032,7 @@ then strings and vectors are not accepted. */)
(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,6 +2040,70 @@ then strings and vectors are not accepted. */)
if (NILP (fun))
return Qnil;
/* Emacs primitives are interactive if their DEFUN specifies an
interactive spec. */
if (SUBRP (fun))
{
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))
{
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))
{
if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))))
return Qt;
}
#endif
/* Strings and vectors are keyboard macros. */
else if (STRINGP (fun) || VECTORP (fun))
return (NILP (for_call_interactively) ? Qt : Qnil);
/* Lists may represent commands. */
else if (!CONSP (fun))
return Qnil;
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;
@ -2048,45 +2111,18 @@ then strings and vectors are not accepted. */)
{
Lisp_Object tmp = Fget (fun, Qinteractive_form);
if (!NILP (tmp))
if_prop = Qt;
error ("Found an 'interactive-form' property!");
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;
/* 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);
#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;
#endif
/* Strings and vectors are keyboard macros. */
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;
/* 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;
}

10
src/lisp.h
View File

@ -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

21
test/lisp/emacs-lisp/oclosure-tests.el
View File

@ -106,6 +106,27 @@
(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")))
(should (not (commandp
(oclosure-lambda (oclosure-test (fst 1) (snd 2)) () fst))))
(should (commandp
(oclosure-lambda (oclosure-test (fst 1) (snd "P")) () fst))))
(oclosure-define (oclosure-test-mut
(:parent oclosure-test)
(:copier oclosure-test-mut-copy))