emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

master da0e75e: Add facility to make module functions interactive (Bug#2


From: Philipp Stephani
Subject: master da0e75e: Add facility to make module functions interactive (Bug#23486).
Date: Sun, 13 Sep 2020 14:50:08 -0400 (EDT)

branch: master
commit da0e75e7410226d7fd6d760f0ebe8a04d815506d
Author: Philipp Stephani <phst@google.com>
Commit: Philipp Stephani <phst@google.com>

    Add facility to make module functions interactive (Bug#23486).
    
    * src/module-env-28.h: Add field for 'make_interactive' function.
    
    * src/emacs-module.c (Lisp_Module_Function): Add new field holding the
    interactive form.
    (allocate_module_function): Adapt to structure layout change.
    (module_make_interactive, module_function_interactive_form): New
    functions.
    (initialize_environment): Use them.
    
    * src/eval.c (Fcommandp):
    * src/data.c (Finteractive_form): Also handle interactive module
    functions.
    
    * test/data/emacs-module/mod-test.c (Fmod_test_identity): New test
    function.
    (emacs_module_init): Create two interactive module test functions.
    
    * test/src/emacs-module-tests.el (module/interactive/return-t)
    (module/interactive/return-t-int, module/interactive/identity):
    New unit tests.
    
    * doc/lispref/internals.texi (Module Functions): Document new
    function.  Rework paragraph about wrapping module functions, as the
    example no longer applies.
    
    * etc/NEWS: Document new facility.
---
 doc/lispref/internals.texi        | 46 +++++++++++++++++++++++++++------------
 etc/NEWS                          |  4 ++++
 src/data.c                        |  7 ++++++
 src/emacs-module.c                | 23 ++++++++++++++++++--
 src/eval.c                        |  7 ++++++
 src/lisp.h                        |  2 ++
 src/module-env-28.h               |  4 ++++
 test/data/emacs-module/mod-test.c | 21 ++++++++++++++++++
 test/src/emacs-module-tests.el    | 32 +++++++++++++++++++++++++++
 9 files changed, 130 insertions(+), 16 deletions(-)

diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index d70c354..cc18b85 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1425,28 +1425,46 @@ violations of the above requirements.  @xref{Initial 
Options,,,emacs,
 The GNU Emacs Manual}.
 
 Using the module @acronym{API}, it is possible to define more complex
-function and data types: interactive functions, inline functions,
-macros, etc.  However, the resulting C code will be cumbersome and
-hard to read.  Therefore, we recommend that you limit the module code
-which creates functions and data structures to the absolute minimum,
-and leave the rest for a Lisp package that will accompany your module,
-because doing these additional tasks in Lisp is much easier, and will
-produce a much more readable code.  For example, given a module
-function @code{module-func} defined as above, one way of making an
-interactive command @code{module-cmd} based on it is with the
-following simple Lisp wrapper:
+function and data types: inline functions, macros, etc.  However, the
+resulting C code will be cumbersome and hard to read.  Therefore, we
+recommend that you limit the module code which creates functions and
+data structures to the absolute minimum, and leave the rest for a Lisp
+package that will accompany your module, because doing these
+additional tasks in Lisp is much easier, and will produce a much more
+readable code.  For example, given a module function
+@code{module-func} defined as above, one way of making a macro
+@code{module-macro} based on it is with the following simple Lisp
+wrapper:
 
 @lisp
-(defun module-cmd (&rest args)
-  "Documentation string for the command."
-  (interactive @var{spec})
-  (apply 'module-func args))
+(defmacro module-macro (&rest args)
+  "Documentation string for the macro."
+  (module-func args))
 @end lisp
 
 The Lisp package which goes with your module could then load the
 module using the @code{load} primitive (@pxref{Dynamic Modules}) when
 the package is loaded into Emacs.
 
+By default, module functions created by @code{make_function} are not
+interactive.  To make them interactive, you can use the following
+function.
+
+@deftypefun void make_interactive (emacs_env *@var{env}, emacs_value 
@var{function}, emacs_value @var{spec})
+This function, which is available since Emacs 28, makes the function
+@var{function} interactive using the interactive specification
+@var{spec}.  Emacs interprets @var{spec} like the argument to the
+@code{interactive} form.  @ref{Using Interactive}, and
+@pxref{Interactive Codes}.  @var{function} must be an Emacs module
+function returned by @code{make_function}.
+@end deftypefun
+
+Note that there is no native module support for retrieving the
+interactive specification of a module function.  Use the function
+@code{interactive-form} for that.  @ref{Using Interactive}.  It is not
+possible to make a module function non-interactive once you have made
+it interactive using @code{make_interactive}.
+
 @anchor{Module Function Finalizers}
 If you want to run some code when a module function object (i.e., an
 object returned by @code{make_function}) is garbage-collected, you can
diff --git a/etc/NEWS b/etc/NEWS
index db2adce..52092f2 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1347,6 +1347,10 @@ This removes the final remaining trace of old-style 
backquotes.
 'emacs_function' and 'emacs_finalizer' for module functions and
 finalizers, respectively.
 
+** Module functions can now be made interactive.  Use
+'make_interactive' to give a module function an interactive
+specification.
+
 ** Module functions can now install an optional finalizer that is
 called when the function object is garbage-collected.  Use
 'set_function_finalizer' to set the finalizer and
diff --git a/src/data.c b/src/data.c
index 59d1481..dae8b10 100644
--- a/src/data.c
+++ b/src/data.c
@@ -906,6 +906,13 @@ Value, if non-nil, is a list (interactive SPEC).  */)
       if (PVSIZE (fun) > COMPILED_INTERACTIVE)
        return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
     }
+  else if (MODULE_FUNCTIONP (fun))
+    {
+      Lisp_Object form
+        = module_function_interactive_form (XMODULE_FUNCTION (fun));
+      if (! NILP (form))
+        return form;
+    }
   else if (AUTOLOADP (fun))
     return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
   else if (CONSP (fun))
diff --git a/src/emacs-module.c b/src/emacs-module.c
index a0bab11..3581daa 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -551,7 +551,7 @@ struct Lisp_Module_Function
   union vectorlike_header header;
 
   /* Fields traced by GC; these must come first.  */
-  Lisp_Object documentation;
+  Lisp_Object documentation, interactive_form;
 
   /* Fields ignored by GC.  */
   ptrdiff_t min_arity, max_arity;
@@ -564,7 +564,7 @@ static struct Lisp_Module_Function *
 allocate_module_function (void)
 {
   return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
-                                documentation, PVEC_MODULE_FUNCTION);
+                                interactive_form, PVEC_MODULE_FUNCTION);
 }
 
 #define XSET_MODULE_FUNCTION(var, ptr) \
@@ -630,6 +630,24 @@ module_finalize_function (const struct 
Lisp_Module_Function *func)
     func->finalizer (func->data);
 }
 
