From 66da3f4afa53e5c5cfab17ca03a13a0d65083ffb Mon Sep 17 00:00:00 2001
From: Philipp Stephani <phst@google.com>
Date: Sun, 4 Jun 2017 19:34:22 +0200
Subject: [PATCH] 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.
---
 src/emacs-module.c | 15 +++++++++++++++
 src/emacs-module.h |  3 +++
 src/eval.c         |  5 ++++-
 3 files changed, 22 insertions(+), 1 deletion(-)

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);
 }
 
diff --git a/src/emacs-module.h b/src/emacs-module.h
index d9eeeabec3f..b8bf2ed2d5f 100644
--- a/src/emacs-module.h
+++ b/src/emacs-module.h
@@ -185,6 +185,9 @@ struct emacs_env_25
 		   emacs_value val);
 
   ptrdiff_t (*vec_size) (emacs_env *env, emacs_value vec);
+
+  /* Returns whether a quit is pending.  */
+  bool (*should_quit) (emacs_env *env);
 };
 
 /* Every module should define a function as follows.  */
diff --git a/src/eval.c b/src/eval.c
index 8aa33a11282..ef961046bcf 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1474,7 +1474,10 @@ process_quit_flag (void)
    If quit-flag is set to `kill-emacs' the SIGINT handler has received
    a request to exit Emacs when it is safe to do.
 
-   When not quitting, process any pending signals.  */
+   When not quitting, process any pending signals.
+
+   If you change this function, also adapt module_should_quit in
+   emacs-module.c.  */
 
 void
 maybe_quit (void)
-- 
2.39.2