Support quitting in modules

The idea is that modules should call env->should_quit from time to
time and return as quickly as possible if it returns true.

* src/emacs-module.c (module_should_quit): New module function.
(initialize_environment): Use it.
(funcall_module): Process potential pending quit.

* src/eval.c (maybe_quit): Add reference to module_should_quit.

1 files changed, 15 insertions, 0 deletions

diff --git a/src/emacs-module.c b/src/emacs-module.c
index f2efc83d257..e6a109b1962 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -28,6 +28,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "lisp.h"
 #include "dynlib.h"
 #include "coding.h"
+#include "keyboard.h"
 #include "syssignal.h"
 
 #include <intprops.h>
@@ -612,6 +613,15 @@ module_vec_size (emacs_env *env, emacs_value vec)
   return ASIZE (lvec);
 }
 
+/* This function should return true if and only if maybe_quit would do
+   anything.  */
+static bool
+module_should_quit (emacs_env *env)
+{
+  MODULE_FUNCTION_BEGIN_NO_CATCH (false);
+  return (! NILP (Vquit_flag) && NILP (Vinhibit_quit)) || pending_signals;
+}
+
 
 /* Subroutines.  */
 
@@ -687,6 +697,10 @@ funcall_module (Lisp_Object function, ptrdiff_t nargs, Lisp_Object *arglist)
 
   eassert (&priv == pub.private_members);
 
+  /* Process the quit flag first, so that quitting doesn't get
+     overridden by other non-local exits.  */
+  maybe_quit ();
+
   switch (priv.pending_non_local_exit)
     {
     case emacs_funcall_exit_return:
@@ -916,6 +930,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
   env->vec_set = module_vec_set;
   env->vec_get = module_vec_get;
   env->vec_size = module_vec_size;
+  env->should_quit = module_should_quit;
   Vmodule_environments = Fcons (make_save_ptr (env), Vmodule_environments);
 }