+static void
+module_make_interactive (emacs_env *env, emacs_value function, emacs_value 
spec)
+{
+  MODULE_FUNCTION_BEGIN ();
+  Lisp_Object lisp_fun = value_to_lisp (function);
+  CHECK_MODULE_FUNCTION (lisp_fun);
+  Lisp_Object lisp_spec = value_to_lisp (spec);
+  /* Normalize (interactive nil) to (interactive). */
+  XMODULE_FUNCTION (lisp_fun)->interactive_form
+    = NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive, 
lisp_spec);
+}
+
+Lisp_Object
+module_function_interactive_form (const struct Lisp_Module_Function *fun)
+{
+  return fun->interactive_form;
+}
+
 static emacs_value
 module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
                emacs_value *args)
@@ -1463,6 +1481,7 @@ initialize_environment (emacs_env *env, struct 
emacs_env_private *priv)
   env->get_function_finalizer = module_get_function_finalizer;
   env->set_function_finalizer = module_set_function_finalizer;
   env->open_channel = module_open_channel;
+  env->make_interactive = module_make_interactive;
   Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
   return env;
 }
diff --git a/src/eval.c b/src/eval.c
index 126ee2e..fdc3cd1 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1948,6 +1948,13 @@ then strings and vectors are not accepted.  */)
   else if (COMPILEDP (fun))
     return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
 
