From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#54802: OClosure: Make `interactive-form` a generic function Date: Tue, 19 Apr 2022 13:52:10 -0400 Message-ID: References: <837d7luj3d.fsf@gnu.org> Reply-To: Stefan Monnier Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="13940"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (gnu/linux) Cc: 54802@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Apr 19 19:53:15 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ngs2L-0003Nx-VN for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 19 Apr 2022 19:53:14 +0200 Original-Received: from localhost ([::1]:48876 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ngs2K-0000tR-CV for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 19 Apr 2022 13:53:12 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:42874) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ngs2A-0000sw-JM for bug-gnu-emacs@gnu.org; Tue, 19 Apr 2022 13:53:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]:50175) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ngs2A-0003UK-9I for bug-gnu-emacs@gnu.org; Tue, 19 Apr 2022 13:53:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ngs2A-0003db-7N for bug-gnu-emacs@gnu.org; Tue, 19 Apr 2022 13:53:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Stefan Monnier Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 19 Apr 2022 17:53:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 54802 X-GNU-PR-Package: emacs Original-Received: via spool by 54802-submit@debbugs.gnu.org id=B54802.165039074413937 (code B ref 54802); Tue, 19 Apr 2022 17:53:02 +0000 Original-Received: (at 54802) by debbugs.gnu.org; 19 Apr 2022 17:52:24 +0000 Original-Received: from localhost ([127.0.0.1]:44072 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ngs1X-0003cg-LK for submit@debbugs.gnu.org; Tue, 19 Apr 2022 13:52:24 -0400 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]:21844) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ngs1V-0003cT-F7 for 54802@debbugs.gnu.org; Tue, 19 Apr 2022 13:52:22 -0400 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id D28F580664; Tue, 19 Apr 2022 13:52:15 -0400 (EDT) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id B517480539; Tue, 19 Apr 2022 13:52:12 -0400 (EDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1650390732; bh=hlUK/I3CH9q+8bv0juc/XuPT1azXqiiWuWuZpk/t3Sg=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=R8pFQ/TZ4wdn3j2PM9idXXcYTVWFGT08rQAWdeg+yx5BcfVBK3cVwtb67jPD3M0ju G6ucsSzHpGkrYwP1GFsoWbopXcA3fG/T5kiSatJIW+vW+v2v4LDm6mhnHvA+pG+1BL FP3026V1J1yykwYjDOijUYVD2HKZuDmuNUTOE50/wGt3yDiJSIlOrmdE5/aYZLCBIY l4rLp05BRN8q002u9nYD791vO/OozWrkbUImzN2Hf3z1QRr/cuyuibyK1DGsAksZlb RNIcK5P26v9pSegqgqco6Ix3ZfsGIxI6i7sUX+jsc5Djet8CoxdDI7JR29+oBoZAYH gdAidr9De+NTQ== Original-Received: from alfajor (modemcable124.78-161-184.mc.videotron.ca [184.161.78.124]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 7AE56120218; Tue, 19 Apr 2022 13:52:12 -0400 (EDT) In-Reply-To: <837d7luj3d.fsf@gnu.org> (Eli Zaretskii's message of "Tue, 19 Apr 2022 19:35:34 +0300") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:230254 Archived-At: > 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 ))` 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 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 =3D AREF (fun, COMPILED_DOC_STRING); >> + if (!(NILP (doc) || VALID_DOCSTRING_P (doc))) >> + genfun =3D 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 =3D false; /* If true, we should consult `interactive-for= m`. */ > 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 =20 @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 opti= on Allows the creation of "functions with slots" or "function objects" via the macros 'oclosure-define' and 'oclosure-lambda'. =20 +*** 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)))) =20 +(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: =CE=B7-reduce! =20 +;; This should be in `oclosure.el' but that file is loaded before `cl-gene= ric'. +(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-fo= rm' +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 =3D Qnil; =20 /* Set SPECS to the interactive form, or barf if not interactive. */ - Lisp_Object form =3D Finteractive_form (function); + Lisp_Object form =3D call1 (Qinteractive_form, function); if (! CONSP (form)) wrong_type_argument (Qcommandp, function); Lisp_Object specs =3D 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, Sintera= ctive_form, 1, 1, 0, (Lisp_Object cmd) { Lisp_Object fun =3D indirect_function (cmd); /* Check cycles. */ + bool genfun =3D false; =20 if (NILP (fun)) return Qnil; @@ -1113,6 +1114,12 @@ DEFUN ("interactive-form", Finteractive_form, Sinter= active_form, 1, 1, 0, /* Old form -- just the interactive spec. */ return list2 (Qinteractive, form); } + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc =3D AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun =3D !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -1135,13 +1142,21 @@ DEFUN ("interactive-form", Finteractive_form, Sinte= ractive_form, 1, 1, 0, if (EQ (funcar, Qclosure)) form =3D Fcdr (form); Lisp_Object spec =3D 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 =3D 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; } =20 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"); =20 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 of= fset) 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 =3D Qnil; + bool genfun =3D false; /* If true, we should consult `interactive-form'.= */ =20 fun =3D function; =20 @@ -2041,52 +2040,89 @@ DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0, if (NILP (fun)) return Qnil; =20 - /* Check an `interactive-form' property if present, analogous to the - function-documentation property. */ - fun =3D function; - while (SYMBOLP (fun)) - { - Lisp_Object tmp =3D Fget (fun, Qinteractive_form); - if (!NILP (tmp)) - if_prop =3D Qt; - fun =3D 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 =3D AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun =3D !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } + } =20 #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 =20 /* Strings and vectors are keyboard macros. */ - if (STRINGP (fun) || VECTORP (fun)) + else if (STRINGP (fun) || VECTORP (fun)) return (NILP (for_call_interactively) ? Qt : Qnil); =20 /* Lists may represent commands. */ if (!CONSP (fun)) return Qnil; - funcar =3D 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 =3D XCAR (fun); + if (EQ (funcar, Qautoload)) + { + if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun)))))) + return Qt; + } + else + { + Lisp_Object body =3D CDR_SAFE (XCDR (fun)); + if (EQ (funcar, Qclosure)) + body =3D 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 =3D 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 =3D function; + while (SYMBOLP (fun)) + { + Lisp_Object tmp =3D Fget (fun, Qinteractive_form); + if (!NILP (tmp)) + error ("Found an 'interactive-form' property!"); + fun =3D 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 =3D 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; } =20 +/* 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))))))) =20 +(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))