From mboxrd@z Thu Jan 1 00:00:00 1970
Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail
From: Philipp Stephani
Newsgroups: gmane.emacs.devel
Subject: [PATCH] Ignore pending_signals when checking for quits.
Date: Mon, 11 Feb 2019 21:17:39 +0100
Message-ID: <20190211201739.25229-1-phst@google.com>
References: <83y36nl7rl.fsf@gnu.org>
Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226";
logging-data="59418"; mail-complaints-to="usenet@blaine.gmane.org"
Cc: Philipp Stephani
To: emacs-devel@gnu.org,
eliz@gnu.org
Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Feb 11 21:20:52 2019
Return-path:
Envelope-to: ged-emacs-devel@m.gmane.org
Original-Received: from lists.gnu.org ([209.51.188.17])
by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256)
(Exim 4.89)
(envelope-from )
id 1gtI4R-000FLf-VM
for ged-emacs-devel@m.gmane.org; Mon, 11 Feb 2019 21:20:52 +0100
Original-Received: from localhost ([127.0.0.1]:55661 helo=lists.gnu.org)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from )
id 1gtI4N-0005lT-Fx
for ged-emacs-devel@m.gmane.org; Mon, 11 Feb 2019 15:20:50 -0500
Original-Received: from eggs.gnu.org ([209.51.188.92]:46328)
by lists.gnu.org with esmtp (Exim 4.71)
(envelope-from ) id 1gtI4A-0005eL-Gy
for emacs-devel@gnu.org; Mon, 11 Feb 2019 15:20:36 -0500
Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
(envelope-from ) id 1gtI1b-0001u0-Ty
for emacs-devel@gnu.org; Mon, 11 Feb 2019 15:17:59 -0500
Original-Received: from mail-wr1-x442.google.com ([2a00:1450:4864:20::442]:42749)
by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16)
(Exim 4.71) (envelope-from )
id 1gtI1b-0001pe-Fe; Mon, 11 Feb 2019 15:17:55 -0500
Original-Received: by mail-wr1-x442.google.com with SMTP id q18so180128wrx.9;
Mon, 11 Feb 2019 12:17:52 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025;
h=from:to:cc:subject:date:message-id:in-reply-to:references;
bh=RX2eR9XzYmo9OU9Qdo7Td9P7kbF9efCPF7yjEgpXD9E=;
b=t/IYfxRF1GCU4pSWvx0aAlzcfS9zD62Hj0Mbv1sO5Ca+Ftmta/sH11svj6fxcFvZ76
8PHzUIAiCuedX19OfclcEWBUtWJp2t0Z8YpuJxop1UAZNUaU9vMLusUY8V1E7TfeVAcd
lbXjG+2h8KVE0MH0umlSK9rdvdu3SmgWaO772ILxPD9VMTOW+4XvwBxyzitV+G6NMYDm
H1KCOhgZEFb1YolvcE301i7VMIH0JHhM8RiR/PgWRPuIW5r74jeLnV96bvf2b1cYrYM1
GuO7/JvMxqYY/4GOx5K/gNKAFAKL7bVak3RlSJLJdGWZXOjFvWyepVcXWwqczmxTazAB
qYcg==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20161025;
h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to
:references;
bh=RX2eR9XzYmo9OU9Qdo7Td9P7kbF9efCPF7yjEgpXD9E=;
b=nXnyf+BCuDkSIwh20BC4Yey1/lVjaiPTGXtccU1sZNlR1B5eDaUkIAsIWUvw+Ekovb
ZbuOUccq40fG5xVNpU9JkqhRY5O1ZQQMUBSSH68U1IQhXK0aKpZXABQ6i1mQcX83uSKZ
YO+UTFxKavJkRsAmVdPnDTPb2q1iNbdz8vnefWP01Gyo0Q6tXwa2YQySQE/68ONc0T2i
PTJU+fGDgRyV6LBuy/KJ5SX0z/+HSOGZOEbW7lRIS4rp5e7XLE+d01zvqoODdLAxDqdE
e8ul3lmvb0wVpJKJqrrGrrnEmzWUIgcI06DN2001DY3FL1dwRcS1ZLx/Nv+kQabk9jY4
neSg==
X-Gm-Message-State: AHQUAuYE/jjIoHs3/wWlZOfPyGGJkw1YVwIZX/+HclG09l9q19PtH3lV
mkABzINcV4Nvrljirmxc8C3PI7p9
X-Google-Smtp-Source: AHgI3Ib1+Wj0mbDq0RhjldN3O7h93CUNfkNADa7c7JMAN1M/fqKffov9PcWYUn+d0p0AWbBhkXomjw==
X-Received: by 2002:adf:e3d1:: with SMTP id k17mr9434852wrm.143.1549916270732;
Mon, 11 Feb 2019 12:17:50 -0800 (PST)
Original-Received: from p.cm.cablesurf.de (85.233.42.145.dynamic.cablesurf.de.
[85.233.42.145])
by smtp.gmail.com with ESMTPSA id f8sm9864473wrv.41.2019.02.11.12.17.49
(version=TLS1_2 cipher=ECDHE-RSA-AES128-SHA bits=128/128);
Mon, 11 Feb 2019 12:17:50 -0800 (PST)
X-Google-Original-From: Philipp Stephani
X-Mailer: git-send-email 2.17.2 (Apple Git-113)
In-Reply-To: <83y36nl7rl.fsf@gnu.org>
X-detected-operating-system: by eggs.gnu.org: Genre and OS details not
recognized.
X-Received-From: 2a00:1450:4864:20::442
X-BeenThere: emacs-devel@gnu.org
X-Mailman-Version: 2.1.21
Precedence: list
List-Id: "Emacs development discussions."
List-Unsubscribe: ,
List-Archive:
List-Post:
List-Help:
List-Subscribe: ,
Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org
Original-Sender: "Emacs-devel"
Xref: news.gmane.org gmane.emacs.devel:233226
Archived-At:
pending_signals is often set if no quit is pending. This results in
bugs in module code if the module returns but no quit is actually
pending.
As a better alternative, add a new process_input environment function
for Emacs 27. That function processes signals (like maybe_quit).
* configure.ac: Add module snippet for Emacs 27.
* src/module-env-27.h: New file.
* src/emacs-module.h.in: Add process_input function to environment
interface.
* src/emacs-module.c (module_should_quit): Use QUITP macro to check
whether the caller should quit.
(module_process_input): New function.
(initialize_environment): Use it.
* src/eval.c: Remove obsolete comment.
* test/data/emacs-module/mod-test.c (signal_wrong_type_argument)
(signal_errno): New helper functions.
(Fmod_test_sleep_until): New test module function.
* test/src/emacs-module-tests.el (mod-test-sleep-until): New unit
test.
* doc/lispref/internals.texi (Module Misc): Document process_input.
---
configure.ac | 2 +
doc/lispref/internals.texi | 22 +++++++++-
etc/NEWS | 3 ++
src/emacs-module.c | 15 +++++--
src/emacs-module.h.in | 21 +++++++++-
src/eval.c | 5 +--
src/module-env-27.h | 4 ++
test/data/emacs-module/mod-test.c | 69 ++++++++++++++++++++++++++++++-
test/src/emacs-module-tests.el | 20 +++++++++
9 files changed, 151 insertions(+), 10 deletions(-)
create mode 100644 src/module-env-27.h
diff --git a/configure.ac b/configure.ac
index 58579008f3..3318f04a5a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3689,8 +3689,10 @@ AC_DEFUN
AC_CONFIG_FILES([src/emacs-module.h])
AC_SUBST_FILE([module_env_snippet_25])
AC_SUBST_FILE([module_env_snippet_26])
+AC_SUBST_FILE([module_env_snippet_27])
module_env_snippet_25="$srcdir/src/module-env-25.h"
module_env_snippet_26="$srcdir/src/module-env-26.h"
+module_env_snippet_27="$srcdir/src/module-env-27.h"
### Use -lpng if available, unless '--with-png=no'.
HAVE_PNG=no
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 3fbff266ad..56465126f4 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -1623,7 +1623,27 @@ Module Misc
@deftypefn Function bool should_quit (emacs_env *@var{env})
This function returns @code{true} if the user wants to quit. In that
case, we recommend that your module function aborts any on-going
-processing and returns as soon as possible.
+processing and returns as soon as possible. In most cases, use
+@code{process_input} instead.
+@end deftypefn
+
+To process input events in addition to checking whether the user wants
+to quit, use the following function, which is available since Emacs
+27.1.
+
+@anchor{process_input}
+@deftypefn Function enum emacs_process_input_result process_input (emacs_env *@var{env})
+This function processes pending input events. It returns
+@code{emacs_process_input_quit} if the user wants to quit or an error
+occurred while processing signals. In that case, we recommend that
+your module function aborts any on-going processing and returns as
+soon as possible. If the module code may continue running,
+@code{process_input} returns @code{emacs_process_input_continue}. The
+return value is @code{emacs_process_input_continue} if and only if
+there is no pending nonlocal exit in @code{env}. If the module
+continues after calling @code{process_input}, global state such as
+variable values and buffer content may have been modified in arbitrary
+ways.
@end deftypefn
@node Module Nonlocal
diff --git a/etc/NEWS b/etc/NEWS
index 75c8dc0b8e..08e2e0c728 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1564,6 +1564,9 @@ given frame supports resizing.
This is currently supported on GNUish hosts and on modern versions of
MS-Windows.
+** New module environment function 'process_input' to process user
+input while module code is running.
+
* Changes in Emacs 27.1 on Non-Free Operating Systems
diff --git a/src/emacs-module.c b/src/emacs-module.c
index cbab023420..b70d6cea81 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -671,13 +671,21 @@ 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. */
+/* This function should return true if and only if maybe_quit would
+ quit. */
static bool
module_should_quit (emacs_env *env)
{
MODULE_FUNCTION_BEGIN_NO_CATCH (false);
- return (! NILP (Vquit_flag) && NILP (Vinhibit_quit)) || pending_signals;
+ return QUITP;
+}
+
+static enum emacs_process_input_result
+module_process_input (emacs_env *env)
+{
+ MODULE_FUNCTION_BEGIN (emacs_process_input_quit);
+ maybe_quit ();
+ return emacs_process_input_continue;
}
@@ -1082,6 +1090,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->vec_get = module_vec_get;
env->vec_size = module_vec_size;
env->should_quit = module_should_quit;
+ env->process_input = module_process_input;
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 4c5286f625..009d1583fe 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -47,7 +47,7 @@ extern "C" {
#endif
/* Current environment. */
-typedef struct emacs_env_26 emacs_env;
+typedef struct emacs_env_27 emacs_env;
/* Opaque pointer representing an Emacs Lisp value.
BEWARE: Do not assume NULL is a valid value! */
@@ -83,6 +83,16 @@ enum emacs_funcall_exit
emacs_funcall_exit_throw = 2
};
+/* Possible return values for emacs_env.process_input. */
+enum emacs_process_input_result
+{
+ /* Module code may continue */
+ emacs_process_input_continue = 0,
+
+ /* Module code should return control to Emacs as soon as possible. */
+ emacs_process_input_quit = 1
+};
+
struct emacs_env_25
{
@module_env_snippet_25@
@@ -95,6 +105,15 @@ struct emacs_env_26
@module_env_snippet_26@
};
+struct emacs_env_27
+{
+@module_env_snippet_25@
+
+@module_env_snippet_26@
+
+@module_env_snippet_27@
+};
+
/* Every module should define a function as follows. */
extern int emacs_module_init (struct emacs_runtime *ert)
EMACS_NOEXCEPT
diff --git a/src/eval.c b/src/eval.c
index b094fc2e66..b6cdfc911d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1575,10 +1575,7 @@ 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.
-
- If you change this function, also adapt module_should_quit in
- emacs-module.c. */
+ When not quitting, process any pending signals. */
void
maybe_quit (void)
diff --git a/src/module-env-27.h b/src/module-env-27.h
new file mode 100644
index 0000000000..b491b60fbb
--- /dev/null
+++ b/src/module-env-27.h
@@ -0,0 +1,4 @@
+ /* Processes pending input events and returns whether the module
+ function should quit. */
+ enum emacs_process_input_result (*process_input) (emacs_env *env)
+ EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 98242e85ba..47ea159d0e 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -17,12 +17,20 @@ GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with GNU Emacs. If not, see . */
+#include "config.h"
+
#include
+#include
+#include
#include
#include
-#include
+#include
+#include
+
#include
+#include "timespec.h"
+
int plugin_is_GPL_compatible;
#if INTPTR_MAX <= 0
@@ -299,6 +307,64 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL);
}
+static void
+signal_wrong_type_argument (emacs_env *env, const char *predicate,
+ emacs_value arg)
+{
+ emacs_value symbol = env->intern (env, "wrong-type-argument");
+ emacs_value elements[2] = {env->intern (env, predicate), arg};
+ emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements);
+ env->non_local_exit_signal (env, symbol, data);
+}
+
+static void
+signal_errno (emacs_env *env, const char *function)
+{
+ const char *message = strerror (errno);
+ emacs_value message_value = env->make_string (env, message, strlen (message));
+ emacs_value symbol = env->intern (env, "file-error");
+ emacs_value elements[2]
+ = {env->make_string (env, function, strlen (function)), message_value};
+ emacs_value data = env->funcall (env, env->intern (env, "list"), 2, elements);
+ env->non_local_exit_signal (env, symbol, data);
+}
+
+/* A long-running operation that occasionally calls `should_quit' or
+ `process_input'. */
+
+static emacs_value
+Fmod_test_sleep_until (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (nargs == 2);
+ const double until_seconds = env->extract_float (env, args[0]);
+ if (env->non_local_exit_check (env))
+ return NULL;
+ if (until_seconds <= 0)
+ {
+ signal_wrong_type_argument (env, "cl-plusp", args[0]);
+ return NULL;
+ }
+ const bool process_input = env->is_not_nil (env, args[1]);
+ const struct timespec until = dtotimespec (until_seconds);
+ const struct timespec amount = make_timespec(0, 10000000);
+ while (true)
+ {
+ const struct timespec now = current_timespec ();
+ if (timespec_cmp (now, until) >= 0)
+ break;
+ if (nanosleep (&amount, NULL) && errno != EINTR)
+ {
+ signal_errno (env, "nanosleep");
+ return NULL;
+ }
+ if ((process_input
+ && env->process_input (env) == emacs_process_input_quit)
+ || env->should_quit (env))
+ return NULL;
+ }
+ return env->intern (env, "finished");
+}
/* Lisp utilities for easier readability (simple wrappers). */
@@ -367,6 +433,7 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0,
NULL, NULL);
+ DEFUN ("mod-test-sleep-until", Fmod_test_sleep_until, 2, 2, NULL, NULL);
#undef DEFUN
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index e4593044ec..e30980b599 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -289,4 +289,24 @@ module--test-assertion
(should (member '(provide . mod-test) entries))
(should (member '(defun . mod-test-sum) entries))))
+(ert-deftest mod-test-sleep-until ()
+ "Check that `mod-test-sleep-until' either returns normally or quits.
+Interactively, you can try hitting \\[keyboard-quit] to quit."
+ (dolist (arg '(nil t))
+ ;; Guard against some caller setting `inhibit-quit'.
+ (with-local-quit
+ (condition-case nil
+ (should (eq (with-local-quit
+ ;; Because `inhibit-quit' is nil here, the next
+ ;; form either quits or returns `finished'.
+ (mod-test-sleep-until
+ ;; Interactively, run for 5 seconds to give the
+ ;; user time to quit. In batch mode, run only
+ ;; briefly since the user can't quit.
+ (float-time (time-add nil (if noninteractive 0.1 5)))
+ ;; should_quit or process_input
+ arg))
+ 'finished))
+ (quit)))))
+
;;; emacs-module-tests.el ends here
--
2.17.2 (Apple Git-113)