mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-04 11:40:22 +00:00
Ignore pending_signals when checking for quits.
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.
This commit is contained in:
parent
5653b76d0b
commit
72ec233f2a
@ -3689,8 +3689,10 @@ AC_SUBST(MODULES_SUFFIX)
|
||||
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
|
||||
|
@ -1623,7 +1623,27 @@ purpose.
|
||||
@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
|
||||
|
3
etc/NEWS
3
etc/NEWS
@ -1614,6 +1614,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
|
||||
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
4
src/module-env-27.h
Normal file
4
src/module-env-27.h
Normal file
@ -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);
|
@ -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 <https://www.gnu.org/licenses/>. */
|
||||
|
||||
#include "config.h"
|
||||
|
||||
#include <assert.h>
|
||||
#include <errno.h>
|
||||
#include <limits.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <limits.h>
|
||||
#include <string.h>
|
||||
#include <time.h>
|
||||
|
||||
#include <emacs-module.h>
|
||||
|
||||
#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
|
||||
|
||||
|
@ -289,4 +289,24 @@ Return A + B"
|
||||
(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
|
||||
|
Loading…
Reference in New Issue
Block a user