+  /* 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;
+
   /* Strings and vectors are keyboard macros.  */
   if (STRINGP (fun) || VECTORP (fun))
     return (NILP (for_call_interactively) ? Qt : Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index 88e69b9..a248980 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4210,6 +4210,8 @@ extern Lisp_Object funcall_module (Lisp_Object, 
ptrdiff_t, Lisp_Object *);
 extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
 extern Lisp_Object module_function_documentation
   (struct Lisp_Module_Function const *);
+extern Lisp_Object module_function_interactive_form
+  (const struct Lisp_Module_Function *);
 extern module_funcptr module_function_address
   (struct Lisp_Module_Function const *);
 extern void *module_function_data (const struct Lisp_Module_Function *);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index 5d884c1..40b03b9 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -12,3 +12,7 @@
 
   int (*open_channel) (emacs_env *env, emacs_value pipe_process)
     EMACS_ATTRIBUTE_NONNULL (1);
+
+  void (*make_interactive) (emacs_env *env, emacs_value function,
+                            emacs_value spec)
+    EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/test/data/emacs-module/mod-test.c 
b/test/data/emacs-module/mod-test.c
index 37186fc..da298d4 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -673,6 +673,14 @@ Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, 
emacs_value *args,
   return env->intern (env, "nil");
 }
 
+static emacs_value
+Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                    void *data)
+{
+  assert (nargs == 1);
+  return args[0];
+}
+
 /* Lisp utilities for easier readability (simple wrappers).  */
 
 /* Provide FEATURE to Emacs.  */
@@ -764,6 +772,19 @@ emacs_module_init (struct emacs_runtime *ert)
 
 #undef DEFUN
 
+  emacs_value constant_fn
+    = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL);
+  env->make_interactive (env, constant_fn, env->intern (env, "nil"));
+  bind_function (env, "mod-test-return-t-int", constant_fn);
+
+  emacs_value identity_fn
+    = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL);
+  const char *interactive_spec = "i";
+  env->make_interactive (env, identity_fn,
+                         env->make_string (env, interactive_spec,
+                                           strlen (interactive_spec)));
+  bind_function (env, "mod-test-identity", identity_fn);
+
   provide (env, "mod-test");
   return 0;
 }
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 096c6b3..1eebb41 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -468,4 +468,36 @@ See Bug#36226."
             (should (equal (buffer-string) "data from thread")))
         (delete-process process)))))
 
+(ert-deftest module/interactive/return-t ()
+  (should (functionp (symbol-function #'mod-test-return-t)))
+  (should (module-function-p (symbol-function #'mod-test-return-t)))
+  (should-not (commandp #'mod-test-return-t))
+  (should-not (commandp (symbol-function #'mod-test-return-t)))
+  (should-not (interactive-form #'mod-test-return-t))
+  (should-not (interactive-form (symbol-function #'mod-test-return-t)))
+  (should-error (call-interactively #'mod-test-return-t)
+                :type 'wrong-type-argument))
+
+(ert-deftest module/interactive/return-t-int ()
+  (should (functionp (symbol-function #'mod-test-return-t-int)))
+  (should (module-function-p (symbol-function #'mod-test-return-t-int)))
+  (should (commandp #'mod-test-return-t-int))
+  (should (commandp (symbol-function #'mod-test-return-t-int)))
+  (should (equal (interactive-form #'mod-test-return-t-int) '(interactive)))
+  (should (equal (interactive-form (symbol-function #'mod-test-return-t-int))
+                 '(interactive)))
+  (should (eq (mod-test-return-t-int) t))
+  (should (eq (call-interactively #'mod-test-return-t-int) t)))
+
+(ert-deftest module/interactive/identity ()
+  (should (functionp (symbol-function #'mod-test-identity)))
+  (should (module-function-p (symbol-function #'mod-test-identity)))
+  (should (commandp #'mod-test-identity))
+  (should (commandp (symbol-function #'mod-test-identity)))
+  (should (equal (interactive-form #'mod-test-identity) '(interactive "i")))
+  (should (equal (interactive-form (symbol-function #'mod-test-identity))
+                 '(interactive "i")))
+  (should (eq (mod-test-identity 123) 123))
+  (should-not (call-interactively #'mod-test-identity)))
+
 ;;; emacs-module-tests.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]