aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPhilipp Stephani2020-09-13 20:21:41 +0200
committerPhilipp Stephani2020-09-13 20:26:47 +0200
commitda0e75e7410226d7fd6d760f0ebe8a04d815506d (patch)
tree1c850a5c13e3af18b7ca8cfe1b785d51300d9dde
parent3eb4e0db5ce247f8396daac3156087fbb7aefbd4 (diff)
downloademacs-da0e75e7410226d7fd6d760f0ebe8a04d815506d.tar.gz
emacs-da0e75e7410226d7fd6d760f0ebe8a04d815506d.zip
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.
-rw-r--r--doc/lispref/internals.texi46
-rw-r--r--etc/NEWS4
-rw-r--r--src/data.c7
-rw-r--r--src/emacs-module.c23
-rw-r--r--src/eval.c7
-rw-r--r--src/lisp.h2
-rw-r--r--src/module-env-28.h4
-rw-r--r--test/data/emacs-module/mod-test.c21
-rw-r--r--test/src/emacs-module-tests.el32
9 files changed, 130 insertions, 16 deletions
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index d70c3543f2a..cc18b852331 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1425,28 +1425,46 @@ violations of the above requirements. @xref{Initial Options,,,emacs,
1425The GNU Emacs Manual}. 1425The GNU Emacs Manual}.
1426 1426
1427Using the module @acronym{API}, it is possible to define more complex 1427Using the module @acronym{API}, it is possible to define more complex
1428function and data types: interactive functions, inline functions, 1428function and data types: inline functions, macros, etc. However, the
1429macros, etc. However, the resulting C code will be cumbersome and 1429resulting C code will be cumbersome and hard to read. Therefore, we
1430hard to read. Therefore, we recommend that you limit the module code 1430recommend that you limit the module code which creates functions and
1431which creates functions and data structures to the absolute minimum, 1431data structures to the absolute minimum, and leave the rest for a Lisp
1432and leave the rest for a Lisp package that will accompany your module, 1432package that will accompany your module, because doing these
1433because doing these additional tasks in Lisp is much easier, and will 1433additional tasks in Lisp is much easier, and will produce a much more
1434produce a much more readable code. For example, given a module 1434readable code. For example, given a module function
1435function @code{module-func} defined as above, one way of making an 1435@code{module-func} defined as above, one way of making a macro
1436interactive command @code{module-cmd} based on it is with the 1436@code{module-macro} based on it is with the following simple Lisp
1437following simple Lisp wrapper: 1437wrapper:
1438 1438
1439@lisp 1439@lisp
1440(defun module-cmd (&rest args) 1440(defmacro module-macro (&rest args)
1441 "Documentation string for the command." 1441 "Documentation string for the macro."
1442 (interactive @var{spec}) 1442 (module-func args))
1443 (apply 'module-func args))
1444@end lisp 1443@end lisp
1445 1444
1446The Lisp package which goes with your module could then load the 1445The Lisp package which goes with your module could then load the
1447module using the @code{load} primitive (@pxref{Dynamic Modules}) when 1446module using the @code{load} primitive (@pxref{Dynamic Modules}) when
1448the package is loaded into Emacs. 1447the package is loaded into Emacs.
1449 1448
1449By default, module functions created by @code{make_function} are not
1450interactive. To make them interactive, you can use the following
1451function.
1452
1453@deftypefun void make_interactive (emacs_env *@var{env}, emacs_value @var{function}, emacs_value @var{spec})
1454This function, which is available since Emacs 28, makes the function
1455@var{function} interactive using the interactive specification
1456@var{spec}. Emacs interprets @var{spec} like the argument to the
1457@code{interactive} form. @ref{Using Interactive}, and
1458@pxref{Interactive Codes}. @var{function} must be an Emacs module
1459function returned by @code{make_function}.
1460@end deftypefun
1461
1462Note that there is no native module support for retrieving the
1463interactive specification of a module function. Use the function
1464@code{interactive-form} for that. @ref{Using Interactive}. It is not
1465possible to make a module function non-interactive once you have made
1466it interactive using @code{make_interactive}.
1467
1450@anchor{Module Function Finalizers} 1468@anchor{Module Function Finalizers}
1451If you want to run some code when a module function object (i.e., an 1469If you want to run some code when a module function object (i.e., an
1452object returned by @code{make_function}) is garbage-collected, you can 1470object returned by @code{make_function}) is garbage-collected, you can
diff --git a/etc/NEWS b/etc/NEWS
index db2adcec155..52092f2ef72 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1347,6 +1347,10 @@ This removes the final remaining trace of old-style backquotes.
1347'emacs_function' and 'emacs_finalizer' for module functions and 1347'emacs_function' and 'emacs_finalizer' for module functions and
1348finalizers, respectively. 1348finalizers, respectively.
1349 1349
1350** Module functions can now be made interactive. Use
1351'make_interactive' to give a module function an interactive
1352specification.
1353
1350** Module functions can now install an optional finalizer that is 1354** Module functions can now install an optional finalizer that is
1351called when the function object is garbage-collected. Use 1355called when the function object is garbage-collected. Use
1352'set_function_finalizer' to set the finalizer and 1356'set_function_finalizer' to set the finalizer and
diff --git a/src/data.c b/src/data.c
index 59d148166fe..dae8b10ef55 100644
--- a/src/data.c
+++ b/src/data.c
@@ -906,6 +906,13 @@ Value, if non-nil, is a list (interactive SPEC). */)
906 if (PVSIZE (fun) > COMPILED_INTERACTIVE) 906 if (PVSIZE (fun) > COMPILED_INTERACTIVE)
907 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE)); 907 return list2 (Qinteractive, AREF (fun, COMPILED_INTERACTIVE));
908 } 908 }
909 else if (MODULE_FUNCTIONP (fun))
910 {
911 Lisp_Object form
912 = module_function_interactive_form (XMODULE_FUNCTION (fun));
913 if (! NILP (form))
914 return form;
915 }
909 else if (AUTOLOADP (fun)) 916 else if (AUTOLOADP (fun))
910 return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil)); 917 return Finteractive_form (Fautoload_do_load (fun, cmd, Qnil));
911 else if (CONSP (fun)) 918 else if (CONSP (fun))
diff --git a/src/emacs-module.c b/src/emacs-module.c
index a0bab118019..3581daad112 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -551,7 +551,7 @@ struct Lisp_Module_Function
551 union vectorlike_header header; 551 union vectorlike_header header;
552 552
553 /* Fields traced by GC; these must come first. */ 553 /* Fields traced by GC; these must come first. */
554 Lisp_Object documentation; 554 Lisp_Object documentation, interactive_form;
555 555
556 /* Fields ignored by GC. */ 556 /* Fields ignored by GC. */
557 ptrdiff_t min_arity, max_arity; 557 ptrdiff_t min_arity, max_arity;
@@ -564,7 +564,7 @@ static struct Lisp_Module_Function *
564allocate_module_function (void) 564allocate_module_function (void)
565{ 565{
566 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function, 566 return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
567 documentation, PVEC_MODULE_FUNCTION); 567 interactive_form, PVEC_MODULE_FUNCTION);
568} 568}
569 569
570#define XSET_MODULE_FUNCTION(var, ptr) \ 570#define XSET_MODULE_FUNCTION(var, ptr) \
@@ -630,6 +630,24 @@ module_finalize_function (const struct Lisp_Module_Function *func)
630 func->finalizer (func->data); 630 func->finalizer (func->data);
631} 631}
632 632
633static void
634module_make_interactive (emacs_env *env, emacs_value function, emacs_value spec)
635{
636 MODULE_FUNCTION_BEGIN ();
637 Lisp_Object lisp_fun = value_to_lisp (function);
638 CHECK_MODULE_FUNCTION (lisp_fun);
639 Lisp_Object lisp_spec = value_to_lisp (spec);
640 /* Normalize (interactive nil) to (interactive). */
641 XMODULE_FUNCTION (lisp_fun)->interactive_form
642 = NILP (lisp_spec) ? list1 (Qinteractive) : list2 (Qinteractive, lisp_spec);
643}
644
645Lisp_Object
646module_function_interactive_form (const struct Lisp_Module_Function *fun)
647{
648 return fun->interactive_form;
649}
650
633static emacs_value 651static emacs_value
634module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, 652module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs,
635 emacs_value *args) 653 emacs_value *args)
@@ -1463,6 +1481,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
1463 env->get_function_finalizer = module_get_function_finalizer; 1481 env->get_function_finalizer = module_get_function_finalizer;
1464 env->set_function_finalizer = module_set_function_finalizer; 1482 env->set_function_finalizer = module_set_function_finalizer;
1465 env->open_channel = module_open_channel; 1483 env->open_channel = module_open_channel;
1484 env->make_interactive = module_make_interactive;
1466 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments); 1485 Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
1467 return env; 1486 return env;
1468} 1487}
diff --git a/src/eval.c b/src/eval.c
index 126ee2e9555..fdc3cd1e9f4 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1948,6 +1948,13 @@ then strings and vectors are not accepted. */)
1948 else if (COMPILEDP (fun)) 1948 else if (COMPILEDP (fun))
1949 return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop); 1949 return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop);
1950 1950
1951 /* Module functions are interactive if their `interactive_form'
1952 field is non-nil. */
1953 else if (MODULE_FUNCTIONP (fun))
1954 return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))
1955 ? if_prop
1956 : Qt;
1957
1951 /* Strings and vectors are keyboard macros. */ 1958 /* Strings and vectors are keyboard macros. */
1952 if (STRINGP (fun) || VECTORP (fun)) 1959 if (STRINGP (fun) || VECTORP (fun))
1953 return (NILP (for_call_interactively) ? Qt : Qnil); 1960 return (NILP (for_call_interactively) ? Qt : Qnil);
diff --git a/src/lisp.h b/src/lisp.h
index 88e69b9061d..a24898004d4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4210,6 +4210,8 @@ extern Lisp_Object funcall_module (Lisp_Object, ptrdiff_t, Lisp_Object *);
4210extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); 4210extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *);
4211extern Lisp_Object module_function_documentation 4211extern Lisp_Object module_function_documentation
4212 (struct Lisp_Module_Function const *); 4212 (struct Lisp_Module_Function const *);
4213extern Lisp_Object module_function_interactive_form
4214 (const struct Lisp_Module_Function *);
4213extern module_funcptr module_function_address 4215extern module_funcptr module_function_address
4214 (struct Lisp_Module_Function const *); 4216 (struct Lisp_Module_Function const *);
4215extern void *module_function_data (const struct Lisp_Module_Function *); 4217extern void *module_function_data (const struct Lisp_Module_Function *);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index 5d884c148c4..40b03b92b52 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -12,3 +12,7 @@
12 12
13 int (*open_channel) (emacs_env *env, emacs_value pipe_process) 13 int (*open_channel) (emacs_env *env, emacs_value pipe_process)
14 EMACS_ATTRIBUTE_NONNULL (1); 14 EMACS_ATTRIBUTE_NONNULL (1);
15
16 void (*make_interactive) (emacs_env *env, emacs_value function,
17 emacs_value spec)
18 EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 37186fcc4d1..da298d4e398 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,
673 return env->intern (env, "nil"); 673 return env->intern (env, "nil");
674} 674}
675 675
676static emacs_value
677Fmod_test_identity (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
678 void *data)
679{
680 assert (nargs == 1);
681 return args[0];
682}
683
676/* Lisp utilities for easier readability (simple wrappers). */ 684/* Lisp utilities for easier readability (simple wrappers). */
677 685
678/* Provide FEATURE to Emacs. */ 686/* Provide FEATURE to Emacs. */
@@ -764,6 +772,19 @@ emacs_module_init (struct emacs_runtime *ert)
764 772
765#undef DEFUN 773#undef DEFUN
766 774
775 emacs_value constant_fn
776 = env->make_function (env, 0, 0, Fmod_test_return_t, NULL, NULL);
777 env->make_interactive (env, constant_fn, env->intern (env, "nil"));
778 bind_function (env, "mod-test-return-t-int", constant_fn);
779
780 emacs_value identity_fn
781 = env->make_function (env, 1, 1, Fmod_test_identity, NULL, NULL);
782 const char *interactive_spec = "i";
783 env->make_interactive (env, identity_fn,
784 env->make_string (env, interactive_spec,
785 strlen (interactive_spec)));
786 bind_function (env, "mod-test-identity", identity_fn);
787
767 provide (env, "mod-test"); 788 provide (env, "mod-test");
768 return 0; 789 return 0;
769} 790}
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 096c6b30574..1eebb418cf3 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -468,4 +468,36 @@ See Bug#36226."
468 (should (equal (buffer-string) "data from thread"))) 468 (should (equal (buffer-string) "data from thread")))
469 (delete-process process))))) 469 (delete-process process)))))
470 470
471(ert-deftest module/interactive/return-t ()
472 (should (functionp (symbol-function #'mod-test-return-t)))
473 (should (module-function-p (symbol-function #'mod-test-return-t)))
474 (should-not (commandp #'mod-test-return-t))
475 (should-not (commandp (symbol-function #'mod-test-return-t)))
476 (should-not (interactive-form #'mod-test-return-t))
477 (should-not (interactive-form (symbol-function #'mod-test-return-t)))
478 (should-error (call-interactively #'mod-test-return-t)
479 :type 'wrong-type-argument))
480
481(ert-deftest module/interactive/return-t-int ()
482 (should (functionp (symbol-function #'mod-test-return-t-int)))
483 (should (module-function-p (symbol-function #'mod-test-return-t-int)))
484 (should (commandp #'mod-test-return-t-int))
485 (should (commandp (symbol-function #'mod-test-return-t-int)))
486 (should (equal (interactive-form #'mod-test-return-t-int) '(interactive)))
487 (should (equal (interactive-form (symbol-function #'mod-test-return-t-int))
488 '(interactive)))
489 (should (eq (mod-test-return-t-int) t))
490 (should (eq (call-interactively #'mod-test-return-t-int) t)))
491
492(ert-deftest module/interactive/identity ()
493 (should (functionp (symbol-function #'mod-test-identity)))
494 (should (module-function-p (symbol-function #'mod-test-identity)))
495 (should (commandp #'mod-test-identity))
496 (should (commandp (symbol-function #'mod-test-identity)))
497 (should (equal (interactive-form #'mod-test-identity) '(interactive "i")))
498 (should (equal (interactive-form (symbol-function #'mod-test-identity))
499 '(interactive "i")))
500 (should (eq (mod-test-identity 123) 123))
501 (should-not (call-interactively #'mod-test-identity)))
502
471;;; emacs-module-tests.el ends here 503;;; emacs-module-tests.el ends here