From 31ba9bbf6c2d0a265c77de1c068400b750ecf34b Mon Sep 17 00:00:00 2001 From: Miha Rihtaršič Date: Mon, 20 Sep 2021 07:59:29 +0200 Subject: Refactor minibuffer aborting * lisp/minibuffer.el (minibuffer-quit-recursive-edit): New optional argument to specify how many levels of recursion to quit. * src/eval.c (internal_catch): Remove special handling of 'exit tag (bug#49700). * src/minibuf.c (Fabort_minibuffers): Use minibuffer-quit-recursive-edit to quit multiple levels of minibuffer recursion. --- src/eval.c | 22 ---------------------- 1 file changed, 22 deletions(-) (limited to 'src/eval.c') diff --git a/src/eval.c b/src/eval.c index 48104bd0f45..76fe671b6dd 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1174,14 +1174,6 @@ usage: (catch TAG BODY...) */) FUNC should return a Lisp_Object. This is how catches are done from within C code. */ -/* MINIBUFFER_QUIT_LEVEL is to handle quitting from nested minibuffers by - throwing t to tag `exit'. - 0 means there is no (throw 'exit t) in progress, or it wasn't from - a minibuffer which isn't the most nested; - N > 0 means the `throw' was done from the minibuffer at level N which - wasn't the most nested. */ -EMACS_INT minibuffer_quit_level = 0; - Lisp_Object internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg) @@ -1189,9 +1181,6 @@ internal_catch (Lisp_Object tag, /* This structure is made part of the chain `catchlist'. */ struct handler *c = push_handler (tag, CATCHER); - if (EQ (tag, Qexit)) - minibuffer_quit_level = 0; - /* Call FUNC. */ if (! sys_setjmp (c->jmp)) { @@ -1205,17 +1194,6 @@ internal_catch (Lisp_Object tag, Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - if (EQ (tag, Qexit) && EQ (val, Qt) && minibuffer_quit_level > 0) - /* If we've thrown t to tag `exit' from within a minibuffer, we - exit all minibuffers more deeply nested than the current - one. */ - { - if (minibuf_level > minibuffer_quit_level - && !NILP (Fminibuffer_innermost_command_loop_p (Qnil))) - Fthrow (Qexit, Qt); - else - minibuffer_quit_level = 0; - } return val; } } -- cgit v1.2.3 From 7973227f67cd8ea4a1ed590ebc279b34ece86c12 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 22 Sep 2021 10:07:25 +0300 Subject: Update comments warning about GC-resistant C programming * src/eval.c: Remove an outdated comment about protection from GC. * src/buffer.h: * src/lisp.h: Add warnings about using 'char *' pointers to text of Lisp strings and buffer text in code that could GC. Reported by Po Lu --- src/buffer.h | 11 +++++++++++ src/eval.c | 3 --- src/lisp.h | 8 ++++++++ 3 files changed, 19 insertions(+), 3 deletions(-) (limited to 'src/eval.c') diff --git a/src/buffer.h b/src/buffer.h index 24e9c3fcbc8..8623bed08e6 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -60,6 +60,14 @@ enum { BEG = 1, BEG_BYTE = BEG }; /* Macros for the addresses of places in the buffer. */ +/* WARNING: Use the 'char *' pointers to buffer text with care in code + that could GC: GC can relocate buffer text, invalidating such + pointers. It is best to use character or byte position instead, + delaying the access through BYTE_POS_ADDR etc. pointers to the + latest possible moment. If you must use the 'char *' pointers + (e.g., for speed), be sure to adjust them after any call that could + potentially GC. */ + /* Address of beginning of buffer. */ #define BEG_ADDR (current_buffer->text->beg) @@ -1002,6 +1010,9 @@ SET_BUF_PT_BOTH (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t byte) or convert between a byte position and an address. These functions do not check that the position is in range. */ +/* See the important WARNING above about using the 'char *' pointers + returned by these functions. */ + /* Return the address of byte position N in current buffer. */ INLINE unsigned char * diff --git a/src/eval.c b/src/eval.c index 76fe671b6dd..2bb7cfe6002 100644 --- a/src/eval.c +++ b/src/eval.c @@ -364,9 +364,6 @@ do_debug_on_call (Lisp_Object code, ptrdiff_t count) call_debugger (list1 (code)); } -/* NOTE!!! Every function that can call EVAL must protect its args - and temporaries from garbage collection while it needs them. - The definition of `For' shows what you have to do. */ DEFUN ("or", For, Sor, 0, UNEVALLED, 0, doc: /* Eval args until one of them yields non-nil, then return that value. diff --git a/src/lisp.h b/src/lisp.h index 720e621d19c..09e0b8e9bda 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1555,6 +1555,14 @@ STRING_MULTIBYTE (Lisp_Object str) /* Convenience functions for dealing with Lisp strings. */ +/* WARNING: Use the 'char *' pointers to string data with care in code + that could GC: GC can relocate string data, invalidating such + pointers. It is best to use string character or byte index + instead, delaying the access through SDATA/SSDATA pointers to the + latest possible moment. If you must use the 'char *' pointers + (e.g., for speed), be sure to adjust them after any call that could + potentially GC. */ + INLINE unsigned char * SDATA (Lisp_Object string) { -- cgit v1.2.3 From ed02b88bbae18caad650d76876940ffb58cab554 Mon Sep 17 00:00:00 2001 From: Mattias Engdegård Date: Thu, 23 Sep 2021 12:43:41 +0200 Subject: Renege on anonymous &rest (bug#50268, bug#50720) Allowing &rest without a variable name following turned out not to be very useful, and it never worked properly. Disallow it. * lisp/emacs-lisp/bytecomp.el (byte-compile-check-lambda-list): * src/eval.c (funcall_lambda): Signal error for &rest without variable name. * doc/lispref/functions.texi (Argument List): Adjust manual. * etc/NEWS (file): Announce. * test/src/eval-tests.el (eval-tests--bugs-24912-and-24913): Extend test, also checking with and without lexical binding. (eval-tests-accept-empty-optional-rest): Reduce to... (eval-tests-accept-empty-optional): ...this, again checking with and without lexical binding. --- doc/lispref/functions.texi | 2 +- etc/NEWS | 7 ++++++ lisp/emacs-lisp/bytecomp.el | 2 ++ src/eval.c | 9 ++++--- test/src/eval-tests.el | 57 ++++++++++++++++++++++++++------------------- 5 files changed, 49 insertions(+), 28 deletions(-) (limited to 'src/eval.c') diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 77d1465c876..c856557c3cb 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -378,7 +378,7 @@ keyword @code{&rest} before one final argument. @group (@var{required-vars}@dots{} @r{[}&optional @r{[}@var{optional-vars}@dots{}@r{]}@r{]} - @r{[}&rest @r{[}@var{rest-var}@r{]}@r{]}) + @r{[}&rest @var{rest-var}@r{]}) @end group @end example diff --git a/etc/NEWS b/etc/NEWS index f211a98678c..61780a3a19e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3273,6 +3273,13 @@ local variable would not be heeded. This has now changed, and a file with a 'lexical-binding' cookie is always heeded. To revert to the old behavior, set 'permanently-enabled-local-variables' to nil. ++++ +** '&rest' in argument lists must always be followed by a variable name. +Omitting the variable name after '&rest' was previously tolerated in +some cases but not consistently so; it could lead to crashes or +outright wrong results. Since the utility was marginal at best, it is +now an error to omit the variable. + --- ** 'kill-all-local-variables' has changed how it handles non-symbol hooks. The function is documented to eliminate all buffer-local bindings diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index be74195778b..d7da7a2149a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2930,6 +2930,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (macroexp--const-symbol-p arg t)) (error "Invalid lambda variable %s" arg)) ((eq arg '&rest) + (unless (cdr list) + (error "&rest without variable name")) (when (cddr list) (error "Garbage following &rest VAR in lambda-list")) (when (memq (cadr list) '(&optional &rest)) diff --git a/src/eval.c b/src/eval.c index 2bb7cfe6002..66d34808f82 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3245,6 +3245,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, emacs_abort (); i = optional = rest = 0; + bool previous_rest = false; for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { maybe_quit (); @@ -3255,13 +3256,14 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, if (EQ (next, Qand_rest)) { - if (rest) + if (rest || previous_rest) xsignal1 (Qinvalid_function, fun); rest = 1; + previous_rest = true; } else if (EQ (next, Qand_optional)) { - if (optional || rest) + if (optional || rest || previous_rest) xsignal1 (Qinvalid_function, fun); optional = 1; } @@ -3287,10 +3289,11 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, else /* Dynamically bind NEXT. */ specbind (next, arg); + previous_rest = false; } } - if (!NILP (syms_left)) + if (!NILP (syms_left) || previous_rest) xsignal1 (Qinvalid_function, fun); else if (i < nargs) xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs)); diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index b2b7dfefda5..3c3e7033419 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -39,31 +39,40 @@ (ert-deftest eval-tests--bugs-24912-and-24913 () "Check that Emacs doesn't accept weird argument lists. Bug#24912 and Bug#24913." - (dolist (args '((&rest &optional) - (&rest a &optional) (&rest &optional a) - (&optional &optional) (&optional &optional a) - (&optional a &optional b) - (&rest &rest) (&rest &rest a) - (&rest a &rest b))) - (should-error (eval `(funcall (lambda ,args)) t) :type 'invalid-function) - (should-error (byte-compile-check-lambda-list args)) - (let ((byte-compile-debug t)) - (ert-info ((format "bytecomp: args = %S" args)) - (should-error (eval `(byte-compile (lambda ,args)) t)))))) - -(ert-deftest eval-tests-accept-empty-optional-rest () - "Check that Emacs accepts empty &optional and &rest arglists. + (dolist (lb '(t false)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let ((lexical-binding lb)) + (dolist (args '((&rest &optional) + (&rest a &optional) (&rest &optional a) + (&optional &optional) (&optional &optional a) + (&optional a &optional b) + (&rest &rest) (&rest &rest a) + (&rest a &rest b) + (&rest) (&optional &rest) + )) + (ert-info ((prin1-to-string args) :prefix "args: ") + (should-error + (eval `(funcall (lambda ,args)) lb) :type 'invalid-function) + (should-error (byte-compile-check-lambda-list args)) + (let ((byte-compile-debug t)) + (should-error (eval `(byte-compile (lambda ,args)) lb))))))))) + +(ert-deftest eval-tests-accept-empty-optional () + "Check that Emacs accepts empty &optional arglists. Bug#24912." - (dolist (args '((&optional) (&rest) (&optional &rest) - (&optional &rest a) (&optional a &rest))) - (let ((fun `(lambda ,args 'ok))) - (ert-info ("eval") - (should (eq (funcall (eval fun t)) 'ok))) - (ert-info ("byte comp check") - (byte-compile-check-lambda-list args)) - (ert-info ("bytecomp") - (let ((byte-compile-debug t)) - (should (eq (funcall (byte-compile fun)) 'ok))))))) + (dolist (lb '(t false)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let ((lexical-binding lb)) + (dolist (args '((&optional) (&optional &rest a))) + (ert-info ((prin1-to-string args) :prefix "args: ") + (let ((fun `(lambda ,args 'ok))) + (ert-info ("eval") + (should (eq (funcall (eval fun lb)) 'ok))) + (ert-info ("byte comp check") + (byte-compile-check-lambda-list args)) + (ert-info ("bytecomp") + (let ((byte-compile-debug t)) + (should (eq (funcall (byte-compile fun)) 'ok))))))))))) (dolist (form '(let let*)) -- cgit v1.2.3 From 3efa45849ab02b4c331d6d3d8a41ba03a1ef016a Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Wed, 29 Sep 2021 07:53:10 +0200 Subject: Improve the max-specpdl-size doc string * src/eval.c (syms_of_eval): Mention what "specpdl" means. --- src/eval.c | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'src/eval.c') diff --git a/src/eval.c b/src/eval.c index 66d34808f82..0f792b487ed 100644 --- a/src/eval.c +++ b/src/eval.c @@ -4311,13 +4311,19 @@ syms_of_eval (void) { DEFVAR_INT ("max-specpdl-size", max_specpdl_size, doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. -If Lisp code tries to increase the total number past this amount, -an error is signaled. -You can safely use a value considerably larger than the default value, -if that proves inconveniently small. However, if you increase it too far, -Emacs could run out of memory trying to make the stack bigger. -Note that this limit may be silently increased by the debugger -if `debug-on-error' or `debug-on-quit' is set. */); + +If Lisp code tries to use more bindings than this amount, an error is +signaled. + +You can safely increase this variable substantially if the default +value proves inconveniently small. However, if you increase it too +much, Emacs could run out of memory trying to make the stack bigger. +Note that this limit may be silently increased by the debugger if +`debug-on-error' or `debug-on-quit' is set. + +\"spec\" is short for \"special variables\", i.e., dynamically bound +variables. \"PDL\" is short for \"push-down list\", which is an old +term for \"stack\". */); DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. -- cgit v1.2.3 From c2055d41b4b145aa940ce940adc1a3fabfe87a6b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 24 Oct 2021 22:20:19 +0200 Subject: Add new macro `with-delayed-message' * doc/lispref/display.texi (Progress): Document it. * lisp/subr.el (with-delayed-message): New macro. * src/eval.c (with_delayed_message_display) (with_delayed_message_cancel): Helper functions. (Ffuncall_with_delayed_message): New function (bug#19776). --- doc/lispref/display.texi | 20 ++++++++++++++++++++ etc/NEWS | 10 ++++++++++ lisp/subr.el | 10 ++++++++++ src/eval.c | 45 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 85 insertions(+) (limited to 'src/eval.c') diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9c378a30277..6f95728e315 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -561,6 +561,26 @@ You can rewrite the previous example with this macro as follows: @end example @end defmac +@defmac with-delayed-message timeout message body@dots{} +Sometimes it's unclear whether an operation will take a long time to +execute or not, or it can be inconvenient to implement a progress +reporter. This macro can be used in those situations. + +@lisp +(with-delayed-message 2 (format "Gathering data for %s" entry) + (setq data (gather-data entry))) +@end lisp + +In this example, if the body takes more than two seconds to execute, +the message will be displayed. If it takes a shorter time than that, +the message won't be displayed. In either case, the body is evaluated +as normally, and the return value of the final element in the body is +the return value of the macro. + +The @var{message} element is evaluated before @var{body}, and is +always evaluated, whether the message is displayed or not. +@end defmac + @node Logging Messages @subsection Logging Messages in @file{*Messages*} @cindex logging echo-area messages diff --git a/etc/NEWS b/etc/NEWS index 0714a4d61b8..d47a91c31f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -284,6 +284,16 @@ Use 'exif-parse-file' and 'exif-field' instead. * Lisp Changes in Emacs 29.1 ++++ +** New macro 'with-delayed-message'. +This macro is like 'progn', but will output the specified message if +the body takes longer to execute than the specified timeout. + +--- +** New function 'funcall-with-delayed-message'. +This function is like 'funcall', but will output the specified message +is the function take longer to execute that the specified timeout. + ** Locale --- diff --git a/lisp/subr.el b/lisp/subr.el index 91189787d55..9acc79923c9 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -6723,4 +6723,14 @@ as the variable documentation string. (define-keymap--define (list ,@(nreverse opts) ,@defs)) ,@(and doc (list doc))))) +(defmacro with-delayed-message (timeout message &rest body) + "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds. +The MESSAGE form will be evaluated immediately, but the resulting +string will be displayed only if BODY takes longer than TIMEOUT seconds." + (declare (indent 2)) + `(funcall-with-delayed-message ,timeout ,message + (lambda () + ,@body))) + + ;;; subr.el ends here diff --git a/src/eval.c b/src/eval.c index 0f792b487ed..cd451ecff06 100644 --- a/src/eval.c +++ b/src/eval.c @@ -29,6 +29,7 @@ along with GNU Emacs. If not, see . */ #include "dispextern.h" #include "buffer.h" #include "pdumper.h" +#include "atimer.h" /* CACHEABLE is ordinarily nothing, except it is 'volatile' if necessary to cajole GCC into not warning incorrectly that a @@ -1078,6 +1079,49 @@ usage: (while TEST BODY...) */) return Qnil; } +static void +with_delayed_message_display (struct atimer *timer) +{ + printf("Here: %s\n", SDATA (timer->client_data)); + message3 (timer->client_data); +} + +static void +with_delayed_message_cancel (void *timer) +{ + cancel_atimer (timer); +} + +DEFUN ("funcall-with-delayed-message", + Ffuncall_with_delayed_message, Sfuncall_with_delayed_message, + 3, 3, 0, + doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer than TIMEOUT. +TIMEOUT is a number of seconds, and can be an integer or a floating +point number. + +If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE +is not displayed. */) + (Lisp_Object timeout, Lisp_Object message, Lisp_Object function) +{ + ptrdiff_t count = SPECPDL_INDEX (); + + CHECK_NUMBER (timeout); + CHECK_STRING (message); + + /* Set up the atimer. */ + struct timespec interval = dtotimespec (XFLOATINT (timeout)); + struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, + with_delayed_message_display, + message); + record_unwind_protect_ptr (with_delayed_message_cancel, timer); + + Lisp_Object result = CALLN (Ffuncall, function); + + cancel_atimer (timer); + + return unbind_to (count, result); +} + DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0, doc: /* Return result of expanding macros at top level of FORM. If FORM is not a macro call, it is returned unchanged. @@ -4511,6 +4555,7 @@ alist of active lexical bindings. */); defsubr (&Slet); defsubr (&SletX); defsubr (&Swhile); + defsubr (&Sfuncall_with_delayed_message); defsubr (&Smacroexpand); defsubr (&Scatch); defsubr (&Sthrow); -- cgit v1.2.3 From ea036e6f8d218241015d3e4a06360957b4e30266 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 24 Oct 2021 23:04:31 +0200 Subject: Remove debugging in with_delayed_message_display * src/eval.c (with_delayed_message_display): Remove debugging. --- src/eval.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/eval.c') diff --git a/src/eval.c b/src/eval.c index cd451ecff06..110b67b587f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1082,7 +1082,6 @@ usage: (while TEST BODY...) */) static void with_delayed_message_display (struct atimer *timer) { - printf("Here: %s\n", SDATA (timer->client_data)); message3 (timer->client_data); } -- cgit v1.2.3 From 83f1e4b3bcb9e651267adba79fed0a229263183e Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 25 Oct 2021 02:19:39 +0200 Subject: Fix issues with type casting in delayed message functions * src/eval.c (with_delayed_message_display) (with_delayed_message_cancel, Ffuncall_with_delayed_message): Fix some type confusion. --- src/eval.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/eval.c') diff --git a/src/eval.c b/src/eval.c index 110b67b587f..94ad0607732 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1082,12 +1082,13 @@ usage: (while TEST BODY...) */) static void with_delayed_message_display (struct atimer *timer) { - message3 (timer->client_data); + message3 (build_string (timer->client_data)); } static void with_delayed_message_cancel (void *timer) { + xfree (((struct atimer *) timer)->client_data); cancel_atimer (timer); } @@ -1111,13 +1112,11 @@ is not displayed. */) struct timespec interval = dtotimespec (XFLOATINT (timeout)); struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval, with_delayed_message_display, - message); + xstrdup (SSDATA (message))); record_unwind_protect_ptr (with_delayed_message_cancel, timer); Lisp_Object result = CALLN (Ffuncall, function); - cancel_atimer (timer); - return unbind_to (count, result); } -- cgit v1.2.3