diff options
| -rw-r--r-- | doc/lispref/internals.texi | 46 | ||||
| -rw-r--r-- | etc/NEWS | 4 | ||||
| -rw-r--r-- | src/data.c | 7 | ||||
| -rw-r--r-- | src/emacs-module.c | 23 | ||||
| -rw-r--r-- | src/eval.c | 7 | ||||
| -rw-r--r-- | src/lisp.h | 2 | ||||
| -rw-r--r-- | src/module-env-28.h | 4 | ||||
| -rw-r--r-- | test/data/emacs-module/mod-test.c | 21 | ||||
| -rw-r--r-- | 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 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, | |||
| 1425 | The GNU Emacs Manual}. | 1425 | The GNU Emacs Manual}. |
| 1426 | 1426 | ||
| 1427 | Using the module @acronym{API}, it is possible to define more complex | 1427 | Using the module @acronym{API}, it is possible to define more complex |
| 1428 | function and data types: interactive functions, inline functions, | 1428 | function and data types: inline functions, macros, etc. However, the |
| 1429 | macros, etc. However, the resulting C code will be cumbersome and | 1429 | resulting C code will be cumbersome and hard to read. Therefore, we |
| 1430 | hard to read. Therefore, we recommend that you limit the module code | 1430 | recommend that you limit the module code which creates functions and |
| 1431 | which creates functions and data structures to the absolute minimum, | 1431 | data structures to the absolute minimum, and leave the rest for a Lisp |
| 1432 | and leave the rest for a Lisp package that will accompany your module, | 1432 | package that will accompany your module, because doing these |
| 1433 | because doing these additional tasks in Lisp is much easier, and will | 1433 | additional tasks in Lisp is much easier, and will produce a much more |
| 1434 | produce a much more readable code. For example, given a module | 1434 | readable code. For example, given a module function |
| 1435 | function @code{module-func} defined as above, one way of making an | 1435 | @code{module-func} defined as above, one way of making a macro |
| 1436 | interactive command @code{module-cmd} based on it is with the | 1436 | @code{module-macro} based on it is with the following simple Lisp |
| 1437 | following simple Lisp wrapper: | 1437 | wrapper: |
| 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 | ||
| 1446 | The Lisp package which goes with your module could then load the | 1445 | The Lisp package which goes with your module could then load the |
| 1447 | module using the @code{load} primitive (@pxref{Dynamic Modules}) when | 1446 | module using the @code{load} primitive (@pxref{Dynamic Modules}) when |
| 1448 | the package is loaded into Emacs. | 1447 | the package is loaded into Emacs. |
| 1449 | 1448 | ||
| 1449 | By default, module functions created by @code{make_function} are not | ||
| 1450 | interactive. To make them interactive, you can use the following | ||
| 1451 | function. | ||
| 1452 | |||
| 1453 | @deftypefun void make_interactive (emacs_env *@var{env}, emacs_value @var{function}, emacs_value @var{spec}) | ||
| 1454 | This 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 | ||
| 1459 | function returned by @code{make_function}. | ||
| 1460 | @end deftypefun | ||
| 1461 | |||
| 1462 | Note that there is no native module support for retrieving the | ||
| 1463 | interactive specification of a module function. Use the function | ||
| 1464 | @code{interactive-form} for that. @ref{Using Interactive}. It is not | ||
| 1465 | possible to make a module function non-interactive once you have made | ||
| 1466 | it interactive using @code{make_interactive}. | ||
| 1467 | |||
| 1450 | @anchor{Module Function Finalizers} | 1468 | @anchor{Module Function Finalizers} |
| 1451 | If you want to run some code when a module function object (i.e., an | 1469 | If you want to run some code when a module function object (i.e., an |
| 1452 | object returned by @code{make_function}) is garbage-collected, you can | 1470 | object returned by @code{make_function}) is garbage-collected, you can |
| @@ -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 |
| 1348 | finalizers, respectively. | 1348 | finalizers, respectively. |
| 1349 | 1349 | ||
| 1350 | ** Module functions can now be made interactive. Use | ||
| 1351 | 'make_interactive' to give a module function an interactive | ||
| 1352 | specification. | ||
| 1353 | |||
| 1350 | ** Module functions can now install an optional finalizer that is | 1354 | ** Module functions can now install an optional finalizer that is |
| 1351 | called when the function object is garbage-collected. Use | 1355 | called 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 * | |||
| 564 | allocate_module_function (void) | 564 | allocate_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 | ||
| 633 | static void | ||
| 634 | module_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 | |||
| 645 | Lisp_Object | ||
| 646 | module_function_interactive_form (const struct Lisp_Module_Function *fun) | ||
| 647 | { | ||
| 648 | return fun->interactive_form; | ||
| 649 | } | ||
| 650 | |||
| 633 | static emacs_value | 651 | static emacs_value |
| 634 | module_funcall (emacs_env *env, emacs_value func, ptrdiff_t nargs, | 652 | module_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 *); | |||
| 4210 | extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); | 4210 | extern Lisp_Object module_function_arity (const struct Lisp_Module_Function *); |
| 4211 | extern Lisp_Object module_function_documentation | 4211 | extern Lisp_Object module_function_documentation |
| 4212 | (struct Lisp_Module_Function const *); | 4212 | (struct Lisp_Module_Function const *); |
| 4213 | extern Lisp_Object module_function_interactive_form | ||
| 4214 | (const struct Lisp_Module_Function *); | ||
| 4213 | extern module_funcptr module_function_address | 4215 | extern module_funcptr module_function_address |
| 4214 | (struct Lisp_Module_Function const *); | 4216 | (struct Lisp_Module_Function const *); |
| 4215 | extern void *module_function_data (const struct Lisp_Module_Function *); | 4217 | 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 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 | ||
| 676 | static emacs_value | ||
| 677 | Fmod_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 |