commit ba300c96fa21af2fe7b7f25d16eec0a6c0738a95 (HEAD, refs/remotes/origin/master) Author: Stefan Monnier Date: Thu Jan 4 22:12:14 2024 -0500 * lisp/startup.el (startup--load-user-init-file): Fix last change Use `condition-case-unless-debug` only in the branch when `--debug-init` is not in use, otherwise it prevents `handler-bind` from triggering the debugger. diff --git a/lisp/startup.el b/lisp/startup.el index 4040d5d3774..23937055f30 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1041,88 +1041,88 @@ init-file, or to a default value if loading is not possible." (let ((inhibit-null-byte-detection t) (body (lambda () - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory - user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage))))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (condition-case-unless-debug error + (funcall body) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t)))))) - (if (eq init-file-debug t) - (handler-bind ((error #'startup--debug)) - (funcall body)) - (funcall body)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") commit 1d40c601b3b77d3bf1ad1bdfbaf2f479ba9c4998 Author: Graham Marlow Date: Tue Jan 2 13:58:22 2024 -0800 Improve yaml-ts-mode fill-paragraph (bug#68226) When using fill-paragraph on a block_scalar (the element within a block_node) fill the paragraph such that the contents remain within the block_node. This fixes the previous behavior that would clobber a block_node. * lisp/textmodes/yaml-ts-mode.el: Add yaml-ts-mode--fill-paragraph diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 2b57b384300..08fe4c49733 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -117,6 +117,26 @@ '((ERROR) @font-lock-warning-face)) "Tree-sitter font-lock settings for `yaml-ts-mode'.") +(defun yaml-ts-mode--fill-paragraph (&optional justify) + "Fill paragraph. +Behaves like `fill-paragraph', but respects block node +boundaries. JUSTIFY is passed to `fill-paragraph'." + (interactive "*P") + (save-restriction + (widen) + (let ((node (treesit-node-at (point)))) + (when (string= "block_scalar" (treesit-node-type node)) + (let* ((start (treesit-node-start node)) + (end (treesit-node-end node)) + (start-marker (point-marker)) + (fill-paragraph-function nil)) + (save-excursion + (goto-char start) + (forward-line) + (move-marker start-marker (point)) + (narrow-to-region (point) end)) + (fill-region start-marker end justify)))))) + ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -141,6 +161,8 @@ (constant escape-sequence number property) (bracket delimiter error misc-punctuation))) + (setq-local fill-paragraph-function #'yaml-ts-mode--fill-paragraph) + (treesit-major-mode-setup))) (if (treesit-ready-p 'yaml) commit 1081e975c9370999df1a288b117bfd9053050d21 Merge: 1870e2f48a7 ae75333ca78 Author: Stefan Monnier Date: Thu Jan 4 18:46:16 2024 -0500 Merge branch 'handler-bind' commit 1870e2f48a7874b9a7cd627198a6079d6a3b70c0 Author: Stefan Monnier Date: Thu Jan 4 18:44:43 2024 -0500 Avoid `defconst` for vars which we modify If we `setq` or let-bind a var, then presumably it's not a const. * lisp/bookmark.el (bookmark-bmenu-buffer): * lisp/char-fold.el (char-fold-table): * lisp/pcmpl-linux.el (pcmpl-linux-fs-modules-path-format) (pcmpl-linux-mtab-file): * lisp/emacs-lisp/bytecomp.el (byte-compile-log-buffer): * lisp/emacs-lisp/check-declare.el (check-declare-warning-buffer): * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): * lisp/erc/erc.el (erc-default-port): * lisp/net/tramp.el (tramp-unknown-id-string) (tramp-unknown-id-integer): * lisp/url/url-util.el (url-unreserved-chars): diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 893fdffb7ce..60dd61a5ac8 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -142,7 +142,7 @@ Nil means don't prompt for confirmation." "Non-nil means show annotations when jumping to a bookmark." :type 'boolean) -(defconst bookmark-bmenu-buffer "*Bookmark List*" +(defvar bookmark-bmenu-buffer "*Bookmark List*" "Name of buffer used for Bookmark List.") (defvar bookmark-bmenu-use-header-line t diff --git a/lisp/char-fold.el b/lisp/char-fold.el index a620d4d8dc3..4d9644216d8 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -214,7 +214,7 @@ equiv)) equiv))) -(defconst char-fold-table +(defvar char-fold-table (eval-when-compile (char-fold--make-table)) "Used for folding characters of the same group during search. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e940a135e51 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -262,7 +262,7 @@ This option is enabled by default because it reduces Emacs memory usage." :type 'boolean) ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp) -(defconst byte-compile-log-buffer "*Compile-Log*" +(defvar byte-compile-log-buffer "*Compile-Log*" "Name of the byte-compiler's log buffer.") (defvar byte-compile--known-dynamic-vars nil @@ -1874,7 +1874,7 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index 0362c7d2c24..8e40b227b65 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -40,7 +40,7 @@ ;;; Code: -(defconst check-declare-warning-buffer "*Check Declarations Warnings*" +(defvar check-declare-warning-buffer "*Check Declarations Warnings*" "Name of buffer used to display any `check-declare' warnings.") (defun check-declare-locate (file basefile) diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 0565440f357..e639a6278fc 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -1691,7 +1691,7 @@ Defaults to the server buffer." (defconst erc-default-server "irc.libera.chat" "IRC server to use if it cannot be detected otherwise.") -(defconst erc-default-port 6667 +(defvar erc-default-port 6667 "IRC port to use if it cannot be detected otherwise.") (defconst erc-default-port-tls 6697 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2f6b526039f..ad36dd53a32 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1085,10 +1085,10 @@ Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp (rx (* (not (any "\r\n"))) eos) "Regexp matching localnames.") -(defconst tramp-unknown-id-string "UNKNOWN" +(defvar tramp-unknown-id-string "UNKNOWN" "String used to denote an unknown user or group.") -(defconst tramp-unknown-id-integer -1 +(defvar tramp-unknown-id-integer -1 "Integer used to denote an unknown user or group.") ;;;###tramp-autoload @@ -2081,7 +2081,7 @@ without a visible progress reporter." (defmacro with-tramp-timeout (list &rest body) "Like `with-timeout', but allow SECONDS to be nil. -(fn (SECONDS TIMEOUT-FORMS...) BODY)" +\(fn (SECONDS TIMEOUT-FORMS...) BODY)" (declare (indent 1) (debug ((form body) body))) (let ((seconds (car list)) (timeout-forms (cdr list))) diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 3aee0b296f6..d0defc54174 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -61,7 +61,7 @@ (pcomplete-opt "hVanfFrsvwt(pcmpl-linux-fs-types)o?L?U?") (while (pcomplete-here (pcomplete-entries) nil #'identity))) -(defconst pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") +(defvar pcmpl-linux-fs-modules-path-format "/lib/modules/%s/kernel/fs/") (defun pcmpl-linux-fs-types () "Return a list of available fs modules on GNU/Linux systems." @@ -69,7 +69,7 @@ (directory-files (format pcmpl-linux-fs-modules-path-format kernel-ver)))) -(defconst pcmpl-linux-mtab-file "/etc/mtab") +(defvar pcmpl-linux-mtab-file "/etc/mtab") (defun pcmpl-linux-mounted-directories () "Return a list of mounted directory names." diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index 28d1885387d..5f45b98c7a5 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -335,7 +335,7 @@ appropriate coding-system; see `decode-coding-string'." str (substring str (match-end 0))))) (concat tmp str))) -(defconst url-unreserved-chars +(defvar url-unreserved-chars '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 commit ae75333ca78f5c45e53e7e5d25f4e04a4d69ad8f Author: Stefan Monnier Date: Thu Jan 4 16:28:39 2024 -0500 Improve `handler-bind` doc * doc/lispref/control.texi (Handling Errors) : Expand. * doc/lispref/variables.texi (Variable Scoping): Mention static scoping. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index 6cc25dcdaee..3c9f26262c1 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -1,6 +1,6 @@ @c -*- mode: texinfo; coding: utf-8 -*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--1999, 2001--2024 Free Software +@c Copyright (C) 1990--2024 Free Software @c Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Control Structures @@ -2311,24 +2311,102 @@ form. In this case, the @code{handler-bind} has no effect. @code{(@var{conditions} @var{handler})} where @var{conditions} is an error condition name to be handled, or a list of condition names, and @var{handler} should be a form whose evaluation should return a function. +As with @code{condition-case}, condition names are symbols. Before running @var{body}, @code{handler-bind} evaluates all the @var{handler} forms and installs those handlers to be active during -the evaluation of @var{body}. These handlers are searched together -with those installed by @code{condition-case}. When the innermost +the evaluation of @var{body}. When an error is signaled, +Emacs searches all the active @code{condition-case} and +@code{handler-bind} forms for a handler that +specifies one or more of these condition names. When the innermost matching handler is one installed by @code{handler-bind}, the @var{handler} function is called with a single argument holding the error description. -@var{handler} is called in the dynamic context where the error -happened, without first unwinding the stack, meaning that all the -dynamic bindings are still in effect, except that all the error -handlers between the code that signaled the error and the -@code{handler-bind} are temporarily suspended. Like any normal -function, @var{handler} can exit non-locally, typically via -@code{throw}, or it can return normally. If @var{handler} returns -normally, it means the handler @emph{declined} to handle the error and -the search for an error handler is continued where it left off. +Contrary to what happens with @code{condition-case}, @var{handler} is +called in the dynamic context where the error happened. This means it +is executed unbinding any variable bindings or running any cleanups of +@code{unwind-protect}, so that all those dynamic bindings are still in +effect. There is one exception: while running the @var{handler} +function, all the error handlers between the code that signaled the +error and the @code{handler-bind} are temporarily suspended, meaning +that when an error is signaled, Emacs will only search the active +@code{condition-case} and @code{handler-bind} forms that are inside +the @var{handler} function or outside of the current +@code{handler-bind}. Note also that lexical variables are not +affected, since they do not have dynamic extent. + +Like any normal function, @var{handler} can exit non-locally, +typically via @code{throw}, or it can return normally. +If @var{handler} returns normally, it means the handler +@emph{declined} to handle the error and the search for an error +handler is continued where it left off. + +For example, if we wanted to keep a log of all the errors that occur +during the execution of a particular piece of code together with the +buffer that's current when the error is signaled, but without +otherwise affecting the behavior of that code, we can do it with: + +@example +@group +(handler-bind + ((error + (lambda (err) + (push (cons err (current-buffer)) my-log-of-errors)))) + @var{body-forms}@dots{}) +@end group +@end example + +This will log only those errors that are not caught internally to +@var{body-forms}@dots{}, in other words errors that ``escape'' from +@var{body-forms}@dots{}, and it will not prevent those errors from +being passed on to surrounding @code{condition-case} handlers (or +@code{handler-bind} handlers for that matter) since the above handler +returns normally. + +We can also use @code{handler-bind} to replace an error with another, +as in the code below which turns all errors of type @code{user-error} +that occur during the execution of @var{body-forms}@dots{} into plain +@code{error}: + +@example +@group +(handler-bind + ((user-error + (lambda (err) + (signal 'error (cdr err))))) + @var{body-forms}@dots{}) +@end group +@end example + +We can get almost the same result with @code{condition-case}: + +@example +@group +(condition-case err + (progn @var{body-forms}@dots{}) + (user-error (signal 'error (cdr err)))) +@end group +@end example + +@noindent +but with the difference that when we (re)signal the new error in +@code{handler-bind} the dynamic environment from the original error is +still active, which means for example that if we enter the +debugger at this point, it will show us a complete backtrace including +the point where we signaled the original error: + +@example +@group +Debugger entered--Lisp error: (error "Oops") + signal(error ("Oops")) + (closure (t) (err) (signal 'error (cdr err)))((user-error "Oops")) + user-error("Oops") + @dots{} + eval((handler-bind ((user-error (lambda (err) @dots{} +@end group +@end example + @end defmac @node Error Symbols diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 705d3260063..4d61d461deb 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Emacs Lisp Reference Manual. -@c Copyright (C) 1990--1995, 1998--2024 Free Software Foundation, Inc. +@c Copyright (C) 1990--2024 Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @node Variables @chapter Variables @@ -978,6 +978,7 @@ program is executing, the binding exists. @cindex lexical binding @cindex lexical scope +@cindex static scope @cindex indefinite extent For historical reasons, there are two dialects of Emacs Lisp, selected via the @code{lexical-binding} buffer-local variable. @@ -989,6 +990,7 @@ binding can also be accessed from the Lisp debugger.}. It also has @dfn{indefinite extent}, meaning that under some circumstances the binding can live on even after the binding construct has finished executing, by means of objects called @dfn{closures}. +Lexical scoping is also commonly called @dfn{static scoping}. @cindex dynamic binding @cindex dynamic scope commit 391c208aecc44fd82c599696d47a18782f2f36da Author: Stefan Monnier Date: Mon Dec 25 21:41:08 2023 -0500 (backtrace-on-redisplay-error): Use `handler-bind` Reimplement `backtrace-on-redisplay-error` using `push_handler_bind`. This moves the code from `signal_or_quit` to `xdisp.c` and `debug-early.el`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Add `base` arg to strip "internal" frames. (debug--early): New function, extracted from `debug-early`. (debug-early, debug-early--handler): Use it. (debug-early--muted): New function, extracted (translated) from `signal_or_quit`; trim the buffer to a max of 10 backtraces. * src/xdisp.c (funcall_with_backtraces): New function. (dsafe_calln): Use it. (syms_of_xdisp): Defsym `Qdebug_early__muted`. * src/eval.c (redisplay_deep_handler): Delete var. (init_eval, internal_condition_case_n): Don't set it any more. (backtrace_yet): Delete var. (signal_or_quit): Remove special case for `backtrace_on_redisplay_error`. * src/keyboard.c (command_loop_1): Don't set `backtrace_yet` any more. * src/lisp.h (backtrace_yet): Don't declare. diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index 464c2e96927..8a0dddc2679 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -27,14 +27,17 @@ ;; This file dumps a backtrace on stderr when an error is thrown. It ;; has no dependencies on any Lisp libraries and is thus used for ;; generating backtraces for bugs in the early parts of bootstrapping. -;; It is also always used in batch model. It was introduced in Emacs +;; It is also always used in batch mode. It was introduced in Emacs ;; 29, before which there was no backtrace available during early ;; bootstrap. ;;; Code: +;; For bootstrap reasons, we cannot use any macros here since they're +;; not defined yet. + (defalias 'debug-early-backtrace - #'(lambda () + #'(lambda (&optional base) "Print a trace of Lisp function calls currently active. The output stream used is the value of `standard-output'. @@ -51,26 +54,39 @@ of the build process." (require 'cl-print) (error nil))) #'cl-prin1 - #'prin1))) + #'prin1)) + (first t)) (mapbacktrace #'(lambda (evald func args _flags) - (let ((args args)) - (if evald + (if first + ;; The first is the debug-early entry point itself. + (setq first nil) + (let ((args args)) + (if evald + (progn + (princ " ") + (funcall prin1 func) + (princ "(")) (progn - (princ " ") - (funcall prin1 func) - (princ "(")) - (progn - (princ " (") - (setq args (cons func args)))) - (if args - (while (progn - (funcall prin1 (car args)) - (setq args (cdr args))) - (princ " "))) - (princ ")\n"))))))) - -(defalias 'debug-early + (princ " (") + (setq args (cons func args)))) + (if args + (while (progn + (funcall prin1 (car args)) + (setq args (cdr args))) + (princ " "))) + (princ ")\n")))) + base)))) + +(defalias 'debug--early + #'(lambda (error base) + (princ "\nError: ") + (prin1 (car error)) ; The error symbol. + (princ " ") + (prin1 (cdr error)) ; The error data. + (debug-early-backtrace base))) + +(defalias 'debug-early ;Called from C. #'(lambda (&rest args) "Print an error message with a backtrace of active Lisp function calls. The output stream used is the value of `standard-output'. @@ -88,14 +104,31 @@ support the latter, except in batch mode which always uses \(In versions of Emacs prior to Emacs 29, no backtrace was available before `debug' was usable.)" - (princ "\nError: ") - (prin1 (car (car (cdr args)))) ; The error symbol. - (princ " ") - (prin1 (cdr (car (cdr args)))) ; The error data. - (debug-early-backtrace))) + (debug--early (car (cdr args)) #'debug-early))) ; The error object. (defalias 'debug-early--handler ;Called from C. #'(lambda (err) - (if backtrace-on-error-noninteractive (debug-early 'error err)))) + (if backtrace-on-error-noninteractive + (debug--early err #'debug-early--handler)))) + +(defalias 'debug-early--muted ;Called from C. + #'(lambda (err) + (save-current-buffer + (set-buffer (get-buffer-create "*Redisplay-trace*")) + (goto-char (point-max)) + (if (bobp) nil + (let ((separator "\n\n\n\n")) + (save-excursion + ;; The C code tested `backtrace_yet', instead we + ;; keep a max of 10 backtraces. + (if (search-backward separator nil t 10) + (delete-region (point-min) (match-end 0)))) + (insert separator))) + (insert "-- Caught at " (current-time-string) "\n") + (let ((standard-output (current-buffer))) + (debug--early err #'debug-early--muted)) + (setq delayed-warnings-list + (cons '(error "Error in a redisplay Lisp hook. See buffer *Redisplay-trace*") + delayed-warnings-list))))) ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 1dd797063eb..94f6d8e31f8 100644 --- a/src/eval.c +++ b/src/eval.c @@ -57,12 +57,6 @@ Lisp_Object Vrun_hooks; /* FIXME: We should probably get rid of this! */ Lisp_Object Vsignaling_function; -/* The handler structure which will catch errors in Lisp hooks called - from redisplay. We do not use it for this; we compare it with the - handler which is about to be used in signal_or_quit, and if it - matches, cause a backtrace to be generated. */ -static struct handler *redisplay_deep_handler; - /* These would ordinarily be static, but they need to be visible to GDB. */ bool backtrace_p (union specbinding *) EXTERNALLY_VISIBLE; Lisp_Object *backtrace_args (union specbinding *) EXTERNALLY_VISIBLE; @@ -244,7 +238,6 @@ init_eval (void) lisp_eval_depth = 0; /* This is less than the initial value of num_nonmacro_input_events. */ when_entered_debugger = -1; - redisplay_deep_handler = NULL; } static void @@ -1611,16 +1604,12 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), ptrdiff_t nargs, Lisp_Object *args)) { - struct handler *old_deep = redisplay_deep_handler; struct handler *c = push_handler (handlers, CONDITION_CASE); - if (redisplaying_p) - redisplay_deep_handler = c; if (sys_setjmp (c->jmp)) { Lisp_Object val = handlerlist->val; clobbered_eassert (handlerlist == c); handlerlist = handlerlist->next; - redisplay_deep_handler = old_deep; return hfun (val, nargs, args); } else @@ -1628,7 +1617,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), Lisp_Object val = bfun (nargs, args); eassert (handlerlist == c); handlerlist = c->next; - redisplay_deep_handler = old_deep; return val; } } @@ -1766,11 +1754,6 @@ quit (void) return signal_or_quit (Qquit, Qnil, true); } -/* Has an error in redisplay giving rise to a backtrace occurred as - yet in the current command? This gets reset in the command - loop. */ -bool backtrace_yet = false; - /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. If CONTINUABLE, the caller allows this function to return (presumably after calling the debugger); @@ -1897,51 +1880,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) return Qnil; } - /* If an error is signaled during a Lisp hook in redisplay, write a - backtrace into the buffer *Redisplay-trace*. */ - /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ - if (!debugger_called && !oom - && backtrace_on_redisplay_error - && (NILP (clause) || h == redisplay_deep_handler) - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - specpdl_ref count = SPECPDL_INDEX (); - max_ensure_room (100); - AUTO_STRING (redisplay_trace, "*Redisplay-trace*"); - Lisp_Object redisplay_trace_buffer; - AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ - Lisp_Object delayed_warning; - redisplay_trace_buffer = Fget_buffer_create (redisplay_trace, Qnil); - current_buffer = XBUFFER (redisplay_trace_buffer); - if (!backtrace_yet) /* Are we on the first backtrace of the command? */ - Ferase_buffer (); - else - Finsert (1, &gap); - backtrace_yet = true; - specbind (Qstandard_output, redisplay_trace_buffer); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, error)); - unbind_to (count, Qnil); - delayed_warning = make_string - ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61); - - Vdelayed_warnings_list = Fcons (list2 (Qerror, delayed_warning), - Vdelayed_warnings_list); - } - if (!NILP (clause)) - { - unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); - } - else - { - if (handlerlist != handlerlist_sentinel) - /* FIXME: This will come right back here if there's no `top-level' - catcher. A better solution would be to abort here, and instead - add a catch-all condition handler so we never come here. */ - Fthrow (Qtop_level, Qt); - } + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); + else if (handlerlist != handlerlist_sentinel) + /* FIXME: This will come right back here if there's no `top-level' + catcher. A better solution would be to abort here, and instead + add a catch-all condition handler so we never come here. */ + Fthrow (Qtop_level, Qt); string = Ferror_message_string (error); fatal ("%s", SDATA (string)); diff --git a/src/keyboard.c b/src/keyboard.c index aa7d732bcc3..e1d738dd6ef 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1167,9 +1167,10 @@ top_level_2 (void) encountering an error, to help with debugging. */ bool setup_handler = noninteractive; if (setup_handler) + /* FIXME: Should we (re)use `list_of_error` from `xdisp.c`? */ push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); - Lisp_Object res = Feval (Vtop_level, Qnil); + Lisp_Object res = Feval (Vtop_level, Qt); if (setup_handler) pop_handler (); @@ -1365,7 +1366,6 @@ command_loop_1 (void) display_malloc_warning (); Vdeactivate_mark = Qnil; - backtrace_yet = false; /* Don't ignore mouse movements for more than a single command loop. (This flag is set in xdisp.c whenever the tool bar is diff --git a/src/lisp.h b/src/lisp.h index 0e082d14a40..44f69892c6f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4529,7 +4529,6 @@ extern Lisp_Object Vrun_hooks; extern Lisp_Object Vsignaling_function; extern Lisp_Object inhibit_lisp_code; extern bool signal_quit_p (Lisp_Object); -extern bool backtrace_yet; /* To run a normal hook, use the appropriate function from the list below. The calling convention: diff --git a/src/xdisp.c b/src/xdisp.c index aeaf8b34652..f8670c6ecb5 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3072,10 +3072,24 @@ dsafe__call (bool inhibit_quit, Lisp_Object (f) (ptrdiff_t, Lisp_Object *), return val; } +static Lisp_Object +funcall_with_backtraces (ptrdiff_t nargs, Lisp_Object *args) +{ + /* If an error is signaled during a Lisp hook in redisplay, write a + backtrace into the buffer *Redisplay-trace*. */ + push_handler_bind (list_of_error, Qdebug_early__muted, 0); + Lisp_Object res = Ffuncall (nargs, args); + pop_handler (); + return res; +} + #define SAFE_CALLMANY(inhibit_quit, f, array) \ dsafe__call ((inhibit_quit), f, ARRAYELTS (array), array) -#define dsafe_calln(inhibit_quit, ...) \ - SAFE_CALLMANY ((inhibit_quit), Ffuncall, ((Lisp_Object []) {__VA_ARGS__})) +#define dsafe_calln(inhibit_quit, ...) \ + SAFE_CALLMANY ((inhibit_quit), \ + backtrace_on_redisplay_error \ + ? funcall_with_backtraces : Ffuncall, \ + ((Lisp_Object []) {__VA_ARGS__})) static Lisp_Object dsafe_call1 (Lisp_Object f, Lisp_Object arg) @@ -37753,6 +37767,8 @@ cursor shapes. */); DEFSYM (Qthin_space, "thin-space"); DEFSYM (Qzero_width, "zero-width"); + DEFSYM (Qdebug_early__muted, "debug-early--muted"); + DEFVAR_LISP ("pre-redisplay-function", Vpre_redisplay_function, doc: /* Function run just before redisplay. It is called with one argument, which is the set of windows that are to commit 2ef6e40da88d5b4f070e339a2210f5751ab6a7cb Author: Stefan Monnier Date: Wed Dec 27 15:06:32 2023 -0500 (signal_or_quit): Preserve error object identity Make sure we build the (ERROR-SYMBOL . ERROR-DATA) object only once when signaling an error, so that its `eq` identity can be used. It also gets us a tiny bit closer to having real "error objects" like in most other current programming languages. * src/eval.c (maybe_call_debugger): Change arglist to receive the error object instead of receiving the signal and the data separately. (signal_or_quit): Build the error object right at the beginning so it stays `eq` to itself. Rename the `keyboard_quit` arg to `continuable` so say what it does rather than what it's used for. (signal_quit_p): Change arg to be the error object rather than just the error-symbol. * src/keyboard.c (cmd_error_internal, menu_item_eval_property_1): Adjust calls to `signal_quit_p` accordingly. * test/src/eval-tests.el (eval-tests--error-id): New test. diff --git a/src/eval.c b/src/eval.c index b982c124184..1dd797063eb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1706,8 +1706,7 @@ push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) static Lisp_Object signal_or_quit (Lisp_Object, Lisp_Object, bool); static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object); -static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, - Lisp_Object data); +static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object error); static void process_quit_flag (void) @@ -1773,20 +1772,25 @@ quit (void) bool backtrace_yet = false; /* Signal an error, or quit. ERROR_SYMBOL and DATA are as with Fsignal. - If KEYBOARD_QUIT, this is a quit; ERROR_SYMBOL should be - Qquit and DATA should be Qnil, and this function may return. + If CONTINUABLE, the caller allows this function to return + (presumably after calling the debugger); Otherwise this function is like Fsignal and does not return. */ static Lisp_Object -signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) +signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) { /* When memory is full, ERROR-SYMBOL is nil, and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). That is a special case--don't do this in other situations. */ + bool oom = NILP (error_symbol); + Lisp_Object error /* The error object. */ + = oom ? data + : (!SYMBOLP (error_symbol) && NILP (data)) ? error_symbol + : Fcons (error_symbol, data); Lisp_Object conditions; Lisp_Object string; Lisp_Object real_error_symbol - = (NILP (error_symbol) ? Fcar (data) : error_symbol); + = CONSP (error) ? XCAR (error) : error_symbol; Lisp_Object clause = Qnil; struct handler *h; int skip; @@ -1804,11 +1808,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) - && ! NILP (error_symbol)) + && !oom) { specpdl_ref count = SPECPDL_INDEX (); max_ensure_room (20); /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ + /* FIXME: Here we still "split" the error object + into its error-symbol and its error-data? */ call2 (Vsignal_hook_function, error_symbol, data); unbind_to (count, Qnil); } @@ -1820,7 +1826,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) too. Don't do this when ERROR_SYMBOL is nil, because that is a memory-full error. */ Vsignaling_function = Qnil; - if (!NILP (error_symbol)) + if (!oom) { union specbinding *pdl = backtrace_next (backtrace_top ()); if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror)) @@ -1845,14 +1851,11 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) { if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) { - Lisp_Object error_data - = (NILP (error_symbol) - ? data : Fcons (error_symbol, data)); specpdl_ref count = SPECPDL_INDEX (); max_ensure_room (20); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); - call1 (h->val, error_data); + call1 (h->val, error); unbind_to (count, Qnil); pop_handler (); } @@ -1875,7 +1878,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) bool debugger_called = false; if (/* Don't run the debugger for a memory-full error. (There is no room in memory to do that!) */ - !NILP (error_symbol) + !oom && (!NILP (Vdebug_on_signal) /* If no handler is present now, try to run the debugger. */ || NILP (clause) @@ -1887,17 +1890,17 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || EQ (clause, Qerror))) { debugger_called - = maybe_call_debugger (conditions, error_symbol, data); + = maybe_call_debugger (conditions, error); /* We can't return values to code which signaled an error, but we can continue code which has signaled a quit. */ - if (keyboard_quit && debugger_called && EQ (real_error_symbol, Qquit)) + if (continuable && debugger_called) return Qnil; } /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ - if (!debugger_called && !NILP (error_symbol) + if (!debugger_called && !oom && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) && NILP (Vinhibit_debugger) @@ -1918,7 +1921,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) backtrace_yet = true; specbind (Qstandard_output, redisplay_trace_buffer); specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); + call_debugger (list2 (Qerror, error)); unbind_to (count, Qnil); delayed_warning = make_string ("Error in a redisplay Lisp hook. See buffer *Redisplay-trace*", 61); @@ -1929,10 +1932,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) if (!NILP (clause)) { - Lisp_Object unwind_data - = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); - - unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, unwind_data); + unwind_to_catch (h, NONLOCAL_EXIT_SIGNAL, error); } else { @@ -1943,10 +1943,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Fthrow (Qtop_level, Qt); } - if (! NILP (error_symbol)) - data = Fcons (error_symbol, data); - - string = Ferror_message_string (data); + string = Ferror_message_string (error); fatal ("%s", SDATA (string)); } @@ -2071,14 +2068,15 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data) return 0; } -/* Say whether SIGNAL is a `quit' symbol (or inherits from it). */ +/* Say whether SIGNAL is a `quit' error (or inherits from it). */ bool -signal_quit_p (Lisp_Object signal) +signal_quit_p (Lisp_Object error) { + Lisp_Object signal = CONSP (error) ? XCAR (error) : Qnil; Lisp_Object list; return EQ (signal, Qquit) - || (!NILP (Fsymbolp (signal)) + || (SYMBOLP (signal) && CONSP (list = Fget (signal, Qerror_conditions)) && !NILP (Fmemq (Qquit, list))); } @@ -2089,27 +2087,23 @@ signal_quit_p (Lisp_Object signal) = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). This is for memory-full errors only. */ static bool -maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data) +maybe_call_debugger (Lisp_Object conditions, Lisp_Object error) { - Lisp_Object combined_data; - - combined_data = Fcons (sig, data); - if ( /* Don't try to run the debugger with interrupts blocked. The editing loop would return anyway. */ ! input_blocked_p () && NILP (Vinhibit_debugger) /* Does user want to enter debugger for this kind of error? */ - && (signal_quit_p (sig) + && (signal_quit_p (error) ? debug_on_quit : wants_debugger (Vdebug_on_error, conditions)) - && ! skip_debugger (conditions, combined_data) + && ! skip_debugger (conditions, error) /* See commentary on definition of `internal-when-entered-debugger'. */ && when_entered_debugger < num_nonmacro_input_events) { - call_debugger (list2 (Qerror, combined_data)); + call_debugger (list2 (Qerror, error)); return 1; } diff --git a/src/keyboard.c b/src/keyboard.c index 816147c9130..aa7d732bcc3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1026,7 +1026,7 @@ cmd_error_internal (Lisp_Object data, const char *context) { /* The immediate context is not interesting for Quits, since they are asynchronous. */ - if (signal_quit_p (XCAR (data))) + if (signal_quit_p (data)) Vsignaling_function = Qnil; Vquit_flag = Qnil; @@ -8619,7 +8619,7 @@ menu_item_eval_property_1 (Lisp_Object arg) { /* If we got a quit from within the menu computation, quit all the way out of it. This takes care of C-] in the debugger. */ - if (CONSP (arg) && signal_quit_p (XCAR (arg))) + if (signal_quit_p (arg)) quit (); return Qnil; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 9ac117859dd..e1c90feb09a 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -340,4 +340,14 @@ expressions works for identifiers starting with period." (error 'plain-error)) 'wrong-type-argument))) +(ert-deftest eval-tests--error-id () + (let* (inner-error + (outer-error + (condition-case err + (handler-bind ((error (lambda (err) (setq inner-error err)))) + (car 1)) + (error err)))) + (should (eq inner-error outer-error)))) + + ;;; eval-tests.el ends here commit 02edbc88a1210b8d5a3e62ca4f03ffd17b23cbf7 Author: Stefan Monnier Date: Tue Dec 26 23:56:09 2023 -0500 eval.c: Add new var `lisp-eval-depth-reserve` Rather than blindly increase `max-lisp-eval-depth` when entering the debugger or running `signal-hook-function`, use this new "reserve" to keep track of how much we have grown the stack for "debugger" purposes so that for example recursive calls to `signal-hook-function` can't eat up the whole C stack. * src/eval.c (max_ensure_room): Rewrite. (restore_stack_limits): Move before `max_ensure_room`. Rewrite. (call_debugger, signal_or_quit): Adjust calls accordingly. Also grow `max-lisp-eval-depth` for `hander-bind` handlers. (init_eval_once): Don't initialize `max_lisp_eval_depth` here. (syms_of_eval): Initialize it here instead. Add new var `lisp-eval-depth-reserve`. * doc/lispref/eval.texi (Eval): Add `lisp-eval-depth-reserve`. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index f4c99640143..b42020f43af 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -844,11 +844,24 @@ function body forms, as well as explicit calls in Lisp code. The default value of this variable is 1600. If you set it to a value less than 100, Lisp will reset it to 100 if the given value is -reached. Entry to the Lisp debugger increases the value, if there is -little room left, to make sure the debugger itself has room to -execute. +reached. @end defopt +@defopt lisp-eval-depth-reserve +In order to be able to debug infinite recursion errors, when invoking the +Lisp debugger, Emacs increases temporarily the value of +@code{max-lisp-eval-depth}, if there is little room left, to make sure +the debugger itself has room to execute. The same happens when +running the handler of a @code{handler-bind}. @xref{Handling Errors}. + +The variable @code{lisp-eval-depth-reserve} bounds the extra depth +that Emacs can add to @code{max-lisp-eval-depth} for those +exceptional circumstances. + +The default value of this variable is 200. +@end defopt + + @defvar values The value of this variable is a list of the values returned by all the expressions that were read, evaluated, and printed from buffers diff --git a/etc/NEWS b/etc/NEWS index db3b838c380..7bbfbf9512d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,11 @@ This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. ++++ +** New variable 'lisp-eval-depth-reserve'. +It puts a limit to the amount by which Emacs can temporarily increase +'max-lisp-eval-depth' when handling signals. + +++ ** New special form 'handler-bind'. Provides a functionality similar to `condition-case` except it runs the diff --git a/src/eval.c b/src/eval.c index 7e578a1aa05..b982c124184 100644 --- a/src/eval.c +++ b/src/eval.c @@ -212,7 +212,6 @@ void init_eval_once (void) { /* Don't forget to update docs (lispref node "Eval"). */ - max_lisp_eval_depth = 1600; Vrun_hooks = Qnil; pdumper_do_now_and_after_load (init_eval_once_for_pdumper); } @@ -248,22 +247,29 @@ init_eval (void) redisplay_deep_handler = NULL; } -/* Ensure that *M is at least A + B if possible, or is its maximum - value otherwise. */ - static void -max_ensure_room (intmax_t *m, intmax_t a, intmax_t b) +restore_stack_limits (Lisp_Object data) { - intmax_t sum = ckd_add (&sum, a, b) ? INTMAX_MAX : sum; - *m = max (*m, sum); + intmax_t old_depth; + integer_to_intmax (data, &old_depth); + lisp_eval_depth_reserve += max_lisp_eval_depth - old_depth; + max_lisp_eval_depth = old_depth; } -/* Unwind-protect function used by call_debugger. */ +/* Try and ensure that we have at least B dpeth available. */ static void -restore_stack_limits (Lisp_Object data) +max_ensure_room (intmax_t b) { - integer_to_intmax (data, &max_lisp_eval_depth); + intmax_t sum = ckd_add (&sum, lisp_eval_depth, b) ? INTMAX_MAX : sum; + intmax_t diff = min (sum - max_lisp_eval_depth, lisp_eval_depth_reserve); + if (diff <= 0) + return; + intmax_t old_depth = max_lisp_eval_depth; + max_lisp_eval_depth += diff; + lisp_eval_depth_reserve -= diff; + /* Restore limits after leaving the debugger. */ + record_unwind_protect (restore_stack_limits, make_int (old_depth)); } /* Call the Lisp debugger, giving it argument ARG. */ @@ -274,16 +280,12 @@ call_debugger (Lisp_Object arg) bool debug_while_redisplaying; specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; - intmax_t old_depth = max_lisp_eval_depth; /* The previous value of 40 is too small now that the debugger prints using cl-prin1 instead of prin1. Printing lists nested 8 deep (which is the value of print-level used in the debugger) currently requires 77 additional frames. See bug#31919. */ - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - - /* Restore limits after leaving the debugger. */ - record_unwind_protect (restore_stack_limits, make_int (old_depth)); + max_ensure_room (100); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -1802,16 +1804,13 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) - && ! NILP (error_symbol) - /* Don't try to call a lisp function if we've already overflowed - the specpdl stack. */ - && specpdl_ptr < specpdl_end) + && ! NILP (error_symbol)) { - /* Edebug takes care of restoring these variables when it exits. */ - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); - + specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (20); /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); + unbind_to (count, Qnil); } conditions = Fget (real_error_symbol, Qerror_conditions); @@ -1849,9 +1848,12 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Lisp_Object error_data = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); + specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (20); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); call1 (h->val, error_data); + unbind_to (count, Qnil); pop_handler (); } continue; @@ -1901,8 +1903,8 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); specpdl_ref count = SPECPDL_INDEX (); + max_ensure_room (100); AUTO_STRING (redisplay_trace, "*Redisplay-trace*"); Lisp_Object redisplay_trace_buffer; AUTO_STRING (gap, "\n\n\n\n"); /* Separates things in *Redisplay-trace* */ @@ -4345,6 +4347,13 @@ actual stack overflow in C, which would be fatal for Emacs. You can safely make it considerably larger than its default value, if that proves inconveniently small. However, if you increase it too far, Emacs could overflow the real C stack, and crash. */); + max_lisp_eval_depth = 1600; + + DEFVAR_INT ("lisp-eval-depth-reserve", lisp_eval_depth_reserve, + doc: /* Extra depth that can be allocated to handle errors. +This is the max depth that the system will add to `max-lisp-eval-depth' +when calling debuggers or `handler-bind' handlers. */); + lisp_eval_depth_reserve = 200; DEFVAR_LISP ("quit-flag", Vquit_flag, doc: /* Non-nil causes `eval' to abort, unless `inhibit-quit' is non-nil. commit a5dcc1abea32abc906abfb66599c280b01d6ba27 Author: Stefan Monnier Date: Mon Dec 25 23:55:53 2023 -0500 (macroexp--with-extended-form-stack): Use plain `let` `macroexp--with-extended-form-stack` used manual push/pop so that upon non-local exits the "deeper" value is kept, so the error handler gets to know what was the deeper value, so as to be able to compute more precise error locations. Replace this with a `handler-bind` which catches that "deeper" value more explicitly. * lisp/emacs-lisp/bytecomp.el (bytecomp--displaying-warnings): Use `handler-bind` to catch the value of `byte-compile-form-stack` at the time of the error. Also consolidate the duplicated code. * lisp/emacs-lisp/macroexp.el (macroexp--with-extended-form-stack): Use a plain dynbound let-rebinding. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 1ef3f0fba6d..e36a79aaa8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1874,39 +1874,44 @@ It is too wide if it has any lines longer than the largest of (setq byte-to-native-plist-environment overriding-plist-environment))))) -(defmacro displaying-byte-compile-warnings (&rest body) +(defmacro displaying-byte-compile-warnings (&rest body) ;FIXME: Namespace! (declare (debug (def-body))) `(bytecomp--displaying-warnings (lambda () ,@body))) (defun bytecomp--displaying-warnings (body-fn) - (let* ((warning-series-started + (let* ((wrapped-body + (lambda () + (if byte-compile-debug + (funcall body-fn) + ;; Use a `handler-bind' to remember the `byte-compile-form-stack' + ;; active at the time the error is signaled, so as to + ;; get more precise error locations. + (let ((form-stack nil)) + (condition-case error-info + (handler-bind + ((error (lambda (_err) + (setq form-stack byte-compile-form-stack)))) + (funcall body-fn)) + (error (let ((byte-compile-form-stack form-stack)) + (byte-compile-report-error error-info)))))))) + (warning-series-started (and (markerp warning-series) (eq (marker-buffer warning-series) (get-buffer byte-compile-log-buffer)))) (byte-compile-form-stack byte-compile-form-stack)) - (if (or (eq warning-series 'byte-compile-warning-series) + (if (or (eq warning-series #'byte-compile-warning-series) warning-series-started) ;; warning-series does come from compilation, ;; so don't bind it, but maybe do set it. - (let (tem) - ;; Log the file name. Record position of that text. - (setq tem (byte-compile-log-file)) + (let ((tem (byte-compile-log-file))) ;; Log the file name. (unless warning-series-started - (setq warning-series (or tem 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info))))) + (setq warning-series (or tem #'byte-compile-warning-series))) + (funcall wrapped-body)) ;; warning-series does not come from compilation, so bind it. (let ((warning-series ;; Log the file name. Record position of that text. - (or (byte-compile-log-file) 'byte-compile-warning-series))) - (if byte-compile-debug - (funcall body-fn) - (condition-case error-info - (funcall body-fn) - (error (byte-compile-report-error error-info)))))))) + (or (byte-compile-log-file) #'byte-compile-warning-series))) + (funcall wrapped-body))))) ;;;###autoload (defun byte-force-recompile (directory) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 0e4fd3ea521..b87b749dd76 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -42,14 +42,8 @@ condition-case handling a signaled error.") (defmacro macroexp--with-extended-form-stack (expr &rest body) "Evaluate BODY with EXPR pushed onto `byte-compile-form-stack'." (declare (indent 1)) - ;; FIXME: We really should just be using a simple dynamic let-binding here, - ;; but these explicit push and pop make the extended stack value visible - ;; to error handlers. Remove that need for that! - `(progn - (push ,expr byte-compile-form-stack) - (prog1 - (progn ,@body) - (pop byte-compile-form-stack)))) + `(let ((byte-compile-form-stack (cons ,expr byte-compile-form-stack))) + ,@body)) ;; Bound by the top-level `macroexpand-all', and modified to include any ;; macros defined by `defmacro'. commit 604e34338f3b5a31439020c6704f9f9d07d17d69 Author: Stefan Monnier Date: Wed Dec 20 23:31:39 2023 -0500 Move batch backtrace code to `top_level_2` Move ad-hoc code meant to ease debugging of bootstrap (and batch mode) to `top_level_2` so it doesn't pollute `signal_or_quit`. * src/lisp.h (pop_handler, push_handler_bind): Declare. * src/keyboard.c (top_level_2): Setup an error handler to call `debug-early` when noninteractive. * src/eval.c (pop_handler): Not static any more. (signal_or_quit): Remove special case for noninteractive use. (push_handler_bind): New function, extracted from `Fhandler_bind_1`. (Fhandler_bind_1): Use it. (syms_of_eval): Declare `Qdebug_early__handler`. * lisp/emacs-lisp/debug-early.el (debug-early-backtrace): Weed out frames below `debug-early`. (debug-early--handler): New function. diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index f2eb8792bfa..464c2e96927 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -94,4 +94,8 @@ available before `debug' was usable.)" (prin1 (cdr (car (cdr args)))) ; The error data. (debug-early-backtrace))) +(defalias 'debug-early--handler ;Called from C. + #'(lambda (err) + (if backtrace-on-error-noninteractive (debug-early 'error err)))) + ;;; debug-early.el ends here. diff --git a/src/eval.c b/src/eval.c index 595267f7686..7e578a1aa05 100644 --- a/src/eval.c +++ b/src/eval.c @@ -317,6 +317,7 @@ call_debugger (Lisp_Object arg) /* Interrupting redisplay and resuming it later is not safe under all circumstances. So, when the debugger returns, abort the interrupted redisplay by going back to the top-level. */ + /* FIXME: Move this to the redisplay code? */ if (debug_while_redisplaying && !EQ (Vdebugger, Qdebug_early)) Ftop_level (); @@ -1198,7 +1199,7 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) -static void +void pop_handler (void) { handlerlist = handlerlist->next; @@ -1367,6 +1368,16 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +void +push_handler_bind (Lisp_Object conditions, Lisp_Object handler, int skip) +{ + if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = skip; +} + DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, doc: /* Setup error handlers around execution of BODYFUN. BODYFUN be a function and it is called with no arguments. @@ -1392,11 +1403,7 @@ usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) Lisp_Object conditions = args[i], handler = args[i + 1]; if (NILP (conditions)) continue; - else if (!CONSP (conditions)) - conditions = Fcons (conditions, Qnil); - struct handler *c = push_handler (conditions, HANDLER_BIND); - c->val = handler; - c->bytecode_dest = count++; + push_handler_bind (conditions, handler, count++); } Lisp_Object ret = call0 (bodyfun); for (; count > 0; count--) @@ -1885,24 +1892,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) return Qnil; } - /* If we're in batch mode, print a backtrace unconditionally to help - with debugging. Make sure to use `debug-early' unconditionally - to not interfere with ERT or other packages that install custom - debuggers. */ - /* FIXME: This could be turned into a `handler-bind` at toplevel? */ - if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (clause, Qerror)) - && noninteractive && backtrace_on_error_noninteractive - && NILP (Vinhibit_debugger) - && !NILP (Ffboundp (Qdebug_early))) - { - max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); - specpdl_ref count = SPECPDL_INDEX (); - specbind (Qdebugger, Qdebug_early); - call_debugger (list2 (Qerror, Fcons (error_symbol, data))); - unbind_to (count, Qnil); - } - /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ @@ -4392,6 +4381,7 @@ before making `inhibit-quit' nil. */); DEFSYM (QCdocumentation, ":documentation"); DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug_early, "debug-early"); + DEFSYM (Qdebug_early__handler, "debug-early--handler"); DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, doc: /* Non-nil means never enter the debugger. diff --git a/src/keyboard.c b/src/keyboard.c index 4555b71abe7..816147c9130 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1163,7 +1163,17 @@ command_loop_2 (Lisp_Object handlers) static Lisp_Object top_level_2 (void) { - return Feval (Vtop_level, Qnil); + /* If we're in batch mode, print a backtrace unconditionally when + encountering an error, to help with debugging. */ + bool setup_handler = noninteractive; + if (setup_handler) + push_handler_bind (list1 (Qerror), Qdebug_early__handler, 0); + + Lisp_Object res = Feval (Vtop_level, Qnil); + + if (setup_handler) + pop_handler (); + return res; } static Lisp_Object diff --git a/src/lisp.h b/src/lisp.h index 2b30326abfc..0e082d14a40 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4570,6 +4570,8 @@ extern Lisp_Object internal_condition_case_n extern Lisp_Object internal_catch_all (Lisp_Object (*) (void *), void *, Lisp_Object (*) (enum nonlocal_exit, Lisp_Object)); extern struct handler *push_handler (Lisp_Object, enum handlertype) ATTRIBUTE_RETURNS_NONNULL; +extern void pop_handler (void); +extern void push_handler_bind (Lisp_Object, Lisp_Object, int); extern struct handler *push_handler_nosignal (Lisp_Object, enum handlertype); extern void specbind (Lisp_Object, Lisp_Object); extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object); commit 80b081a0ac72a5a9e459af6c96f5b0226a79894f Author: Stefan Monnier Date: Tue Dec 19 19:46:47 2023 -0500 startup.el: Use `handler-bind` to implement `--debug-init` This provides a more reliable fix for bug#65267 since we don't touch `debug-on-error` nor `debug-ignore-errors` any more. * lisp/startup.el (startup--debug): New function. (startup--load-user-init-file): Use it and `handler-bind` instead of let-binding `debug-on-error`. diff --git a/lisp/startup.el b/lisp/startup.el index 1abbb260e30..4040d5d3774 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -393,7 +393,7 @@ If this is nil, Emacs uses `system-name'." "The email address of the current user. This defaults to either: the value of EMAIL environment variable; or user@host, using `user-login-name' and `mail-host-address' (or `system-name')." - :initialize 'custom-initialize-delay + :initialize #'custom-initialize-delay :set-after '(mail-host-address) :type 'string :group 'mail) @@ -492,7 +492,7 @@ DIRS are relative." (setq tail (cdr tail))) ;;Splice the new section in. (when tail - (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))) + (setcdr tail (append (mapcar #'expand-file-name dirs) (cdr tail)))))) ;; The default location for XDG-convention Emacs init files. (defconst startup--xdg-config-default "~/.config/emacs/") @@ -1019,6 +1019,9 @@ If STYLE is nil, display appropriately for the terminal." (when standard-display-table (aset standard-display-table char nil))))))) +(defun startup--debug (err) + (funcall debugger 'error err :backtrace-base #'startup--debug)) + (defun startup--load-user-init-file (filename-function &optional alternate-filename-function load-defaults) "Load a user init-file. @@ -1032,124 +1035,94 @@ is non-nil. This function sets `user-init-file' to the name of the loaded init-file, or to a default value if loading is not possible." - (let ((debug-on-error-from-init-file nil) - (debug-on-error-should-be-set nil) - (debug-on-error-initial - (if (eq init-file-debug t) - 'startup--witness ;Dummy but recognizable non-nil value. - init-file-debug)) - (d-i-e-from-init-file nil) - (d-i-e-initial - ;; Use (startup--witness) instead of nil, so we can detect when the - ;; init files set `debug-ignored-errors' to nil. - (if init-file-debug '(startup--witness) debug-ignored-errors)) - (d-i-e-standard debug-ignored-errors) - ;; The init file might contain byte-code with embedded NULs, - ;; which can cause problems when read back, so disable nul - ;; byte detection. (Bug#52554) - (inhibit-null-byte-detection t)) - (let ((debug-on-error debug-on-error-initial) - ;; If they specified --debug-init, enter the debugger - ;; on any error whatsoever. - (debug-ignored-errors d-i-e-initial)) - (condition-case-unless-debug error - (when init-file-user - (let ((init-file-name (funcall filename-function))) - - ;; If `user-init-file' is t, then `load' will store - ;; the name of the file that it loads into - ;; `user-init-file'. - (setq user-init-file t) - (when init-file-name - (load (if (equal (file-name-extension init-file-name) - "el") - (file-name-sans-extension init-file-name) - init-file-name) - 'noerror 'nomessage)) - - (when (and (eq user-init-file t) alternate-filename-function) - (let ((alt-file (funcall alternate-filename-function))) - (unless init-file-name - (setq init-file-name alt-file)) - (and (equal (file-name-extension alt-file) "el") - (setq alt-file (file-name-sans-extension alt-file))) - (load alt-file 'noerror 'nomessage))) - - ;; If we did not find the user's init file, set - ;; user-init-file conclusively. Don't let it be - ;; set from default.el. - (when (eq user-init-file t) - (setq user-init-file init-file-name))) - - ;; If we loaded a compiled file, set `user-init-file' to - ;; the source version if that exists. - (if (equal (file-name-extension user-init-file) "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source))) - ;; Else, perhaps the user init file was compiled - (when (and (equal (file-name-extension user-init-file) "eln") - ;; The next test is for builds without native - ;; compilation support or builds with unexec. - (boundp 'comp-eln-to-el-h)) - (if-let (source (gethash (file-name-nondirectory user-init-file) - comp-eln-to-el-h)) - ;; source exists or the .eln file would not load - (setq user-init-file source) - (message "Warning: unknown source file for init file %S" - user-init-file) - (sit-for 1)))) - - (when (and load-defaults - (not inhibit-default-init)) - ;; Prevent default.el from changing the value of - ;; `inhibit-startup-screen'. - (let ((inhibit-startup-screen nil)) - (load "default" 'noerror 'nomessage)))) - (error - (display-warning - 'initialization - (format-message "\ + ;; The init file might contain byte-code with embedded NULs, + ;; which can cause problems when read back, so disable nul + ;; byte detection. (Bug#52554) + (let ((inhibit-null-byte-detection t) + (body + (lambda () + (condition-case-unless-debug error + (when init-file-user + (let ((init-file-name (funcall filename-function))) + + ;; If `user-init-file' is t, then `load' will store + ;; the name of the file that it loads into + ;; `user-init-file'. + (setq user-init-file t) + (when init-file-name + (load (if (equal (file-name-extension init-file-name) + "el") + (file-name-sans-extension init-file-name) + init-file-name) + 'noerror 'nomessage)) + + (when (and (eq user-init-file t) alternate-filename-function) + (let ((alt-file (funcall alternate-filename-function))) + (unless init-file-name + (setq init-file-name alt-file)) + (and (equal (file-name-extension alt-file) "el") + (setq alt-file (file-name-sans-extension alt-file))) + (load alt-file 'noerror 'nomessage))) + + ;; If we did not find the user's init file, set + ;; user-init-file conclusively. Don't let it be + ;; set from default.el. + (when (eq user-init-file t) + (setq user-init-file init-file-name))) + + ;; If we loaded a compiled file, set `user-init-file' to + ;; the source version if that exists. + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory + user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) + + (when (and load-defaults + (not inhibit-default-init)) + ;; Prevent default.el from changing the value of + ;; `inhibit-startup-screen'. + (let ((inhibit-startup-screen nil)) + (load "default" 'noerror 'nomessage)))) + (error + (display-warning + 'initialization + (format-message "\ An error occurred while loading `%s':\n\n%s%s%s\n\n\ To ensure normal operation, you should investigate and remove the cause of the error in your initialization file. Start Emacs with the `--debug-init' option to view a complete error backtrace." - user-init-file - (get (car error) 'error-message) - (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) - (cdr error) ", ")) - :warning) - (setq init-file-had-error t))) - - ;; If we can tell that the init file altered debug-on-error, - ;; arrange to preserve the value that it set up. - (unless (eq debug-ignored-errors d-i-e-initial) - (if (memq 'startup--witness debug-ignored-errors) - ;; The init file wants to add errors to the standard - ;; value, so we need to emulate that. - (setq d-i-e-from-init-file - (list (append d-i-e-standard - (remq 'startup--witness - debug-ignored-errors)))) - ;; The init file _replaces_ the standard value. - (setq d-i-e-from-init-file (list debug-ignored-errors)))) - (or (eq debug-on-error debug-on-error-initial) - (setq debug-on-error-should-be-set t - debug-on-error-from-init-file debug-on-error))) - - (when d-i-e-from-init-file - (setq debug-ignored-errors (car d-i-e-from-init-file))) - (when debug-on-error-should-be-set - (setq debug-on-error debug-on-error-from-init-file)))) + user-init-file + (get (car error) 'error-message) + (if (cdr error) ": " "") + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) + :warning) + (setq init-file-had-error t)))))) + (if (eq init-file-debug t) + (handler-bind ((error #'startup--debug)) + (funcall body)) + (funcall body)))) (defvar lisp-directory nil "Directory where Emacs's own *.el and *.elc Lisp files are installed.") @@ -1445,7 +1418,7 @@ please check its value") (error (princ (if (eq (car error) 'error) - (apply 'concat (cdr error)) + (apply #'concat (cdr error)) (if (memq 'file-error (get (car error) 'error-conditions)) (format "%s: %s" (nth 1 error) @@ -1897,10 +1870,10 @@ Each element in the list should be a list of strings or pairs (let ((map (make-sparse-keymap))) (suppress-keymap map) (set-keymap-parent map button-buffer-map) - (define-key map "\C-?" 'scroll-down-command) - (define-key map [?\S-\ ] 'scroll-down-command) - (define-key map " " 'scroll-up-command) - (define-key map "q" 'exit-splash-screen) + (define-key map "\C-?" #'scroll-down-command) + (define-key map [?\S-\ ] #'scroll-down-command) + (define-key map " " #'scroll-up-command) + (define-key map "q" #'exit-splash-screen) map) "Keymap for splash screen buffer.") @@ -2338,7 +2311,7 @@ To quit a partially entered command, type Control-g.\n") ;; If C-h can't be invoked, temporarily disable its ;; binding, so where-is uses alternative bindings. (let ((map (make-sparse-keymap))) - (define-key map [?\C-h] 'undefined) + (define-key map [?\C-h] #'undefined) map)) minor-mode-overriding-map-alist))) @@ -2530,8 +2503,8 @@ A fancy display is used on graphic displays, normal otherwise." (fancy-about-screen) (normal-splash-screen nil))) -(defalias 'about-emacs 'display-about-screen) -(defalias 'display-splash-screen 'display-startup-screen) +(defalias 'about-emacs #'display-about-screen) +(defalias 'display-splash-screen #'display-startup-screen) ;; This avoids byte-compiler warning in the unexec build. (declare-function pdumper-stats "pdumper.c" ()) commit 142c90a6f088a6eea66d6b08d05a5ff70c018aa6 Author: Stefan Monnier Date: Thu Dec 28 00:49:39 2023 -0500 emacs-module-tests.el (mod-test-non-local-exit-signal-test): Repair test That test relied on `debugger` and `debug-on-signal` in a way that doesn't work with the new ERT code. * test/src/emacs-module-tests.el (mod-test-non-local-exit-signal-test): Use `handler-bind` rather than the debugger. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index b82d4a36304..fd0647275a0 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -114,15 +114,14 @@ changes." (ert-deftest mod-test-non-local-exit-signal-test () (should-error (mod-test-signal)) - (let (debugger-args backtrace) + (let (handler-err backtrace) (should-error - (let ((debugger (lambda (&rest args) - (setq debugger-args args - backtrace (with-output-to-string (backtrace))) - (cl-incf num-nonmacro-input-events))) - (debug-on-signal t)) + (handler-bind + ((error (lambda (err) + (setq handler-err err + backtrace (with-output-to-string (backtrace)))))) (mod-test-signal))) - (should (equal debugger-args '(error (error . 56)))) + (should (equal handler-err '(error . 56))) (should (string-match-p (rx bol " mod-test-signal()" eol) backtrace)))) commit fa1063774ce32714365cf122b2a8cca2d23fc6cd Author: Mattias Engdegård Date: Wed Dec 27 11:32:49 2023 +0100 Use handler-bind to repair bytecomp-tests * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--error-frame, bytecomp--byte-op-error-backtrace): Make test pass again and simplify, using handler-bind instead of the previous debugger hack. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 293d3025420..dcb72e4105a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -2087,18 +2087,12 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ (defun bytecomp-tests--error-frame (fun args) "Call FUN with ARGS. Return result or (ERROR . BACKTRACE-FRAME)." - (let* ((debugger - (lambda (&rest args) - ;; Make sure Emacs doesn't think our debugger is buggy. - (cl-incf num-nonmacro-input-events) - (throw 'bytecomp-tests--backtrace - (cons args (cadr (backtrace-get-frames debugger)))))) - (debug-on-error t) - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - (debug-ignored-errors nil)) + (letrec ((handler (lambda (e) + (throw 'bytecomp-tests--backtrace + (cons e (cadr (backtrace-get-frames handler))))))) (catch 'bytecomp-tests--backtrace - (apply fun args)))) + (handler-bind ((error handler)) + (apply fun args))))) (defconst bytecomp-tests--byte-op-error-cases '(((car a) (wrong-type-argument listp a)) @@ -2143,7 +2137,7 @@ EXPECTED-POINT BINDINGS (MODES \\='\\='(ruby-mode js-mode python-mode)) \ `(lambda ,formals (,fun-sym ,@formals))))))) (error-frame (bytecomp-tests--error-frame fun actuals))) (should (consp error-frame)) - (should (equal (car error-frame) (list 'error expected-error))) + (should (equal (car error-frame) expected-error)) (let ((frame (cdr error-frame))) (should (equal (type-of frame) 'backtrace-frame)) (should (equal (cons (backtrace-frame-fun frame) commit 25ea99c211ecf91735b44172da19fc53b304c5f4 Author: Stefan Monnier Date: Thu Dec 28 00:46:36 2023 -0500 Fix ert-tests.el for the new `handler-bind` code Now that `ert.el` uses `handler-bind` instead of `debugger`, some details of the behavior have changed. More specifically, three tests are now broken, but these basically tested the failure of ERT's machinery to record errors when ERT was run within a `condition-case`. AFAICT, these tests do not check for a behavior that we want, so rather than "fix" them, I deleted them (bug#67862). * test/lisp/emacs-lisp/ert-tests.el (ert-test-error-debug) (ert-test-fail-debug-with-condition-case): Delete. (ert-test-should-failure-debugging): Don't use `ert-debug-on-error`. (ert-test-with-demoted-errors): It now passes. Bug#11218 is fixed! diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 768a3a726aa..1aff73d66f6 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -1,6 +1,6 @@ ;;; ert-tests.el --- ERT's self-tests -*- lexical-binding: t -*- -;; Copyright (C) 2007-2008, 2010-2024 Free Software Foundation, Inc. +;; Copyright (C) 2007-2024 Free Software Foundation, Inc. ;; Author: Christian Ohler @@ -93,16 +93,6 @@ failed or if there was a problem." '(ert-test-failed "failure message")) t)))) -(ert-deftest ert-test-fail-debug-with-condition-case () - (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(ert-test-failed "failure message")) t))))) - (ert-deftest ert-test-fail-debug-with-debugger-1 () (let ((test (make-ert-test :body (lambda () (ert-fail "failure message"))))) (let ((debugger (lambda (&rest _args) @@ -146,16 +136,6 @@ failed or if there was a problem." '(error "Error message")) t)))) -(ert-deftest ert-test-error-debug () - (let ((test (make-ert-test :body (lambda () (error "Error message"))))) - (condition-case condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (cl-assert (equal condition '(error "Error message")) t))))) - ;;; Test that `should' works. (ert-deftest ert-test-should () @@ -359,14 +339,10 @@ This macro is used to test if macroexpansion in `should' works." (,(lambda () (let ((_x t)) (should (error "Foo")))) (error "Foo"))) do - (let ((test (make-ert-test :body body))) - (condition-case actual-condition - (progn - (let ((ert-debug-on-error t)) - (ert-run-test test)) - (cl-assert nil)) - ((error) - (should (equal actual-condition expected-condition))))))) + (let* ((test (make-ert-test :body body)) + (result (ert-run-test test))) + (should (ert-test-failed-p result)) + (should (equal (ert-test-failed-condition result) expected-condition))))) (defun ert-test--which-file () "Dummy function to help test `symbol-file' for tests.") @@ -392,9 +368,9 @@ This macro is used to test if macroexpansion in `should' works." (result (ert-run-test test))) (should (ert-test-failed-p result)) (should (memq (backtrace-frame-fun (car (ert-test-failed-backtrace result))) - ;;; This is `ert-fail' on nativecomp and `signal' - ;;; otherwise. It's not clear whether that's a bug - ;;; or not (bug#51308). + ;; This is `ert-fail' on nativecomp and `signal' + ;; otherwise. It's not clear whether that's a bug + ;; or not (bug#51308). '(ert-fail signal))))) (ert-deftest ert-test-messages () @@ -880,7 +856,6 @@ This macro is used to test if macroexpansion in `should' works." (ert-deftest ert-test-with-demoted-errors () "Check that ERT correctly handles `with-demoted-errors'." - :expected-result :failed ;; FIXME! Bug#11218 (should-not (with-demoted-errors "FOO: %S" (error "Foo")))) (ert-deftest ert-test-fail-inside-should () commit fe0f15dbc962b37d98507a494fd7720bad584a7a Author: Stefan Monnier Date: Mon Dec 18 23:57:45 2023 -0500 ert.el: Use `handler-bind` to record backtraces * lisp/emacs-lisp/ert.el (ert--should-signal-hook): Delete function. (ert--expand-should-1): Don't bind `signal-hook-function`. (ert--test-execution-info): Remove `next-debugger` slot. (ert--run-test-debugger): Adjust to new calling convention. Pass the `:backtrace-base` info to the debugger. (ert--run-test-internal): Use `handler-bind` rather than let-binding `debugger` and `debug-on-error`. * lisp/emacs-lisp/ert-x.el (ert-remote-temporary-file-directory): Don't use `defconst` if it's not meant to stay constant (e.g. we let-bind it in tramp-tests.el). diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 05da0f1844e..a6d2fe4a1da 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -543,7 +543,7 @@ The same keyword arguments are supported as in ;; If this defconst is used in a test file, `tramp' shall be loaded ;; prior `ert-x'. There is no default value on w32 systems, which ;; could work out of the box. -(defconst ert-remote-temporary-file-directory +(defvar ert-remote-temporary-file-directory (when (featurep 'tramp) (cond ((getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 353c1bd09d2..8ab57d2b238 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -278,14 +278,6 @@ DATA is displayed to the user and should state the reason for skipping." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) -;; See Bug#24402 for why this exists -(defun ert--should-signal-hook (error-symbol data) - "Stupid hack to stop `condition-case' from catching ert signals. -It should only be stopped when ran from inside `ert--run-test-internal'." - (when (and (not (symbolp debugger)) ; only run on anonymous debugger - (memq error-symbol '(ert-test-failed ert-test-skipped))) - (funcall debugger 'error (cons error-symbol data)))) - (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -324,8 +316,7 @@ It should only be stopped when ran from inside `ert--run-test-internal'." (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err - (let ((signal-hook-function #'ert--should-signal-hook)) - (list ,@arg-forms)) + (list ,@arg-forms) (error (progn (setq ,fn #'signal) (list (car err) (cdr err))))))) @@ -728,78 +719,68 @@ in front of the value of MESSAGE-FORM." ;; value and test execution should be terminated. Should not ;; return. (exit-continuation (cl-assert nil)) - ;; The binding of `debugger' outside of the execution of the test. - next-debugger ;; The binding of `ert-debug-on-error' that is in effect for the ;; execution of the current test. We store it to avoid being ;; affected by any new bindings the test itself may establish. (I ;; don't remember whether this feature is important.) ert-debug-on-error) -(defun ert--run-test-debugger (info args) - "During a test run, `debugger' is bound to a closure that calls this function. +(defun ert--run-test-debugger (info condition debugfun) + "Error handler used during the test run. This function records failures and errors and either terminates the test silently or calls the interactive debugger, as appropriate. -INFO is the ert--test-execution-info corresponding to this test -run. ARGS are the arguments to `debugger'." - (cl-destructuring-bind (first-debugger-arg &rest more-debugger-args) - args - (cl-ecase first-debugger-arg - ((lambda debug t exit nil) - (apply (ert--test-execution-info-next-debugger info) args)) - (error - (let* ((condition (car more-debugger-args)) - (type (cl-case (car condition) - ((quit) 'quit) - ((ert-test-skipped) 'skipped) - (otherwise 'failed))) - ;; We store the backtrace in the result object for - ;; `ert-results-pop-to-backtrace-for-test-at-point'. - ;; This means we have to limit `print-level' and - ;; `print-length' when printing result objects. That - ;; might not be worth while when we can also use - ;; `ert-results-rerun-test-at-point-debugging-errors', - ;; (i.e., when running interactively) but having the - ;; backtrace ready for printing is important for batch - ;; use. - ;; - ;; Grab the frames above the debugger. - (backtrace (cdr (backtrace-get-frames debugger))) - (infos (reverse ert--infos))) - (setf (ert--test-execution-info-result info) - (cl-ecase type - (quit - (make-ert-test-quit :condition condition - :backtrace backtrace - :infos infos)) - (skipped - (make-ert-test-skipped :condition condition - :backtrace backtrace - :infos infos)) - (failed - (make-ert-test-failed :condition condition - :backtrace backtrace - :infos infos)))) - ;; Work around Emacs's heuristic (in eval.c) for detecting - ;; errors in the debugger. - (cl-incf num-nonmacro-input-events) - ;; FIXME: We should probably implement more fine-grained - ;; control a la non-t `debug-on-error' here. - (cond - ((ert--test-execution-info-ert-debug-on-error info) - (apply (ert--test-execution-info-next-debugger info) args)) - (t)) - (funcall (ert--test-execution-info-exit-continuation info))))))) +INFO is the `ert--test-execution-info' corresponding to this test run. +ERR is the error object." + (let* ((type (cl-case (car condition) + ((quit) 'quit) + ((ert-test-skipped) 'skipped) + (otherwise 'failed))) + ;; We store the backtrace in the result object for + ;; `ert-results-pop-to-backtrace-for-test-at-point'. + ;; This means we have to limit `print-level' and + ;; `print-length' when printing result objects. That + ;; might not be worth while when we can also use + ;; `ert-results-rerun-test-at-point-debugging-errors', + ;; (i.e., when running interactively) but having the + ;; backtrace ready for printing is important for batch + ;; use. + ;; + ;; Grab the frames above ourselves. + (backtrace (cdr (backtrace-get-frames debugfun))) + (infos (reverse ert--infos))) + (setf (ert--test-execution-info-result info) + (cl-ecase type + (quit + (make-ert-test-quit :condition condition + :backtrace backtrace + :infos infos)) + (skipped + (make-ert-test-skipped :condition condition + :backtrace backtrace + :infos infos)) + (failed + (make-ert-test-failed :condition condition + :backtrace backtrace + :infos infos)))) + ;; FIXME: We should probably implement more fine-grained + ;; control a la non-t `debug-on-error' here. + (cond + ((ert--test-execution-info-ert-debug-on-error info) + ;; The `debugfun' arg tells `debug' which backtrace frame starts + ;; the "entering the debugger" code so it can hide those frames + ;; from the backtrace. + (funcall debugger 'error condition :backtrace-base debugfun)) + (t)) + (funcall (ert--test-execution-info-exit-continuation info)))) (defun ert--run-test-internal (test-execution-info) "Low-level function to run a test according to TEST-EXECUTION-INFO. This mainly sets up debugger-related bindings." - (setf (ert--test-execution-info-next-debugger test-execution-info) debugger - (ert--test-execution-info-ert-debug-on-error test-execution-info) + (setf (ert--test-execution-info-ert-debug-on-error test-execution-info) ert-debug-on-error) (catch 'ert--pass ;; For now, each test gets its own temp buffer and its own @@ -807,26 +788,14 @@ This mainly sets up debugger-related bindings." ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion - ;; FIXME: Use `signal-hook-function' instead of `debugger' to - ;; handle ert errors. Once that's done, remove - ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for - ;; details. - (let ((lexical-binding t) - (debugger (lambda (&rest args) - (ert--run-test-debugger test-execution-info - args))) - (debug-on-error t) - ;; Don't infloop if the error being called is erroring - ;; out, and we have `debug-on-error' bound to nil inside - ;; the test. - (backtrace-on-error-noninteractive nil) - (debug-on-quit t) - ;; FIXME: Do we need to store the old binding of this - ;; and consider it in `ert--run-test-debugger'? - (debug-ignored-errors nil) + (let ((lexical-binding t) ;;FIXME: Why? (ert--infos '())) - (funcall (ert-test-body (ert--test-execution-info-test - test-execution-info)))))) + (letrec ((debugfun (lambda (err) + (ert--run-test-debugger test-execution-info + err debugfun)))) + (handler-bind (((error quit) debugfun)) + (funcall (ert-test-body (ert--test-execution-info-test + test-execution-info)))))))) (ert-pass)) (setf (ert--test-execution-info-result test-execution-info) (make-ert-test-passed)) commit 7959a63ce258c90eb3c7947ab3318c5531eb37d9 Author: Stefan Monnier Date: Mon Dec 18 23:47:56 2023 -0500 (eval-expression): Fix bug#67196 * lisp/simple.el (eval-expression--debug): New function. (eval-expression): Use it together with `handler-bind` instead of let-binding `debug-on-error`. diff --git a/lisp/simple.el b/lisp/simple.el index 4f6d2ee12c3..692c0dacefc 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2087,6 +2087,9 @@ of the prefix argument for `eval-expression' and ((= num -1) most-positive-fixnum) (t eval-expression-print-maximum-character))))) +(defun eval-expression--debug (err) + (funcall debugger 'error err :backtrace-base #'eval-expression--debug)) + ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-buffer. (defun eval-expression (exp &optional insert-value no-truncate char-print-limit) @@ -2120,23 +2123,17 @@ this command arranges for all errors to enter the debugger." (cons (read--expression "Eval: ") (eval-expression-get-print-arguments current-prefix-arg))) - (let (result) + (let* (result + (runfun + (lambda () + (setq result + (values--store-value + (eval (let ((lexical-binding t)) (macroexpand-all exp)) + t)))))) (if (null eval-expression-debug-on-error) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (let ((old-value (make-symbol "t")) new-value) - ;; Bind debug-on-error to something unique so that we can - ;; detect when evalled code changes it. - (let ((debug-on-error old-value)) - (setq result - (values--store-value - (eval (let ((lexical-binding t)) (macroexpand-all exp)) t))) - (setq new-value debug-on-error)) - ;; If evalled code has changed the value of debug-on-error, - ;; propagate that change to the global binding. - (unless (eq old-value new-value) - (setq debug-on-error new-value)))) + (funcall runfun) + (handler-bind ((error #'eval-expression--debug)) + (funcall runfun))) (let ((print-length (unless no-truncate eval-expression-print-length)) (print-level (unless no-truncate eval-expression-print-level)) commit 5ba75e183c60aff50949587c21066e876dabfbda Author: Stefan Monnier Date: Mon Dec 25 22:32:17 2023 -0500 New special form `handler-bind` AFAIK, this provides the same semantics as Common Lisp's `handler-bind`, modulo the differences about how error objects and conditions are represented. * lisp/subr.el (handler-bind): New macro. * src/eval.c (pop_handler): New function. (Fhandler_Bind_1): New function. (signal_or_quit): Handle new handlertypes `HANDLER` and `SKIP_CONDITIONS`. (find_handler_clause): Simplify. (syms_of_eval): Defsubr `Fhandler_bind_1`. * doc/lispref/control.texi (Handling Errors): Add `handler-bind`. * test/src/eval-tests.el (eval-tests--handler-bind): New test. * lisp/emacs-lisp/lisp-mode.el (lisp-font-lock-keywords): Move 'handler-bind' from CL-only to generic Lisp. (handler-bind): Remove indentation setting, it now lives in the macro definition. diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi index acf9be5c3ff..6cc25dcdaee 100644 --- a/doc/lispref/control.texi +++ b/doc/lispref/control.texi @@ -2293,6 +2293,44 @@ should be robust if one does occur. Note that this macro uses @code{condition-case-unless-debug} rather than @code{condition-case}. @end defmac +Occasionally, we want to catch some errors and record some information +about the conditions in which they occurred, such as the full +backtrace, or the current buffer. This kinds of information is sadly +not available in the handlers of a @code{condition-case} because the +stack is unwound before running that handler, so the handler is run in +the dynamic context of the @code{condition-case} rather than that of +the place where the error was signaled. For those circumstances, you +can use the following form: + +@defmac handler-bind handlers body@dots{} +This special form runs @var{body} and if it executes without error, +the value it returns becomes the value of the @code{handler-bind} +form. In this case, the @code{handler-bind} has no effect. + +@var{handlers} should be a list of elements of the form +@code{(@var{conditions} @var{handler})} where @var{conditions} is an +error condition name to be handled, or a list of condition names, and +@var{handler} should be a form whose evaluation should return a function. + +Before running @var{body}, @code{handler-bind} evaluates all the +@var{handler} forms and installs those handlers to be active during +the evaluation of @var{body}. These handlers are searched together +with those installed by @code{condition-case}. When the innermost +matching handler is one installed by @code{handler-bind}, the +@var{handler} function is called with a single argument holding the +error description. + +@var{handler} is called in the dynamic context where the error +happened, without first unwinding the stack, meaning that all the +dynamic bindings are still in effect, except that all the error +handlers between the code that signaled the error and the +@code{handler-bind} are temporarily suspended. Like any normal +function, @var{handler} can exit non-locally, typically via +@code{throw}, or it can return normally. If @var{handler} returns +normally, it means the handler @emph{declined} to handle the error and +the search for an error handler is continued where it left off. +@end defmac + @node Error Symbols @subsubsection Error Symbols and Condition Names @cindex error symbol diff --git a/etc/NEWS b/etc/NEWS index 6239af3e138..db3b838c380 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,13 @@ This is like 'require', but it checks whether the argument 'feature' is already loaded, in which case it either signals an error or forcibly reloads the file that defines the feature. ++++ +** New special form 'handler-bind'. +Provides a functionality similar to `condition-case` except it runs the +handler code without unwinding the stack, such that we can record the +backtrace and other dynamic state at the point of the error. +See the Info node "(elisp) Handling Errors". + +++ ** New 'pop-up-frames' action alist entry for 'display-buffer'. This has the same effect as the variable of the same name and takes diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1bb9c2fdc2e..ca207ff548d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -343,7 +343,7 @@ This will generate compile-time constants from BINDINGS." (lisp-vdefs '("defvar")) (lisp-kw '("cond" "if" "while" "let" "let*" "progn" "prog1" "prog2" "lambda" "unwind-protect" "condition-case" - "when" "unless" "with-output-to-string" + "when" "unless" "with-output-to-string" "handler-bind" "ignore-errors" "dotimes" "dolist" "declare")) (lisp-errs '("warn" "error" "signal")) ;; Elisp constructs. Now they are update dynamically @@ -376,7 +376,7 @@ This will generate compile-time constants from BINDINGS." (cl-kw '("block" "break" "case" "ccase" "compiler-let" "ctypecase" "declaim" "destructuring-bind" "do" "do*" "ecase" "etypecase" "eval-when" "flet" "flet*" - "go" "handler-case" "handler-bind" "in-package" ;; "inline" + "go" "handler-case" "in-package" ;; "inline" "labels" "letf" "locally" "loop" "macrolet" "multiple-value-bind" "multiple-value-prog1" "proclaim" "prog" "prog*" "progv" @@ -1346,7 +1346,6 @@ Lisp function does not specify a special indentation." (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'handler-case 'lisp-indent-function 1) ;CL -(put 'handler-bind 'lisp-indent-function 1) ;CL (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) (put 'closure 'lisp-indent-function 2) diff --git a/lisp/subr.el b/lisp/subr.el index d2b8ea17f74..0519e56e057 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7497,6 +7497,28 @@ predicate conditions in CONDITION." (push buf bufs))) bufs)) +(defmacro handler-bind (handlers &rest body) + "Setup error HANDLERS around execution of BODY. +HANDLERS is a list of (CONDITIONS HANDLER) where +CONDITIONS should be a list of condition names (symbols) or +a single condition name, and HANDLER is a form whose evaluation +returns a function. +When an error is signaled during execution of BODY, if that +error matches CONDITIONS, then the associated HANDLER +function is called with the error object as argument. +HANDLERs can either transfer the control via a non-local exit, +or return normally. If a handler returns normally, the search for an +error handler continues from where it left off." + ;; FIXME: Completion support as in `condition-case'? + (declare (indent 1) (debug ((&rest (sexp form)) body))) + (let ((args '())) + (dolist (cond+handler handlers) + (let ((handler (car (cdr cond+handler))) + (conds (car cond+handler))) + (push `',(ensure-list conds) args) + (push handler args))) + `(handler-bind-1 (lambda () ,@body) ,@(nreverse args)))) + (defmacro with-memoization (place &rest code) "Return the value of CODE and stash it in PLACE. If PLACE's value is non-nil, then don't bother evaluating CODE diff --git a/src/eval.c b/src/eval.c index 7f67b5a9db8..595267f7686 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1198,6 +1198,12 @@ usage: (catch TAG BODY...) */) #define clobbered_eassert(E) verify (sizeof (E) != 0) +static void +pop_handler (void) +{ + handlerlist = handlerlist->next; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1361,6 +1367,43 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0, + doc: /* Setup error handlers around execution of BODYFUN. +BODYFUN be a function and it is called with no arguments. +CONDITIONS should be a list of condition names (symbols). +When an error is signaled during executon of BODYFUN, if that +error matches one of CONDITIONS, then the associated HANDLER is +called with the error as argument. +HANDLER should either transfer the control via a non-local exit, +or return normally. +If it returns normally, the search for an error handler continues +from where it left off. + +usage: (handler-bind BODYFUN [CONDITIONS HANDLER]...) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + eassert (nargs >= 1); + Lisp_Object bodyfun = args[0]; + int count = 0; + if (nargs % 2 == 0) + error ("Trailing CONDITIONS withount HANDLER in `handler-bind`"); + for (ptrdiff_t i = nargs - 2; i > 0; i -= 2) + { + Lisp_Object conditions = args[i], handler = args[i + 1]; + if (NILP (conditions)) + continue; + else if (!CONSP (conditions)) + conditions = Fcons (conditions, Qnil); + struct handler *c = push_handler (conditions, HANDLER_BIND); + c->val = handler; + c->bytecode_dest = count++; + } + Lisp_Object ret = call0 (bodyfun); + for (; count > 0; count--) + pop_handler (); + return ret; +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1737,6 +1780,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) = (NILP (error_symbol) ? Fcar (data) : error_symbol); Lisp_Object clause = Qnil; struct handler *h; + int skip; if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1759,6 +1803,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* Edebug takes care of restoring these variables when it exits. */ max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 20); + /* FIXME: 'handler-bind' makes `signal-hook-function' obsolete? */ call2 (Vsignal_hook_function, error_symbol, data); } @@ -1778,16 +1823,42 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Vsignaling_function = backtrace_function (pdl); } - for (h = handlerlist; h; h = h->next) + for (skip = 0, h = handlerlist; h; skip++, h = h->next) { - if (h->type == CATCHER_ALL) + switch (h->type) { + case CATCHER_ALL: clause = Qt; break; - } - if (h->type != CONDITION_CASE) - continue; - clause = find_handler_clause (h->tag_or_ch, conditions); + case CATCHER: + continue; + case CONDITION_CASE: + clause = find_handler_clause (h->tag_or_ch, conditions); + break; + case HANDLER_BIND: + { + if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) + { + Lisp_Object error_data + = (NILP (error_symbol) + ? data : Fcons (error_symbol, data)); + push_handler (make_fixnum (skip + h->bytecode_dest), + SKIP_CONDITIONS); + call1 (h->val, error_data); + pop_handler (); + } + continue; + } + case SKIP_CONDITIONS: + { + int toskip = XFIXNUM (h->tag_or_ch); + while (toskip-- >= 0) + h = h->next; + continue; + } + default: + abort (); + } if (!NILP (clause)) break; } @@ -1804,7 +1875,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) || (CONSP (clause) && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->tag_or_ch, Qerror))) + || EQ (clause, Qerror))) { debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1818,8 +1889,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) with debugging. Make sure to use `debug-early' unconditionally to not interfere with ERT or other packages that install custom debuggers. */ + /* FIXME: This could be turned into a `handler-bind` at toplevel? */ if (!debugger_called && !NILP (error_symbol) - && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) + && (NILP (clause) || EQ (clause, Qerror)) && noninteractive && backtrace_on_error_noninteractive && NILP (Vinhibit_debugger) && !NILP (Ffboundp (Qdebug_early))) @@ -1833,6 +1905,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ + /* FIXME: Turn this into a `handler-bind` installed during redisplay? */ if (!debugger_called && !NILP (error_symbol) && backtrace_on_redisplay_error && (NILP (clause) || h == redisplay_deep_handler) @@ -2058,13 +2131,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) register Lisp_Object h; /* t is used by handlers for all conditions, set up by C code. */ - if (EQ (handlers, Qt)) - return Qt; - /* error is used similarly, but means print an error message and run the debugger if that is enabled. */ - if (EQ (handlers, Qerror)) - return Qt; + if (!CONSP (handlers)) + return handlers; for (h = handlers; CONSP (h); h = XCDR (h)) { @@ -4494,6 +4564,7 @@ alist of active lexical bindings. */); defsubr (&Sthrow); defsubr (&Sunwind_protect); defsubr (&Scondition_case); + defsubr (&Shandler_bind_1); DEFSYM (QCsuccess, ":success"); defsubr (&Ssignal); defsubr (&Scommandp); diff --git a/src/lisp.h b/src/lisp.h index 10018e4dde7..2b30326abfc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3543,7 +3543,8 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) } /* This structure helps implement the `catch/throw' and `condition-case/signal' - control structures. A struct handler contains all the information needed to + control structures as well as 'handler-bind'. + A struct handler contains all the information needed to restore the state of the interpreter after a non-local jump. Handler structures are chained together in a doubly linked list; the `next' @@ -3564,9 +3565,41 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) state. Members are volatile if their values need to survive _longjmp when - a 'struct handler' is a local variable. */ - -enum handlertype { CATCHER, CONDITION_CASE, CATCHER_ALL }; + a 'struct handler' is a local variable. + + When running the HANDLER of a 'handler-bind', we need to + temporarily "mute" the CONDITION_CASEs and HANDLERs that are "below" + the current handler, but without hiding any CATCHERs. We do that by + installing a SKIP_CONDITIONS which tells the search to skip the + N next conditions. */ + +enum handlertype { + CATCHER, /* Entry for 'catch'. + 'tag_or_ch' holds the catch's tag. + 'val' holds the retval during longjmp. */ + CONDITION_CASE, /* Entry for 'condition-case'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the retval during longjmp. */ + CATCHER_ALL, /* Wildcard which catches all 'throw's. + 'tag_or_ch' is unused. + 'val' holds the retval during longjmp. */ + HANDLER_BIND, /* Entry for 'handler-bind'. + 'tag_or_ch' holds the list of conditions. + 'val' holds the handler function. + The rest of the handler is unused, + except for 'bytecode_dest' that holds + the number of preceding HANDLER_BIND + entries which belong to the same + 'handler-bind' (and hence need to + be muted together). */ + SKIP_CONDITIONS /* Mask out the N preceding entries. + Used while running the handler of + a HANDLER_BIND to hides the condition + handlers underneath (and including) + the 'handler-bind'. + 'tag_or_ch' holds that number, the rest + is unused. */ +}; enum nonlocal_exit { diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index e4b18ec7849..9ac117859dd 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -303,4 +303,41 @@ expressions works for identifiers starting with period." (should (eq 'bar (default-value 'eval-tests/buffer-local-var))) (should (eq 'bar eval-tests/buffer-local-var))))) +(ert-deftest eval-tests--handler-bind () + ;; A `handler-bind' has no effect if no error is signaled. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'wow)))) + 'noerror)) + 'noerror)) + ;; The handler is called from within the dynamic extent where the + ;; error is signaled, unlike `condition-case'. + (should (equal (catch 'tag + (handler-bind ((error (lambda (_err) (throw 'tag 'err)))) + (list 'inner-catch + (catch 'tag + (user-error "hello"))))) + '(inner-catch err))) + ;; But inner condition handlers are temporarily muted. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil)))) + (list 'result + (condition-case nil + (user-error "hello") + (wrong-type-argument 'inner-handler)))) + (wrong-type-argument 'wrong-type-argument)) + 'wrong-type-argument)) + ;; Handlers do not apply to the code run within the handlers. + (should (equal (condition-case nil + (handler-bind + ((error (lambda (_err) + (signal 'wrong-type-argument nil))) + (wrong-type-argument + (lambda (_err) (user-error "wrong-type-argument")))) + (user-error "hello")) + (wrong-type-argument 'wrong-type-argument) + (error 'plain-error)) + 'wrong-type-argument))) + ;;; eval-tests.el ends here commit 225710ba79c10b53b6ba320327ca31192ca72387 Author: Antero Mejr Date: Thu Jan 4 19:49:23 2024 +0000 Add file completion for "git blame" to pcomplete * lisp/pcmpl-git.el (pcomplete/git): Add "blame" to the tracked files clause. (Bug#68245) diff --git a/lisp/pcmpl-git.el b/lisp/pcmpl-git.el index facca4107a1..95b6859dd23 100644 --- a/lisp/pcmpl-git.el +++ b/lisp/pcmpl-git.el @@ -88,7 +88,7 @@ Files listed by `git ls-files ARGS' satisfy the predicate." (pcomplete-entries nil (pcmpl-git--tracked-file-predicate "-m")))) ;; Complete all tracked files - ((or "mv" "rm" "grep" "status") + ((or "mv" "rm" "grep" "status" "blame") (pcomplete-here (pcomplete-entries nil (pcmpl-git--tracked-file-predicate)))) ;; Complete revisions commit df505804ab6e7dc869cfc9db6308a8c568eddd6a Author: Eli Zaretskii Date: Thu Jan 4 20:47:06 2024 +0200 ; Fix documentation of last change * lisp/minibuffer.el (completion-category-overrides): Doc fix. * doc/emacs/mini.texi (Completion Options): Update documentation of 'completions-sort'. * doc/lispref/minibuf.texi (Completion Variables): Fox wording. Add a cross-reference to where 'completions-sort' is documented. diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index 30a61a02f06..aa7144610a6 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -709,7 +709,9 @@ will use just one column. The @code{completions-sort} user option controls the order in which the completions are sorted in the @samp{*Completions*} buffer. The default is @code{alphabetical}, which sorts in alphabetical order. -The value @code{nil} disables sorting. The value can also be a +The value @code{nil} disables sorting; the value @code{historical} +sorts alphabetically first, and then rearranges according to the order +of the candidates in the minibuffer history. The value can also be a function, which will be called with the list of completions, and should return the list in the desired order. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 65272627660..8aed1515764 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1880,10 +1880,12 @@ The value should be a value for @code{completion-cycle-threshold} category. @item display-sort-function -The possible values are: @code{nil} that means to use either the sorting -function from metadata or if it's nil then fall back to @code{completions-sort}; -@code{identity} that means to not use any sorting to keep the original order; -and other values are the same as in @code{completions-sort}. +The possible values are: @code{nil}, which means to use either the +sorting function from metadata or if that is @code{nil}, fall back to +@code{completions-sort}; @code{identity}, which means not to sort at +all, leaving the original order; or any other value out of those used +in @code{completions-sort} (@pxref{Completion Options,,, emacs, The +GNU Emacs Manual}). @end table @noindent diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 6ead11d81c8..b7aebae63a8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1155,10 +1155,10 @@ Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. -- `display-sort-function': where `nil' means to use either the sorting -function from metadata or if it's nil then fall back to `completions-sort'; -`identity' means to not use any sorting to keep the original order; -and other values are the same as in `completions-sort'. +- `display-sort-function': nil means to use either the sorting +function from metadata, or if that is nil, fall back to `completions-sort'; +`identity' disables sorting and keeps the original order; and other +possible values are the same as in `completions-sort'. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. commit dc99be8e633fa0d8594b72f41584a53590939fde Author: Juri Linkov Date: Thu Jan 4 19:20:30 2024 +0200 Support display-sort-function in completion-category-overrides (bug#68214) * doc/lispref/minibuf.texi (Completion Variables): Add 'display-sort-function' to the table of 'completion-category-overrides'. * lisp/calendar/calendar.el (calendar-read-date): Add metadata category 'calendar-month' for completing-read reading a month name. * lisp/minibuffer.el (completion-category-defaults): Add 'display-sort-function' with identity for the category 'calendar-month'. (completion-category-overrides): Add customization for completion sorting with 'display-sort-function' and a choice like in 'completions-sort'. (completion-metadata-override-get): New function. (minibuffer-completion-help): Use 'completion-metadata-override-get' instead of 'completion-metadata-get' to get sort-fun from 'display-sort-function'. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 5c5edf62a8d..65272627660 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1878,6 +1878,12 @@ The value should be a list of completion styles (symbols). The value should be a value for @code{completion-cycle-threshold} (@pxref{Completion Options,,, emacs, The GNU Emacs Manual}) for this category. + +@item display-sort-function +The possible values are: @code{nil} that means to use either the sorting +function from metadata or if it's nil then fall back to @code{completions-sort}; +@code{identity} that means to not use any sorting to keep the original order; +and other values are the same as in @code{completions-sort}. @end table @noindent diff --git a/etc/NEWS b/etc/NEWS index 713581cdcf4..6239af3e138 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -740,6 +740,12 @@ When 'completions-sort' is set to 'historical', completion candidates will be first sorted alphabetically, and then re-sorted by their order in the minibuffer history, with more recent candidates appearing first. ++++ +*** 'completion-category-overrides' supports 'display-sort-function'. +You can now customize the sorting order for any category in +'completion-category-overrides' that will override the sorting order +defined in the metadata or in 'completions-sort'. + ** Pcomplete --- diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index a25684f7b5d..e01d5d792a6 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -2339,7 +2339,11 @@ returned is (month year)." (month (cdr (assoc-string (completing-read (format-prompt "Month name" defmon) - (append month-array nil) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (category . calendar-month)) + (complete-with-action + action (append month-array nil) string pred))) nil t nil nil defmon) (calendar-make-alist month-array 1) t))) (defday (calendar-extract-day default-date)) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index fa2dcb4f698..6ead11d81c8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1135,12 +1135,14 @@ styles for specific categories, such as files, buffers, etc." (project-file (styles . (substring))) (xref-location (styles . (substring))) (info-menu (styles . (basic substring))) - (symbol-help (styles . (basic shorthand substring)))) + (symbol-help (styles . (basic shorthand substring))) + (calendar-month (display-sort-function . identity))) "Default settings for specific completion categories. Each entry has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': the sorting function. Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1148,10 +1150,16 @@ Also see `completion-category-overrides'.") (defcustom completion-category-overrides nil "List of category-specific user overrides for completion styles. + Each override has the shape (CATEGORY . ALIST) where ALIST is an association list that can specify properties such as: - `styles': the list of `completion-styles' to use for that category. - `cycle': the `completion-cycle-threshold' to use for that category. +- `display-sort-function': where `nil' means to use either the sorting +function from metadata or if it's nil then fall back to `completions-sort'; +`identity' means to not use any sorting to keep the original order; +and other values are the same as in `completions-sort'. + Categories are symbols such as `buffer' and `file', used when completing buffer and file names, respectively. @@ -1171,12 +1179,28 @@ overrides the default specified in `completion-category-defaults'." ,completion--styles-type) (cons :tag "Completion Cycling" (const :tag "Select one value from the menu." cycle) - ,completion--cycling-threshold-type)))) + ,completion--cycling-threshold-type) + (cons :tag "Completion Sorting" + (const :tag "Select one value from the menu." + display-sort-function) + (choice (const :tag "Use default" nil) + (const :tag "No sorting" identity) + (const :tag "Alphabetical sorting" + minibuffer-sort-alphabetically) + (const :tag "Historical sorting" + minibuffer-sort-by-history) + (function :tag "Custom function")))))) (defun completion--category-override (category tag) (or (assq tag (cdr (assq category completion-category-overrides))) (assq tag (cdr (assq category completion-category-defaults))))) +(defun completion-metadata-override-get (metadata prop) + (if-let ((cat (completion-metadata-get metadata 'category)) + (over (completion--category-override cat prop))) + (cdr over) + (completion-metadata-get metadata prop))) + (defun completion--styles (metadata) (let* ((cat (completion-metadata-get metadata 'category)) (over (completion--category-override cat 'styles))) @@ -2522,7 +2546,7 @@ The candidate will still be chosen by `choose-completion' unless (aff-fun (or (completion-metadata-get all-md 'affixation-function) (plist-get completion-extra-properties :affixation-function))) - (sort-fun (completion-metadata-get all-md 'display-sort-function)) + (sort-fun (completion-metadata-override-get all-md 'display-sort-function)) (group-fun (completion-metadata-get all-md 'group-function)) (mainbuf (current-buffer)) ;; If the *Completions* buffer is shown in a new commit d69fb6dab28e55447516341cf28f1b6d06937ad6 Author: Morgan Willcock Date: Sun Dec 31 20:47:17 2023 +0000 Fix last change in tempo.el * lisp/tempo.el: Set marker type for tempo-region-start to move when text is inserted at its position. This prevents the template from inserting text into the region. (Bug#68185) diff --git a/lisp/tempo.el b/lisp/tempo.el index f32313d80d0..513e778e4ef 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -198,6 +198,10 @@ This is an abnormal hook where the functions are called with one argument (defvar-local tempo-region-start (make-marker) "Region start when inserting around the region.") +;; Insertion by the template at the region start position should move +;; the marker to preserve the original region contents. +(set-marker-insertion-type tempo-region-start t) + (defvar-local tempo-region-stop (make-marker) "Region stop when inserting around the region.") commit 5765cc3a5a32bdecfb6b28180afda97d4b74ee6a Author: Morgan Willcock Date: Sun Dec 31 20:47:17 2023 +0000 Ensure indent-region argument order in tempo.el is correct * lisp/tempo.el (tempo-insert): Call 'indent-region' with the stored region markers to ensure that the start and end arguments are used in the correct order. (Bug#68185) diff --git a/lisp/tempo.el b/lisp/tempo.el index df78690bd31..f32313d80d0 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -333,7 +333,8 @@ possible." (`(r> . ,rest) (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start + tempo-region-stop)) (tempo-insert-prompt-compat rest))) (`(s ,name) (tempo-insert-named name)) (`(l . ,rest) (dolist (elt rest) (tempo-insert elt on-region))) @@ -344,7 +345,7 @@ possible." ('r> (if on-region (progn (goto-char tempo-region-stop) - (indent-region (mark) (point) nil)) + (indent-region tempo-region-start tempo-region-stop)) (tempo-insert-mark (point-marker)))) ('> (indent-according-to-mode)) ('& (if (not (or (= (current-column) 0) commit ff00b85acf8371a358a055ef3e7325220bb6e362 Author: Eli Zaretskii Date: Thu Jan 4 11:34:21 2024 +0200 Document 'etags-regen-mode' in the Emacs user manual * doc/emacs/maintaining.texi (Create Tags Table): Document 'etags-regen-mode'. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8de9cf2c2f3..d3e06fa697b 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2683,7 +2683,7 @@ use tags, separate from the @command{etags} facility. @menu * Tag Syntax:: Tag syntax for various types of code and text files. -* Create Tags Table:: Creating a tags table with @command{etags}. +* Create Tags Table:: Creating and updating tags tables with @command{etags}. * Etags Regexps:: Create arbitrary tags using regular expressions. @end menu @@ -2999,6 +2999,38 @@ explanation. If followed by one or more @samp{--language=@var{lang}} options, it outputs detailed information about how tags are generated for @var{lang}. +@findex etags-regen-mode + Instead of creating and updating the tags table by manually invoking +@command{etags}, you can ask Emacs to do it for you automatically. +The global minor mode @code{etags-regen-mode}, if enabled, generates +tags tables automatically as needed, and takes care of updating them +when you edit any of the source files that contribute tags. This mode +uses the current project configuration (@pxref{Projects}) to determine +which files to submit to @command{etags} for regenerating the tags +table for the project. You can customize how this minor mode works +using the following user options: + +@vtable @code +@item etags-regen-program +The program to regenerate tags table; defaults to @command{etags}. + +@item etags-regen-program-options +Command-line options to pass to the program which regenerates tags +tables. + +@item etags-regen-ignores +List of glob patterns which specify files to ignore when regenerating +tags tables. +@end vtable + +@cindex tags-reset-tags-tables + If you select a tags table manually, with @kbd{M-x visit-tags-table} +(@pxref{Select Tags Table}), @code{etags-regen-mode} effectively +disables itself: it will no longer automatically create and update +tags tables, assuming that you prefer managing your tags tables +manually. You can cancel this effect of using @code{visit-tags-table} +by invoking the command @code{tags-reset-tags-tables}. + @node Etags Regexps @subsubsection Etags Regexps diff --git a/etc/NEWS b/etc/NEWS index 1cdb12c3958..713581cdcf4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1265,6 +1265,7 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their customization options. ++++ ** New global minor mode 'etags-regen-mode'. This minor mode generates the tags table automatically based on the current project configuration, and later updates it as you edit the commit 310ed338c195c755b11e0c62bde9629797b644c8 Author: Stefan Kangas Date: Thu Jan 4 02:41:22 2024 +0100 Remove semantic patch for adjusting `XSAVE_*` * admin/coccinelle/xsave.cocci: Delete file. The corresponding macros were removed in 4139c98eb5f 2018-06-14 "Remove Lisp_Misc_Save_Value". diff --git a/admin/coccinelle/xsave.cocci b/admin/coccinelle/xsave.cocci deleted file mode 100644 index 5172bb55b33..00000000000 --- a/admin/coccinelle/xsave.cocci +++ /dev/null @@ -1,11 +0,0 @@ -// Adjust users of XSAVE_POINTER and XSAVE_INTEGER. -@@ -expression E; -@@ -( -- XSAVE_POINTER (E) -+ XSAVE_POINTER (E, 0) -| -- XSAVE_INTEGER (E) -+ XSAVE_INTEGER (E, 1) -) commit d91a4133b0ad6bb5f53fdbd9ae0e4410c1422a64 Author: Stefan Kangas Date: Thu Jan 4 02:24:13 2024 +0100 Prefer build_unibyte_string where applicable * src/fns.c (syms_of_fns): * src/image.c (slurp_image): Prefer build_unibyte_string (str) to make_unibyte_string (str, strlen (str)). * admin/coccinelle/unibyte_string.cocci: Support string literals. diff --git a/admin/coccinelle/unibyte_string.cocci b/admin/coccinelle/unibyte_string.cocci index 0ff8cafa15d..97f87e5a4ca 100644 --- a/admin/coccinelle/unibyte_string.cocci +++ b/admin/coccinelle/unibyte_string.cocci @@ -4,3 +4,9 @@ identifier I; @@ - make_unibyte_string (I, strlen (I)) + build_unibyte_string (I) + +@@ +constant C; +@@ +- make_unibyte_string (C, strlen (C)) ++ build_unibyte_string (C) diff --git a/src/fns.c b/src/fns.c index 05b7fe85601..c03aea02397 100644 --- a/src/fns.c +++ b/src/fns.c @@ -6337,7 +6337,7 @@ The same variable also affects the function `read-answer'. See also DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt, doc: /* String to append when `yes-or-no-p' asks a question. For best results this should end in a space. */); - Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or no) ")); + Vyes_or_no_prompt = build_unibyte_string ("(yes or no) "); defsubr (&Sidentity); defsubr (&Srandom); diff --git a/src/image.c b/src/image.c index dea2730832b..252b83da992 100644 --- a/src/image.c +++ b/src/image.c @@ -4373,7 +4373,7 @@ slurp_image (Lisp_Object filename, ptrdiff_t *size, const char *image_type) char *result = slurp_file (fd, size); if (result == NULL) image_error ("Error loading %s image `%s'", - make_unibyte_string (image_type, strlen (image_type)), + build_unibyte_string (image_type), file); return result; } commit 88ed501abe9666fced46703613c000c26e450ad8 Author: Stefan Kangas Date: Thu Jan 4 01:49:34 2024 +0100 Prefer NILP (x) to EQ (x, Qnil) * src/image.c (anim_prune_animation_cache): Prefer NILP (x) to EQ (x, Qnil). * admin/coccinelle/nilp.cocci: Semantic patch for above change. diff --git a/admin/coccinelle/nilp.cocci b/admin/coccinelle/nilp.cocci new file mode 100644 index 00000000000..ccebbbe1c80 --- /dev/null +++ b/admin/coccinelle/nilp.cocci @@ -0,0 +1,6 @@ +// Prefer NILP (x) to EQ (x, Qnil) +@@ +expression X; +@@ +- EQ (X, Qnil) ++ NILP (X) diff --git a/src/image.c b/src/image.c index f09552c4017..dea2730832b 100644 --- a/src/image.c +++ b/src/image.c @@ -3561,7 +3561,7 @@ anim_prune_animation_cache (Lisp_Object clear) { struct anim_cache *cache = *pcache; if (EQ (clear, Qt) - || (EQ (clear, Qnil) && timespec_cmp (old, cache->update_time) > 0) + || (NILP (clear) && timespec_cmp (old, cache->update_time) > 0) || EQ (clear, cache->spec)) { if (cache->handle) commit bdfa49502a84f46999c4f207249562f33a119d36 Author: Dmitry Gutov Date: Thu Jan 4 03:44:23 2024 +0200 New feature: etags-regen-mode * lisp/progmodes/etags-regen.el: New file (bug#67687). * etc/NEWS: Mention the addition. * .dir-locals.el: Add this project's settings for etags-regen-regexp-alist and etags-regen-ignores. diff --git a/.dir-locals.el b/.dir-locals.el index e087aa89cd1..ce7febca851 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,6 +8,12 @@ (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") (diff-add-log-use-relative-names . t) + (etags-regen-regexp-alist + . + ((("c" "objc") . + ("/[ \t]*DEFVAR_[A-Z_ \t(]+\"\\([^\"]+\\)\"/\\1/" + "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) + (etags-regen-ignores . ("test/manual/etags/")) (vc-prepare-patches-separately . nil))) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" diff --git a/etc/NEWS b/etc/NEWS index a6b0beb6ee5..1cdb12c3958 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1265,6 +1265,11 @@ the needs of users with red-green or blue-yellow color deficiency. The Info manual "(modus-themes) Top" describes the details and showcases all their customization options. +** New global minor mode 'etags-regen-mode'. +This minor mode generates the tags table automatically based on the +current project configuration, and later updates it as you edit the +files and save the changes. + * Incompatible Lisp Changes in Emacs 30.1 diff --git a/lisp/progmodes/etags-regen.el b/lisp/progmodes/etags-regen.el new file mode 100644 index 00000000000..6cd78d3577a --- /dev/null +++ b/lisp/progmodes/etags-regen.el @@ -0,0 +1,431 @@ +;;; etags-regen.el --- Auto-(re)regenerating tags -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2023 Free Software Foundation, Inc. + +;; Author: Dmitry Gutov +;; Keywords: tools + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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 . + +;;; Commentary: + +;; Simple automatic tags generation with updates on save. +;; +;; This mode provides automatic indexing for Emacs "go to definition" +;; feature, the `xref-go-forward' command (bound to `M-.' by default). +;; +;; At the moment reindexing works off before/after-save-hook, but to +;; handle more complex changes (for example, the user switching to +;; another branch from the terminal) we can look into plugging into +;; something like `filenotify'. +;; +;; Note that this feature disables itself if the user has some tags +;; table already visited (with `M-x visit-tags-table', or through an +;; explicit prompt triggered by some feature that requires tags). + +;;; Code: + +(require 'cl-lib) + +(defgroup etags-regen nil + "Auto-(re)generating tags." + :group 'tools) + +(defvar etags-regen--tags-file nil) +(defvar etags-regen--tags-root nil) +(defvar etags-regen--new-file nil) + +(declare-function project-root "project") +(declare-function project-files "project") +(declare-function dired-glob-regexp "dired") + +(defcustom etags-regen-program (executable-find "etags") + "Name of the etags program used by `etags-regen-mode'. + +If you only have `ctags' installed, you can also set this to +\"ctags -e\". Some features might not be supported this way." + ;; Always having our 'etags' here would be easier, but we can't + ;; always rely on it being installed. So it might be ctags's etags. + :type 'file + :version "30.1") + +(defcustom etags-regen-tags-file "TAGS" + "Name of the tags file to create inside the project by `etags-regen-mode'. + +The value should either be a simple file name (no directory +specified), or a function that accepts the project root directory +and returns a distinct absolute file name for its tags file. The +latter possibility is useful when you prefer to store the tag +files somewhere else, for example in `temporary-file-directory'." + :type '(choice (string :tag "File name") + (function :tag "Function that returns file name")) + :version "30.1") + +(defcustom etags-regen-program-options nil + "List of additional options for etags program invoked by `etags-regen-mode'." + :type '(repeat string) + :version "30.1") + +(defcustom etags-regen-regexp-alist nil + "Mapping of languages to etags regexps for `etags-regen-mode'. + +These regexps are used in addition to the tags made with the +standard parsing based on the language. + +The value must be a list where each element has the +form (LANGUAGES . TAG-REGEXPS) where both LANGUAGES and +TAG-REGEXPS are lists of strings. + +Each language should be one of the recognized by etags, see +`etags --help'. Each tag regexp should be a string in the format +documented for the `--regex' arguments (without `{language}'). + +We currently support only Emacs's etags program with this option." + :type '(repeat + (cons + :tag "Languages group" + (repeat (string :tag "Language name")) + (repeat (string :tag "Tag Regexp")))) + :version "30.1") + +;;;###autoload +(put 'etags-regen-regexp-alist 'safe-local-variable + (lambda (value) + (and (listp value) + (seq-every-p + (lambda (group) + (and (consp group) + (listp (car group)) + (listp (cdr group)) + (seq-every-p #'stringp (car group)) + (seq-every-p #'stringp (cdr group)))) + value)))) + +;; We have to list all extensions: etags falls back to Fortran +;; when it cannot determine the type of the file. +;; http://lists.gnu.org/archive/html/emacs-devel/2018-01/msg00323.html +(defcustom etags-regen-file-extensions + '("rb" "js" "py" "pl" "el" "c" "cpp" "cc" "h" "hh" "hpp" + "java" "go" "cl" "lisp" "prolog" "php" "erl" "hrl" + "F" "f" "f90" "for" "cs" "a" "asm" "ads" "adb" "ada") + "Code file extensions for `etags-regen-mode'. + +File extensions to generate the tags for." + :type '(repeat (string :tag "File extension")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-file-extensions 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +;; FIXME: We don't support root anchoring yet. +(defcustom etags-regen-ignores nil + "Additional ignore rules, in the format of `project-ignores'." + :type '(repeat + (string :tag "Glob to ignore")) + :version "30.1") + +;;;###autoload +(put 'etags-regen-ignores 'safe-local-variable + (lambda (value) (and (listp value) (seq-every-p #'stringp value)))) + +(defvar etags-regen--errors-buffer-name "*etags-regen-tags-errors*") + +(defvar etags-regen--rescan-files-limit 100) + +(defun etags-regen--all-mtimes (proj) + (let ((files (etags-regen--all-files proj)) + (mtimes (make-hash-table :test 'equal)) + file-name-handler-alist) + (dolist (f files) + (condition-case nil + (puthash f + (file-attribute-modification-time + (file-attributes f)) + mtimes) + (file-missing nil))) + mtimes)) + +(defun etags-regen--choose-tags-file (proj) + (if (functionp etags-regen-tags-file) + (funcall etags-regen-tags-file (project-root proj)) + (expand-file-name etags-regen-tags-file (project-root proj)))) + +(defun etags-regen--refresh (proj) + (save-excursion + (let* ((tags-file (etags-regen--choose-tags-file proj)) + (tags-mtime (file-attribute-modification-time + (file-attributes tags-file))) + (all-mtimes (etags-regen--all-mtimes proj)) + added-files + changed-files + removed-files) + (etags-regen--visit-table tags-file (project-root proj)) + (set-buffer (get-file-buffer tags-file)) + (dolist (file (tags-table-files)) + (let ((mtime (gethash file all-mtimes))) + (cond + ((null mtime) + (push file removed-files)) + ((time-less-p tags-mtime mtime) + (push file changed-files) + (remhash file all-mtimes)) + (t + (remhash file all-mtimes))))) + (maphash + (lambda (key _value) + (push key added-files)) + all-mtimes) + (if (> (+ (length added-files) + (length changed-files) + (length removed-files)) + etags-regen--rescan-files-limit) + (progn + (message "etags-regen: Too many changes, falling back to full rescan") + (etags-regen--tags-cleanup)) + (dolist (file (nconc removed-files changed-files)) + (etags-regen--remove-tag file)) + (when (or changed-files added-files) + (apply #'etags-regen--append-tags + (nconc changed-files added-files))) + (when (or changed-files added-files removed-files) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0))))))) + +(defun etags-regen--maybe-generate () + (let (proj) + (when (and etags-regen--tags-root + (not (file-in-directory-p default-directory + etags-regen--tags-root))) + (etags-regen--tags-cleanup)) + (when (and (not etags-regen--tags-root) + ;; If existing table is visited that's not generated by + ;; this mode, skip all functionality. + (not (or tags-file-name + tags-table-list)) + (file-exists-p (etags-regen--choose-tags-file + (setq proj (project-current))))) + (message "Found existing tags table, refreshing...") + (etags-regen--refresh proj)) + (when (and (not (or tags-file-name + tags-table-list)) + (setq proj (or proj (project-current)))) + (message "Generating new tags table...") + (let ((start (time-to-seconds))) + (etags-regen--tags-generate proj) + (message "...done (%.2f s)" (- (time-to-seconds) start)))))) + +(defun etags-regen--all-files (proj) + (let* ((root (project-root proj)) + (default-directory root) + ;; TODO: Make the scanning more efficient, e.g. move the + ;; filtering by glob to project (project-files-filtered...). + (files (project-files proj)) + (match-re (concat + "\\." + (regexp-opt etags-regen-file-extensions) + "\\'")) + (ir-start (1- (length root))) + (ignores-regexps + (mapcar #'etags-regen--ignore-regexp + etags-regen-ignores))) + (cl-delete-if + (lambda (f) (or (not (string-match-p match-re f)) + (string-match-p "/\\.#" f) ;Backup files. + (cl-some (lambda (ignore) (string-match ignore f ir-start)) + ignores-regexps))) + files))) + +(defun etags-regen--ignore-regexp (ignore) + (require 'dired) + ;; It's somewhat brittle to rely on Dired. + (let ((re (dired-glob-regexp ignore))) + ;; We could implement root anchoring here, but \\= doesn't work in + ;; string-match :-(. + (concat (unless (eq ?/ (aref re 3)) "/") + ;; Cutting off the anchors added by `dired-glob-regexp'. + (substring re 2 (- (length re) 2)) + ;; This way we allow a glob to match against a directory + ;; name, or a file name. And when it ends with / already, + ;; no need to add the anchoring. + (unless (eq ?/ (aref re (- (length re) 3))) + ;; Either match a full name segment, or eos. + "\\(?:/\\|\\'\\)")))) + +(defun etags-regen--tags-generate (proj) + (let* ((root (project-root proj)) + (default-directory root) + (files (etags-regen--all-files proj)) + (tags-file (etags-regen--choose-tags-file proj)) + (ctags-p (etags-regen--ctags-p)) + (command (format "%s %s %s - -o %s" + etags-regen-program + (mapconcat #'identity + (etags-regen--build-program-options ctags-p) + " ") + ;; ctags's etags requires '-L' for stdin input. + (if ctags-p "-L" "") + tags-file))) + (with-temp-buffer + (mapc (lambda (f) + (insert f "\n")) + files) + (shell-command-on-region (point-min) (point-max) command + nil nil etags-regen--errors-buffer-name t)) + (etags-regen--visit-table tags-file root))) + +(defun etags-regen--visit-table (tags-file root) + ;; Invalidate the scanned tags after any change is written to disk. + (add-hook 'after-save-hook #'etags-regen--update-file) + (add-hook 'before-save-hook #'etags-regen--mark-as-new) + (setq etags-regen--tags-file tags-file + etags-regen--tags-root root) + (visit-tags-table etags-regen--tags-file)) + +(defun etags-regen--ctags-p () + (string-search "Ctags" + (shell-command-to-string + (format "%s --version" etags-regen-program)))) + +(defun etags-regen--build-program-options (ctags-p) + (when (and etags-regen-regexp-alist ctags-p) + (user-error "etags-regen-regexp-alist is not supported with Ctags")) + (nconc + (mapcan + (lambda (group) + (mapcan + (lambda (lang) + (mapcar (lambda (regexp) + (concat "--regex=" + (shell-quote-argument + (format "{%s}%s" lang regexp)))) + (cdr group))) + (car group))) + etags-regen-regexp-alist) + (mapcar #'shell-quote-argument + etags-regen-program-options))) + +(defun etags-regen--update-file () + ;; TODO: Maybe only do this when Emacs is idle for a bit. Or defer + ;; the updates and do them later in bursts when the table is used. + (let* ((file-name buffer-file-name) + (tags-file-buf (and etags-regen--tags-root + (get-file-buffer etags-regen--tags-file))) + (relname (concat "/" (file-relative-name file-name + etags-regen--tags-root))) + (ignores etags-regen-ignores) + pr should-scan) + (save-excursion + (when tags-file-buf + (cond + ((and etags-regen--new-file + (kill-local-variable 'etags-regen--new-file) + (setq pr (project-current)) + (equal (project-root pr) etags-regen--tags-root) + (member file-name (project-files pr))) + (set-buffer tags-file-buf) + (setq should-scan t)) + ((progn (set-buffer tags-file-buf) + (etags-regen--remove-tag file-name)) + (setq should-scan t)))) + (when (and should-scan + (not (cl-some + (lambda (ignore) + (string-match-p + (etags-regen--ignore-regexp ignore) + relname)) + ignores))) + (etags-regen--append-tags file-name) + (let ((save-silently t) + (message-log-max nil)) + (save-buffer 0)))))) + +(defun etags-regen--remove-tag (file-name) + (goto-char (point-min)) + (when (search-forward (format "\f\n%s," file-name) nil t) + (let ((start (match-beginning 0))) + (search-forward "\f\n" nil 'move) + (let ((inhibit-read-only t)) + (delete-region start + (if (eobp) + (point) + (- (point) 2))))) + t)) + +(defun etags-regen--append-tags (&rest file-names) + (goto-char (point-max)) + (let ((options (etags-regen--build-program-options (etags-regen--ctags-p))) + (inhibit-read-only t)) + ;; XXX: call-process is significantly faster, though. + ;; Like 10ms vs 20ms here. But `shell-command' makes it easy to + ;; direct stderr to a separate buffer. + (shell-command + (format "%s %s %s -o -" + etags-regen-program (mapconcat #'identity options " ") + (mapconcat #'identity file-names " ")) + t etags-regen--errors-buffer-name)) + ;; FIXME: Is there a better way to do this? + ;; Completion table is the only remaining place where the + ;; update is not incremental. + (setq-default tags-completion-table nil)) + +(defun etags-regen--mark-as-new () + (when (and etags-regen--tags-root + (not buffer-file-number)) + (setq-local etags-regen--new-file t))) + +(defun etags-regen--tags-cleanup () + (when etags-regen--tags-file + (let ((buffer (get-file-buffer etags-regen--tags-file))) + (and buffer + (kill-buffer buffer))) + (tags-reset-tags-tables) + (setq tags-file-name nil + tags-table-list nil + etags-regen--tags-file nil + etags-regen--tags-root nil)) + (remove-hook 'after-save-hook #'etags-regen--update-file) + (remove-hook 'before-save-hook #'etags-regen--mark-as-new)) + +(defvar etags-regen-mode-map (make-sparse-keymap)) + +;;;###autoload +(define-minor-mode etags-regen-mode + "Minor mode to automatically generate and update tags tables. + +This minor mode generates the tags table automatically based on +the current project configuration, and later updates it as you +edit the files and save the changes. + +If you select a tags table manually (for example, using +\\[visit-tags-table]), then this mode will be effectively +disabled for the entire session. Use \\[tags-reset-tags-tables] +to countermand the effect of a previous \\[visit-tags-table]." + :global t + (if etags-regen-mode + (progn + (advice-add 'etags--xref-backend :before + #'etags-regen--maybe-generate) + (advice-add 'tags-completion-at-point-function :before + #'etags-regen--maybe-generate)) + (advice-remove 'etags--xref-backend #'etags-regen--maybe-generate) + (advice-remove 'tags-completion-at-point-function #'etags-regen--maybe-generate) + (etags-regen--tags-cleanup))) + +(provide 'etags-regen) + +;;; etags-regen.el ends here commit 0c5cfd0a236346265e06a46cfff43239868051c9 Author: Eli Zaretskii Date: Wed Jan 3 19:21:56 2024 +0200 ; * etc/themes/manoj-dark-theme.el (manoj-dark): Fix :box faces. diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 0318f85ba4d..81dac1902f0 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -411,10 +411,10 @@ jarring angry fruit salad look to reduce eye fatigue." '(cursor ((t (:background "orchid")))) '(custom-button-face ((t (:background "lightgrey" :foreground "black" - :box '(:line-width 2 :style released-button))))) + :box (:line-width 2 :style released-button))))) '(custom-button-pressed-face ((t (:background "lightgrey" :foreground "black" - :box '(:line-width 2 :style pressed-button))))) + :box (:line-width 2 :style pressed-button))))) '(custom-changed-face ((t (:foreground "wheat" :background "blue")))) '(custom-comment-face ((t (:background "dim gray")))) '(custom-comment-tag-face ((t (:foreground "gray80")))) @@ -430,7 +430,7 @@ jarring angry fruit salad look to reduce eye fatigue." '(custom-variable-button-face ((t (:bold t :underline t :weight bold :background "lightgrey" :foreground "black" - :box '(:line-width 2 :style released-button))))) + :box (:line-width 2 :style released-button))))) '(custom-variable-tag-face ((t (:bold t :foreground "light blue" :weight bold :height 1.2)))) @@ -586,15 +586,16 @@ jarring angry fruit salad look to reduce eye fatigue." '(match ((t (:background "RoyalBlue3")))) '(minibuffer-prompt ((t (:foreground "cyan")))) '(mode-line ((t (:background "grey75" :foreground "Blue" - :box '(:line-width -1 :style released-button) + :box (:line-width -1 :style released-button) :height 0.9)))) '(mode-line-buffer-id ((t (:background "grey65" :foreground "red" :bold t :weight bold :height 0.9)))) '(mode-line-emphasis ((t (:bold t :weight bold)))) '(mode-line-highlight ((t (:box (:line-width 2 :color "grey40" - :style released-button :height 0.9))))) + :style released-button) + :height 0.9)))) '(mode-line-inactive ((t (:background "grey30" :foreground "grey80" - :box '(:line-width -1 :color "grey40") + :box (:line-width -1 :color "grey40") :weight light :height 0.9)))) '(mouse ((t (:background "OrangeRed")))) commit eac9757f5c1be1d13ad8e2a8c098bf0a24435e5c Author: Eli Zaretskii Date: Wed Jan 3 14:39:30 2024 +0200 ; * lisp/vc/vc.el (vc-deduce-fileset): Add commentary for bug#68174. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7b2301ee3e5..b8cc44fc3dc 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1157,6 +1157,9 @@ BEWARE: this function may change the current buffer." (vc-checkout-model backend buffer-file-name)) (list backend (list buffer-file-name)))) ((derived-mode-p 'log-view-mode) + ;; 'log-view-mode' stashes the backend and the fileset in the + ;; two special variables, so we use them to avoid any possible + ;; mistakes from a decision made here ad-hoc. (list log-view-vc-backend log-view-vc-fileset)) ((and (buffer-live-p vc-parent-buffer) ;; FIXME: Why this test? --Stef commit b1380af072d5a76a6f95726fee0eb378dc26849b Author: Po Lu Date: Wed Jan 3 13:42:27 2024 +0800 Don't magnify extent of shifts by variable glyph interpolation * src/sfnt.c (sfnt_infer_deltas_2): Correctly index x_coordinates and y_coordinates computing deltas for plain shift. (sfnt_vary_simple_glyph): Copy glyph contents to original_x and original_y not the first time is create, but before each tuple is applied. diff --git a/src/sfnt.c b/src/sfnt.c index e66292c6ad8..aa8b49a9ecd 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -15411,7 +15411,7 @@ sfnt_infer_deltas_2 (struct sfnt_glyph *glyph, size_t pair_start, d1 = (glyph->simple->x_coordinates[pair_start] - x[pair_start]); d2 = (glyph->simple->x_coordinates[pair_end] - - x[pair_start]); + - x[pair_end]); if (d1 == d2) glyph->simple->x_coordinates[j] += d1; @@ -15483,7 +15483,7 @@ sfnt_infer_deltas_2 (struct sfnt_glyph *glyph, size_t pair_start, d1 = (glyph->simple->y_coordinates[pair_start] - y[pair_start]); d2 = (glyph->simple->y_coordinates[pair_end] - - y[pair_start]); + - y[pair_end]); if (d1 == d2) glyph->simple->y_coordinates[j] += d1; @@ -15915,14 +15915,20 @@ sfnt_vary_simple_glyph (struct sfnt_blend *blend, sfnt_glyph id, * glyph->simple->number_of_points); original_y = original_x + glyph->simple->number_of_points; - memcpy (original_x, glyph->simple->x_coordinates, - (sizeof *original_x - * glyph->simple->number_of_points)); - memcpy (original_y, glyph->simple->y_coordinates, - (sizeof *original_y - * glyph->simple->number_of_points)); } + /* The array of original coordinates should reflect the + state of the glyph immediately before deltas from this + tuple are applied, in contrast to the state before any + deltas are applied. */ + + memcpy (original_x, glyph->simple->x_coordinates, + (sizeof *original_x + * glyph->simple->number_of_points)); + memcpy (original_y, glyph->simple->y_coordinates, + (sizeof *original_y + * glyph->simple->number_of_points)); + memset (touched, 0, (sizeof *touched * glyph->simple->number_of_points)); commit ef71ff4c7e27a04344d8ddcca7e7d3e2822e38bf Author: Stefan Kangas Date: Wed Jan 3 05:22:15 2024 +0100 Don't include sheap.h in sysdep.c The symbol we used from sheap.h (bss_sbrk_did_unexec) was removed with the introduction of the portable dumper. * src/sysdep.c: Don't include "sheap.h". diff --git a/src/sysdep.c b/src/sysdep.c index 78379934347..3a6829dd27a 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -#include "sheap.h" #include "sysselect.h" #include "blockinput.h" commit 5a1cd1bb98f74710d3b2a227755c5627a256dafb Author: Stefan Kangas Date: Wed Jan 3 05:11:10 2024 +0100 Delete obsolete GC debugging code This code was introduced in 2014 to catch a GC bug that, according to Paul Eggert in 2019, "seems to have been fixed" (see 2b552f34892 2019-08-21 "Don’t debug fset by default"). It has been marked obsolete since that time, and no one has mentioned it on our mailing lists since. Let's just get rid of it. * src/alloc.c (SUSPICIOUS_OBJECT_CHECKING) [ENABLE_CHECKING]: Don't define. (suspicious_free_record, suspicious_objects, suspicious_object_index) (suspicious_free_history, suspicious_free_history_index) (note_suspicious_free) [SUSPICIOUS_OBJECT_CHECKING]: Delete. (find_suspicious_object_in_range) (detect_suspicious_free): Delete functions. (cleanup_vector) (allocate_vectorlike): Don't call above deleted functions. (Fsuspicious_object): Delete DEFUN. (syms_of_alloc) : Delete defsubr. diff --git a/src/alloc.c b/src/alloc.c index 3e29c61f1ff..53ba85d88b7 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -412,31 +412,6 @@ static EMACS_INT gc_threshold; const char *pending_malloc_warning; -/* Pointer sanity only on request. FIXME: Code depending on - SUSPICIOUS_OBJECT_CHECKING is obsolete; remove it entirely. */ -#ifdef ENABLE_CHECKING -#define SUSPICIOUS_OBJECT_CHECKING 1 -#endif - -#ifdef SUSPICIOUS_OBJECT_CHECKING -struct suspicious_free_record -{ - void *suspicious_object; - void *backtrace[128]; -}; -static void *suspicious_objects[32]; -static int suspicious_object_index; -struct suspicious_free_record suspicious_free_history[64] EXTERNALLY_VISIBLE; -static int suspicious_free_history_index; -/* Find the first currently-monitored suspicious pointer in range - [begin,end) or NULL if no such pointer exists. */ -static void *find_suspicious_object_in_range (void *begin, void *end); -static void detect_suspicious_free (void *ptr); -#else -# define find_suspicious_object_in_range(begin, end) ((void *) NULL) -# define detect_suspicious_free(ptr) ((void) 0) -#endif - /* Maximum amount of C stack to save when a GC happens. */ #ifndef MAX_SAVE_STACK @@ -3351,7 +3326,6 @@ vectorlike_nbytes (const union vectorlike_header *hdr) static void cleanup_vector (struct Lisp_Vector *vector) { - detect_suspicious_free (vector); if ((vector->header.size & PSEUDOVECTOR_FLAG) == 0) return; /* nothing more to do for plain vectors */ switch (PSEUDOVECTOR_TYPE (vector)) @@ -3629,9 +3603,6 @@ allocate_vectorlike (ptrdiff_t len, bool clearit) mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); #endif - if (find_suspicious_object_in_range (p, (char *) p + nbytes)) - emacs_abort (); - tally_consing (nbytes); vector_cells_consed += len; @@ -8019,78 +7990,6 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) return unbind_to (gc_count, found); } -#ifdef SUSPICIOUS_OBJECT_CHECKING - -static void * -find_suspicious_object_in_range (void *begin, void *end) -{ - char *begin_a = begin; - char *end_a = end; - int i; - - for (i = 0; i < ARRAYELTS (suspicious_objects); ++i) - { - char *suspicious_object = suspicious_objects[i]; - if (begin_a <= suspicious_object && suspicious_object < end_a) - return suspicious_object; - } - - return NULL; -} - -static void -note_suspicious_free (void *ptr) -{ - struct suspicious_free_record *rec; - - rec = &suspicious_free_history[suspicious_free_history_index++]; - if (suspicious_free_history_index == - ARRAYELTS (suspicious_free_history)) - { - suspicious_free_history_index = 0; - } - - memset (rec, 0, sizeof (*rec)); - rec->suspicious_object = ptr; - backtrace (&rec->backtrace[0], ARRAYELTS (rec->backtrace)); -} - -static void -detect_suspicious_free (void *ptr) -{ - int i; - - eassert (ptr != NULL); - - for (i = 0; i < ARRAYELTS (suspicious_objects); ++i) - if (suspicious_objects[i] == ptr) - { - note_suspicious_free (ptr); - suspicious_objects[i] = NULL; - } -} - -#endif /* SUSPICIOUS_OBJECT_CHECKING */ - -DEFUN ("suspicious-object", Fsuspicious_object, Ssuspicious_object, 1, 1, 0, - doc: /* Return OBJ, maybe marking it for extra scrutiny. -If Emacs is compiled with suspicious object checking, capture -a stack trace when OBJ is freed in order to help track down -garbage collection bugs. Otherwise, do nothing and return OBJ. */) - (Lisp_Object obj) -{ -#ifdef SUSPICIOUS_OBJECT_CHECKING - /* Right now, we care only about vectors. */ - if (VECTORLIKEP (obj)) - { - suspicious_objects[suspicious_object_index++] = XVECTOR (obj); - if (suspicious_object_index == ARRAYELTS (suspicious_objects)) - suspicious_object_index = 0; - } -#endif - return obj; -} - #ifdef ENABLE_CHECKING bool suppress_checking; @@ -8322,7 +8221,6 @@ N should be nonnegative. */); #ifdef HAVE_MALLOC_TRIM defsubr (&Smalloc_trim); #endif - defsubr (&Ssuspicious_object); Lisp_Object watcher; commit 91bc775b0c60342f118640001d2ce293d4f1f7ef Author: Dmitry Gutov Date: Wed Jan 3 02:11:56 2024 +0200 (vc-deduce-fileset): Handle log-view-mode derivatives specially * lisp/vc/vc.el (vc-deduce-fileset): Handle log-view-mode derivatives specially, that helps after switching projects (bug#68174). diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 69097c180f2..7b2301ee3e5 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1074,6 +1074,7 @@ Within directories, only files already under version control are noticed." (defvar vc-dir-backend) (defvar log-view-vc-backend) +(defvar log-view-vc-fileset) (defvar log-edit-vc-backend) (defvar diff-vc-backend) (defvar diff-vc-revisions) @@ -1155,6 +1156,8 @@ BEWARE: this function may change the current buffer." (vc-state buffer-file-name) (vc-checkout-model backend buffer-file-name)) (list backend (list buffer-file-name)))) + ((derived-mode-p 'log-view-mode) + (list log-view-vc-backend log-view-vc-fileset)) ((and (buffer-live-p vc-parent-buffer) ;; FIXME: Why this test? --Stef (or (buffer-file-name vc-parent-buffer) commit 0bc42eec9836d5f977d4187d57c829895726b862 Author: Eli Zaretskii Date: Tue Jan 2 19:13:55 2024 +0200 ; * lisp/mail/rmail.el (rmail-epa-decrypt): Fix whitespace. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index a9a56e35573..74cf297c2fc 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4682,7 +4682,7 @@ Argument MIME is non-nil if this is a mime message." (when armor-end (if (null (nth 2 d)) nil - ;; In a mime part -- + ;; In a mime part -- ;; replace CRLF with NL in it. (save-restriction (narrow-to-region armor-start armor-end) commit 7592c3a6e0d9dc50d818bd0499b8a074b265f666 Author: Eli Zaretskii Date: Tue Jan 2 19:10:33 2024 +0200 ; Fix compilation errors in completion-preview.el * lisp/completion-preview.el (mouse-wheel-up-event) (mouse-wheel-up-alternate-event, mouse-wheel-down-event) (mouse-wheel-down-alternate-event): Defvar, to avoid warnings and errors in builds --without-x. (Bug#68213) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index da4afb8f66a..baadb4714b1 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -128,6 +128,10 @@ If this option is nil, these commands do not display any message." ;; "M-p" #'completion-preview-prev-candidate ) +(defvar mouse-wheel-up-event) +(defvar mouse-wheel-up-alternate-event) +(defvar mouse-wheel-down-event) +(defvar mouse-wheel-down-alternate-event) (defvar-keymap completion-preview--mouse-map :doc "Keymap for mouse clicks on the completion preview." "" #'completion-preview-insert commit b37676642679a9ec3cd3b995cd14a4af3567cf80 Author: Richard M. Stallman Date: Tue Jan 2 09:45:45 2024 -0500 Fix non-permenent decryption to show up temperarily. In a decrypted mime part, replace CRLF with newline, * lisp/mail/rmail.el (rmail-epa-decrypt-1): If NOT descrypting permanently, put the decrypts into the view buffer. (rmail-epa-decrypt, rmail-epa-decrypt-1): In a decrypted mime part, replace CRLF with newline, diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 6366a9fddcb..a9a56e35573 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4611,6 +4611,16 @@ Argument MIME is non-nil if this is a mime message." ;; Decode any base64-encoded material in what we just decrypted. (rmail-epa-decode armor-start after-end) + ;; If this is in a MIME part, convert CRLF into just LF (newline) + (when mime + (save-restriction + (narrow-to-region armor-start (- (point-max) after-end)) + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (while (search-forward "\r\n" nil t) + (delete-region (- (point) 2) (- (point) 1))))) + ) + (list armor-start (- (point-max) after-end) mime armor-end-regexp (buffer-substring armor-start (- (point-max) after-end))))) @@ -4654,7 +4664,33 @@ Argument MIME is non-nil if this is a mime message." (push (rmail-epa-decrypt-1 mime) decrypts)))) (when (and decrypts (rmail-buffers-swapped-p)) - (when (y-or-n-p "Replace the original message? ") + (if (not (y-or-n-p "Replace the original message? ")) + ;; User wants to decrypt only temporarily. + ;; Find, in the view buffer, the armors + ;; that we made decrypts for, and replace each one + ;; with its decrypt. In a mime part, replace CRLF with NL. + (dolist (d decrypts) + (if (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (let (armor-start armor-end armor-end-regexp) + (setq armor-start (match-beginning 0) + armor-end-regexp (nth 3 d) + armor-end (re-search-forward + armor-end-regexp + nil t)) + + ;; Found as expected -- now replace it with the decrypt. + (when armor-end + (if (null (nth 2 d)) + nil + ;; In a mime part -- + ;; replace CRLF with NL in it. + (save-restriction + (narrow-to-region armor-start armor-end) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (delete-region (- (point) 2) (- (point) 1)))))) + ))) + ;; User wants to decrypt the message perenently. (when (eq major-mode 'rmail-mode) (rmail-add-label "decrypt")) (setq decrypts (nreverse decrypts)) commit 7c6e44e5ccb009a63da30fbc468c924dd383b521 Author: Stefan Kangas Date: Tue Jan 2 06:57:17 2024 +0100 Don't include sheap.h from alloc.c The symbol we used from sheap.h (bss_sbrk_did_unexec) was removed with the introduction of the portable dumper. * src/alloc.c: Don't include sheap.h. diff --git a/src/alloc.c b/src/alloc.c index 7978bc925ae..3e29c61f1ff 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -34,7 +34,6 @@ along with GNU Emacs. If not, see . */ #include "dispextern.h" #include "intervals.h" #include "puresize.h" -#include "sheap.h" #include "sysstdio.h" #include "systime.h" #include "character.h" commit ce7a95711c0746eb7320ea18799b66599764c49a Author: Po Lu Date: Tue Jan 2 12:26:57 2024 +0800 Improve rounding of projection vector versors * src/sfnt.c (sfnt_short_frac_dot): New function. (sfnt_validate_gs): Guarantee dot product of freedom and projection vectors are properly rounded. If the final product is short of 1/16th of a vector, reset it to an entire vector. diff --git a/src/sfnt.c b/src/sfnt.c index ead41b89025..e66292c6ad8 100644 --- a/src/sfnt.c +++ b/src/sfnt.c @@ -10721,6 +10721,15 @@ sfnt_move (sfnt_f26dot6 *restrict x, sfnt_f26dot6 *restrict y, } } +/* Compute the dot product of the two versors A and B with + rounding. */ + +static sfnt_f2dot14 +sfnt_short_frac_dot (sfnt_f2dot14 a, sfnt_f2dot14 b) +{ + return (sfnt_f2dot14) ((((long) a * b) + 8192) / 16384); +} + /* Validate the graphics state GS. Establish function pointers for rounding and projection. Establish dot product used to convert vector distances between @@ -10797,11 +10806,18 @@ sfnt_validate_gs (struct sfnt_graphics_state *gs) gs->vector_dot_product = gs->projection_vector.y; else /* Actually calculate the dot product. */ - gs->vector_dot_product = ((((long) gs->projection_vector.x - * gs->freedom_vector.x) - + ((long) gs->projection_vector.y - * gs->freedom_vector.y)) - / 16384); + gs->vector_dot_product = (sfnt_short_frac_dot (gs->projection_vector.x, + gs->freedom_vector.x) + + sfnt_short_frac_dot (gs->projection_vector.y, + gs->freedom_vector.y)); + + /* If the product is less than 1/16th of a vector, prevent overflow + by resetting it to 1. */ + + if (gs->vector_dot_product > -0x400 + && gs->vector_dot_product < 0x400) + gs->vector_dot_product = (gs->vector_dot_product < 0 + ? -0x4000 : 0x4000); /* Now figure out which function to use to move distances. Handle the common case where both the freedom and projection vectors are commit f77840a5526e40c381a9208a0c5097f652be8e03 Author: Stefan Kangas Date: Tue Jan 2 04:08:43 2024 +0100 ; Clarify two comments in byte-optimize-letX * lisp/emacs-lisp/byte-opt.el (byte-optimize-letX): Clarify comments. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index cdeed678eef..add13a5c312 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1479,7 +1479,7 @@ See Info node `(elisp) Integer Basics'." (put 'let* 'byte-optimizer #'byte-optimize-letX) (defun byte-optimize-letX (form) (pcase form - ;; No bindings. + ;; Bindings list is empty. (`(,_ () . ,body) `(progn . ,body)) @@ -1489,7 +1489,7 @@ See Info node `(elisp) Integer Basics'." `(progn ,@(mapcar #'cadr bindings) ,const) `(,head ,(butlast bindings) ,(cadar (last bindings)) ,const))) - ;; Body is last variable. + ;; Body does nothing but return the last variable in bindings. (`(,head ,(and bindings (let last-var (caar (last bindings)))) ,(and last-var ; non-linear pattern commit d2528f5c0f90a6c36ad270d8f9fb1b92042db721 Author: Po Lu Date: Tue Jan 2 10:31:42 2024 +0800 ; Update copyright years in more files diff --git a/admin/notes/years b/admin/notes/years index 113e6608d3f..0510cb24b81 100644 --- a/admin/notes/years +++ b/admin/notes/years @@ -24,6 +24,8 @@ A few known problems with the build-aux/update-copyright script: . several README and XPM files under etc/images/, and also etc/refcards/README, msdos/README, and nt/icons/README aren't updated either + - the copyright notice for headers generated by exec/configure.ac is + not updated as the file already bears a notice above it These files need to be updated by hand. diff --git a/exec/configure.ac b/exec/configure.ac index 594e82ce624..9008c84f6a6 100644 --- a/exec/configure.ac +++ b/exec/configure.ac @@ -25,7 +25,7 @@ AC_PREREQ([2.65]) AC_INIT([libexec], [30.0.50], [bug-gnu-emacs@gnu.org], [], [https://www.gnu.org/software/emacs/]) -AH_TOP([/* Copyright (C) 2023 Free Software Foundation, Inc. +AH_TOP([/* Copyright (C) 2024 Free Software Foundation, Inc. This file is part of GNU Emacs. commit 070cb32463a8c606bf4384574a6c7ea60167e87d Author: Po Lu Date: Tue Jan 2 10:30:05 2024 +0800 ; Add 2024 to copyright years diff --git a/ChangeLog.android b/ChangeLog.android index 96419ebe351..e86ef7a2a77 100644 --- a/ChangeLog.android +++ b/ChangeLog.android @@ -7261,7 +7261,7 @@ and those made after the Android port was installed. ;; coding: utf-8 ;; End: - Copyright (C) 2023 Free Software Foundation, Inc. + Copyright (C) 2023-2024 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/admin/notes/java b/admin/notes/java index 6a66d1aa765..891096cd406 100644 --- a/admin/notes/java +++ b/admin/notes/java @@ -1,5 +1,5 @@ Installation instructions for Android -Copyright (C) 2023 Free Software Foundation, Inc. +Copyright (C) 2023-2024 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/build-aux/git-hooks/commit-msg-files.awk b/build-aux/git-hooks/commit-msg-files.awk index 5c9b70a5de5..2fbbd059500 100644 --- a/build-aux/git-hooks/commit-msg-files.awk +++ b/build-aux/git-hooks/commit-msg-files.awk @@ -1,6 +1,6 @@ # Check the file list of GNU Emacs change log entries for each commit SHA. -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/build-aux/git-hooks/post-commit b/build-aux/git-hooks/post-commit index e02fee48db4..e6b5effc93a 100755 --- a/build-aux/git-hooks/post-commit +++ b/build-aux/git-hooks/post-commit @@ -1,7 +1,7 @@ #!/bin/sh # Check the file list of GNU Emacs change log entries after committing. -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/build-aux/git-hooks/pre-push b/build-aux/git-hooks/pre-push index a342814c1e3..86c81e02d9a 100755 --- a/build-aux/git-hooks/pre-push +++ b/build-aux/git-hooks/pre-push @@ -1,7 +1,7 @@ #!/bin/sh # Check the file list of GNU Emacs change log entries before pushing. -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/build-aux/makecounter.sh b/build-aux/makecounter.sh index 3bebd288031..a63fcbb7c61 100755 --- a/build-aux/makecounter.sh +++ b/build-aux/makecounter.sh @@ -2,7 +2,7 @@ # Generate or update a C file containing an increasing counter # variable. # -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # # This file is part of GNU Emacs. GNU Emacs is free software: you can # redistribute it and/or modify it under the terms of the GNU General diff --git a/build-aux/ndk-build-helper-1.mk b/build-aux/ndk-build-helper-1.mk index 2cde5146301..5681728154c 100644 --- a/build-aux/ndk-build-helper-1.mk +++ b/build-aux/ndk-build-helper-1.mk @@ -1,5 +1,5 @@ # ndk-build-helper-1.mk -- Helper for ndk-build.m4. -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. # GNU Emacs is free software: you can redistribute it and/or modify diff --git a/build-aux/ndk-build-helper-2.mk b/build-aux/ndk-build-helper-2.mk index 186f3aec333..1c2409cfd57 100644 --- a/build-aux/ndk-build-helper-2.mk +++ b/build-aux/ndk-build-helper-2.mk @@ -1,5 +1,5 @@ # ndk-build-helper-2.mk -- Helper for ndk-build.m4. -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. # GNU Emacs is free software: you can redistribute it and/or modify diff --git a/build-aux/ndk-build-helper-3.mk b/build-aux/ndk-build-helper-3.mk index 4d0358d4f77..e360a347bb4 100644 --- a/build-aux/ndk-build-helper-3.mk +++ b/build-aux/ndk-build-helper-3.mk @@ -1,5 +1,5 @@ # ndk-build-helper-3.mk -- Helper for ndk-build.m4. -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. # GNU Emacs is free software: you can redistribute it and/or modify diff --git a/build-aux/ndk-build-helper-4.mk b/build-aux/ndk-build-helper-4.mk index a41679c53af..54f781bdbaa 100644 --- a/build-aux/ndk-build-helper-4.mk +++ b/build-aux/ndk-build-helper-4.mk @@ -1,4 +1,4 @@ -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. # GNU Emacs is free software: you can redistribute it and/or modify diff --git a/build-aux/ndk-build-helper.mk b/build-aux/ndk-build-helper.mk index 05f0af76411..521e1b24ce3 100644 --- a/build-aux/ndk-build-helper.mk +++ b/build-aux/ndk-build-helper.mk @@ -1,5 +1,5 @@ # ndk-build-helper.mk -- Helper for ndk-build.m4. -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. # GNU Emacs is free software: you can redistribute it and/or modify diff --git a/cross/Makefile.in b/cross/Makefile.in index b66025283aa..6f2250fe02f 100644 --- a/cross/Makefile.in +++ b/cross/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/langinfo.h b/cross/langinfo.h index b296ba8db80..0edb0082bda 100644 --- a/cross/langinfo.h +++ b/cross/langinfo.h @@ -1,6 +1,6 @@ /* Replacement langinfo.h file for building GNU Emacs on Android. -Copyright (C) 2023 Free Software Foundation, Inc. +Copyright (C) 2023-2024 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/cross/ndk-build/Makefile.in b/cross/ndk-build/Makefile.in index cdf18471ff3..8ba2d356f27 100644 --- a/cross/ndk-build/Makefile.in +++ b/cross/ndk-build/Makefile.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/README b/cross/ndk-build/README index d6cf2908014..84a131443c4 100644 --- a/cross/ndk-build/README +++ b/cross/ndk-build/README @@ -1,6 +1,6 @@ NDK BUILD SYSTEM IMPLEMENTATION -Copyright (C) 2023 Free Software Foundation, Inc. +Copyright (C) 2023-2024 Free Software Foundation, Inc. See the end of the file for license conditions. Emacs implements ndk-build itself, because the version that comes with diff --git a/cross/ndk-build/ndk-build-executable.mk b/cross/ndk-build/ndk-build-executable.mk index 9591c862b18..4f520074c7f 100644 --- a/cross/ndk-build/ndk-build-executable.mk +++ b/cross/ndk-build/ndk-build-executable.mk @@ -1,4 +1,4 @@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-build-shared-library.mk b/cross/ndk-build/ndk-build-shared-library.mk index d60802da1d0..74c6756a0c1 100644 --- a/cross/ndk-build/ndk-build-shared-library.mk +++ b/cross/ndk-build/ndk-build-shared-library.mk @@ -1,4 +1,4 @@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-build-static-library.mk b/cross/ndk-build/ndk-build-static-library.mk index 98afd864ed6..aba4539f6bb 100644 --- a/cross/ndk-build/ndk-build-static-library.mk +++ b/cross/ndk-build/ndk-build-static-library.mk @@ -1,4 +1,4 @@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in index 57006901721..6c85ff5044e 100644 --- a/cross/ndk-build/ndk-build.mk.in +++ b/cross/ndk-build/ndk-build.mk.in @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright (C) 2023 Free Software Foundation, Inc. +# Copyright (C) 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-clear-vars.mk b/cross/ndk-build/ndk-clear-vars.mk index 7309b7bb513..0803522f3d4 100644 --- a/cross/ndk-build/ndk-clear-vars.mk +++ b/cross/ndk-build/ndk-clear-vars.mk @@ -1,4 +1,4 @@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-prebuilt-shared-library.mk b/cross/ndk-build/ndk-prebuilt-shared-library.mk index 2a8260f9851..d63ca4a0c76 100644 --- a/cross/ndk-build/ndk-prebuilt-shared-library.mk +++ b/cross/ndk-build/ndk-prebuilt-shared-library.mk @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-prebuilt-static-library.mk b/cross/ndk-build/ndk-prebuilt-static-library.mk index 9230f690bb1..94c98435d5f 100644 --- a/cross/ndk-build/ndk-prebuilt-static-library.mk +++ b/cross/ndk-build/ndk-prebuilt-static-library.mk @@ -1,6 +1,6 @@ ### @configure_input@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/ndk-build/ndk-resolve.mk b/cross/ndk-build/ndk-resolve.mk index b29a2c6dc39..d3b398bca62 100644 --- a/cross/ndk-build/ndk-resolve.mk +++ b/cross/ndk-build/ndk-resolve.mk @@ -1,4 +1,4 @@ -# Copyright 2023 Free Software Foundation, Inc. +# Copyright 2023-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/cross/verbose.mk.android b/cross/verbose.mk.android index d41d6b6aac0..958cf237c58 100644 --- a/cross/verbose.mk.android +++ b/cross/verbose.mk.android @@ -1,7 +1,7 @@ ### verbose.mk --- Makefile fragment for GNU Emacs during ### cross-compilation. -## Copyright (C) 2023 Free Software Foundation, Inc. +## Copyright (C) 2023-2024 Free Software Foundation, Inc. ## This file is part of GNU Emacs. diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi index 3b81f5cb43f..0ea96d91492 100644 --- a/doc/emacs/android.texi +++ b/doc/emacs/android.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2023 Free Software Foundation, Inc. +@c Copyright (C) 2023--2024 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Android @appendix Emacs and Android diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi index 7f9d37b52de..67679b00e89 100644 --- a/doc/emacs/input.texi +++ b/doc/emacs/input.texi @@ -1,5 +1,5 @@ @c This is part of the Emacs manual. -@c Copyright (C) 2023 Free Software Foundation, Inc. +@c Copyright (C) 2023--2024 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Other Input @section Touchscreen Input and Virtual Keyboards diff --git a/doc/lang/fr/misc/ses-fr.texi b/doc/lang/fr/misc/ses-fr.texi index ff49974bd48..e1b9cac5fc3 100644 --- a/doc/lang/fr/misc/ses-fr.texi +++ b/doc/lang/fr/misc/ses-fr.texi @@ -15,7 +15,7 @@ Ce fichier documente @acronym{SES} : le tableur simple d’Emacs (Simple Emacs Spreadsheet). -Copyright @copyright{} 2002--2023 Free Software Foundation, Inc. +Copyright @copyright{} 2002--2024 Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document diff --git a/etc/NEWS b/etc/NEWS index 7ae8529b33a..a6b0beb6ee5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2022-2023 Free Software Foundation, Inc. +Copyright (C) 2022-2024 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Emacs bug reports to 'bug-gnu-emacs@gnu.org'. diff --git a/etc/images/gnus/gnus-pointer.svg b/etc/images/gnus/gnus-pointer.svg index 67a631cdcf5..590e0f56d89 100644 --- a/etc/images/gnus/gnus-pointer.svg +++ b/etc/images/gnus/gnus-pointer.svg @@ -1,7 +1,7 @@ + org.gnu.emacs GFDL-1.3+ diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py index 609815613bf..ad235e46b89 100644 --- a/etc/emacs_lldb.py +++ b/etc/emacs_lldb.py @@ -1,4 +1,4 @@ -# Copyright (C) 2022-2023 Free Software Foundation, Inc. +# Copyright (C) 2022-2024 Free Software Foundation, Inc. # # This file is part of GNU Emacs. # diff --git a/etc/enriched.txt b/etc/enriched.txt index 5828a6e68a7..a3bd3f21f5d 100644 --- a/etc/enriched.txt +++ b/etc/enriched.txt @@ -259,7 +259,7 @@ it. -Copyright (C) 1995, 1997, 2001-2023 Free Software Foundation, Inc. +Copyright (C) 1995, 1997, 2001-2024 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el index afdf5119bb4..b1f378cbc39 100644 --- a/etc/forms/forms-d2.el +++ b/etc/forms/forms-d2.el @@ -1,6 +1,6 @@ ;;; forms-d2.el --- demo forms-mode -*- lexical-binding:t -*- -;; Copyright (C) 1991, 1994-1997, 2001-2023 Free Software Foundation, +;; Copyright (C) 1991, 1994-1997, 2001-2024 Free Software Foundation, ;; Inc. ;; Author: Johan Vromans diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt index 9212a81be27..02b4b7e2193 100644 --- a/etc/gnus-tut.txt +++ b/etc/gnus-tut.txt @@ -24,7 +24,7 @@ was done by moi, yours truly, your humble servant, Lars Magne Ingebrigtsen. If you have a WWW browser, you can investigate to your heart's delight at . -;; Copyright (C) 1995, 2001-2023 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2001-2024 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news diff --git a/etc/grep.txt b/etc/grep.txt index 99e6d3641be..653123344dc 100644 --- a/etc/grep.txt +++ b/etc/grep.txt @@ -104,7 +104,7 @@ grep -nH -e "xyzxyz" ../info/* * Miscellaneous -Copyright (C) 2005-2023 Free Software Foundation, Inc. +Copyright (C) 2005-2024 Free Software Foundation, Inc. COPYING PERMISSIONS: diff --git a/etc/images/README b/etc/images/README index 5886f641536..3c381baaab0 100644 --- a/etc/images/README +++ b/etc/images/README @@ -27,7 +27,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES File: mh-logo.xpm Author: Satyaki Das - Copyright (C) 2003-2023 Free Software Foundation, Inc. + Copyright (C) 2003-2024 Free Software Foundation, Inc. Files: gnus.pbm Author: Luis Fernandes diff --git a/etc/images/custom/README b/etc/images/custom/README index 7ed66523ecd..235303c3dd3 100644 --- a/etc/images/custom/README +++ b/etc/images/custom/README @@ -6,5 +6,5 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES Files: down.xpm down-pushed.xpm right.xpm right-pushed.xpm Author: Juri Linkov -Copyright (C) 2008-2023 Free Software Foundation, Inc. +Copyright (C) 2008-2024 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/ezimage/README b/etc/images/ezimage/README index 4d2482de515..02178819211 100644 --- a/etc/images/ezimage/README +++ b/etc/images/ezimage/README @@ -7,5 +7,5 @@ Files: bits.xpm bitsbang.xpm box-minus.xpm box-plus.xpm tag-gt.xpm tag-minus.xpm tag-plus.xpm tag-type.xpm tag-v.xpm tag.xpm unlock.xpm Author: Eric M. Ludlam -Copyright (C) 1999-2023 Free Software Foundation, Inc. +Copyright (C) 1999-2024 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/gnus/README b/etc/images/gnus/README index f05cf0f7f10..1d4259c2e2e 100644 --- a/etc/images/gnus/README +++ b/etc/images/gnus/README @@ -7,7 +7,7 @@ COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES Files: important.xpm, unimportant.xpm Author: Simon Josefsson -Copyright (C) 2001-2023 Free Software Foundation, Inc. +Copyright (C) 2001-2024 Free Software Foundation, Inc. Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg index 14f96da5e55..42aee872bf0 100644 --- a/etc/images/gnus/gnus.svg +++ b/etc/images/gnus/gnus.svg @@ -1,7 +1,7 @@ + diff --git a/etc/org/README b/etc/org/README index 3737c8df9ac..7944bcb207c 100644 --- a/etc/org/README +++ b/etc/org/README @@ -1,7 +1,7 @@ The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the following copyright information: -Copyright (C) 2010-2023 Free Software Foundation, Inc. +Copyright (C) 2010-2024 Free Software Foundation, Inc. These files are part of GNU Emacs. diff --git a/etc/ps-prin0.ps b/etc/ps-prin0.ps index ba35337e4e4..a9471de2093 100644 --- a/etc/ps-prin0.ps +++ b/etc/ps-prin0.ps @@ -1,7 +1,7 @@ % === BEGIN ps-print prologue 0 % version: 6.0 -% Copyright (C) 2000-2023 Free Software Foundation, Inc. +% Copyright (C) 2000-2024 Free Software Foundation, Inc. % This file is part of GNU Emacs. diff --git a/etc/ps-prin1.ps b/etc/ps-prin1.ps index 37512a86ab9..34bde99c420 100644 --- a/etc/ps-prin1.ps +++ b/etc/ps-prin1.ps @@ -1,7 +1,7 @@ % === BEGIN ps-print prologue 1 % version: 6.1 -% Copyright (C) 2000-2023 Free Software Foundation, Inc. +% Copyright (C) 2000-2024 Free Software Foundation, Inc. % This file is part of GNU Emacs. diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index 9bc7564395a..c80c55a60cf 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -1,6 +1,6 @@ ### Makefile for Emacs refcards -## Copyright (C) 1993-1994, 2001-2023 Free Software Foundation, Inc. +## Copyright (C) 1993-1994, 2001-2024 Free Software Foundation, Inc. ## This file is part of GNU Emacs. # diff --git a/etc/refcards/README b/etc/refcards/README index 7e3c7d65d6c..97bd8f33993 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -1,4 +1,4 @@ -Copyright (C) 2013-2023 Free Software Foundation, Inc. +Copyright (C) 2013-2024 Free Software Foundation, Inc. See the end of the file for license conditions. diff --git a/etc/refcards/calccard.tex b/etc/refcards/calccard.tex index ce70b6271e5..1684240f9cf 100644 --- a/etc/refcards/calccard.tex +++ b/etc/refcards/calccard.tex @@ -20,7 +20,7 @@ % Typical command to format: tex calccard.tex % Typical command to print (3 cols): dvips -t landscape calccard.dvi -% Copyright (C) 1987, 1992, 2001--2023 Free Software Foundation, Inc. +% Copyright (C) 1987, 1992, 2001--2024 Free Software Foundation, Inc. % This document is free software: you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by diff --git a/etc/refcards/cs-dired-ref.tex b/etc/refcards/cs-dired-ref.tex index 6f865ca26c7..028df7ee33b 100644 --- a/etc/refcards/cs-dired-ref.tex +++ b/etc/refcards/cs-dired-ref.tex @@ -1,6 +1,6 @@ % Reference Card for Dired -*- coding: utf-8 -*- -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Evgeny Roubinchtein % Czech translation: Pavel Janík , March 2001 diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex index a949b3d19d2..85383d0ac4b 100644 --- a/etc/refcards/cs-refcard.tex +++ b/etc/refcards/cs-refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -*- coding: utf-8 -*- -% Copyright (C) 1987, 1993, 1996--1997, 2001--2023 Free Software +% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software % Foundation, Inc. % Author: Stephen Gildea diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex index 59885e92654..bd6206152de 100644 --- a/etc/refcards/cs-survival.tex +++ b/etc/refcards/cs-survival.tex @@ -1,6 +1,6 @@ % Title: GNU Emacs Survival Card -*- coding: utf-8 -*- -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Włodek Bzyl % Czech translation: Pavel Janík , March 2001 diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex index e0088bc6c7c..da11ac4aa8e 100644 --- a/etc/refcards/de-refcard.tex +++ b/etc/refcards/de-refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -% Copyright (C) 1987, 1993, 1996, 2000--2023 Free Software Foundation, +% Copyright (C) 1987, 1993, 1996, 2000--2024 Free Software Foundation, % Inc. % Author: Stephen Gildea diff --git a/etc/refcards/dired-ref.tex b/etc/refcards/dired-ref.tex index 3ebd422ed09..ffe1bbb50ff 100644 --- a/etc/refcards/dired-ref.tex +++ b/etc/refcards/dired-ref.tex @@ -1,6 +1,6 @@ % Reference Card for Dired -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Evgeny Roubinchtein diff --git a/etc/refcards/emacsver.tex.in b/etc/refcards/emacsver.tex.in index d1f15f18c85..31d1aa95eff 100644 --- a/etc/refcards/emacsver.tex.in +++ b/etc/refcards/emacsver.tex.in @@ -2,4 +2,4 @@ \def\versionemacs{@majorversion@} % major version of emacs %% This one should not be automatically updated; %% M-x set-copyright in admin.el handles it. -\def\year{2023} % latest copyright year +\def\year{2024} % latest copyright year diff --git a/etc/refcards/fr-dired-ref.tex b/etc/refcards/fr-dired-ref.tex index 9a0df984ad1..7f9d32901c7 100644 --- a/etc/refcards/fr-dired-ref.tex +++ b/etc/refcards/fr-dired-ref.tex @@ -1,6 +1,6 @@ % Reference Card for Dired -*- coding: utf-8 -*- -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Evgeny Roubinchtein % French translation: Eric Jacoboni diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex index b7b70721f90..cce866d634d 100644 --- a/etc/refcards/fr-refcard.tex +++ b/etc/refcards/fr-refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -% Copyright (C) 1987, 1993, 1996--1997, 2001--2023 Free Software +% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software % Foundation, Inc. % Author: Stephen Gildea diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex index abc49b61895..149268c20b0 100644 --- a/etc/refcards/fr-survival.tex +++ b/etc/refcards/fr-survival.tex @@ -1,7 +1,7 @@ %&tex % Title: GNU Emacs Survival Card -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Włodek Bzyl % French translation: \'Eric Jacoboni , November 2001 diff --git a/etc/refcards/gnus-logo.eps b/etc/refcards/gnus-logo.eps index 3bd785d6825..44a43ab65c9 100644 --- a/etc/refcards/gnus-logo.eps +++ b/etc/refcards/gnus-logo.eps @@ -1,5 +1,5 @@ %!PS-Adobe-2.0 EPSF-2.0 -% Copyright (C) 2000-2023 Free Software Foundation, Inc. +% Copyright (C) 2000-2024 Free Software Foundation, Inc. % % Author: Luis Fernandes % diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex index 1064af089a4..ee3fff2d3e3 100644 --- a/etc/refcards/gnus-refcard.tex +++ b/etc/refcards/gnus-refcard.tex @@ -120,7 +120,7 @@ %% Gnus logo by Luis Fernandes. \newcommand{\Copyright}{% \begin{center} - Copyright \copyright\ 1995, 2000, 2002--2023 Free Software Foundation, Inc.\\* + Copyright \copyright\ 1995, 2000, 2002--2024 Free Software Foundation, Inc.\\* \end{center} Released under the terms of the GNU General Public License version 3 or later. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index c757d343bc8..705ab62d69d 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -17,7 +17,7 @@ \pdflayout=(0l) % Nothing else needs to be changed below this line. -% Copyright (C) 1987, 1993, 1996--1997, 2001--2023 Free Software +% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software % Foundation, Inc. % This document is free software: you can redistribute it and/or modify diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty index 284f4d74cc7..050dee2f9ca 100644 --- a/etc/refcards/pdflayout.sty +++ b/etc/refcards/pdflayout.sty @@ -1,4 +1,4 @@ -% Copyright (C) 2007-2023 Free Software Foundation, Inc. +% Copyright (C) 2007-2024 Free Software Foundation, Inc. % This file is part of GNU Emacs. diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex index 1fbdeab1be9..dabef6d91c8 100644 --- a/etc/refcards/pl-refcard.tex +++ b/etc/refcards/pl-refcard.tex @@ -1,7 +1,7 @@ %&mex % Reference Card for GNU Emacs -% Copyright (C) 1999, 2001--2023 Free Software Foundation, Inc. +% Copyright (C) 1999, 2001--2024 Free Software Foundation, Inc. % Author: Stephen Gildea % Polish translation: Włodek Bzyl diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex index 20f7e16d230..47064e7365d 100644 --- a/etc/refcards/pt-br-refcard.tex +++ b/etc/refcards/pt-br-refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -% Copyright (C) 1987, 1993, 1996--1997, 2002--2004, 2006--2023 Free +% Copyright (C) 1987, 1993, 1996--1997, 2002--2004, 2006--2024 Free % Software Foundation, Inc. % Author: Stephen Gildea diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index ac802fdc4c3..8e8ee846291 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -% Copyright (C) 1987, 1993, 1996--1997, 2001--2023 Free Software +% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software % Foundation, Inc. % Author: Stephen Gildea diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 3124ce4f7c7..96328cde1db 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -1,4 +1,4 @@ -% Copyright (C) 1997, 2002--2023 Free Software Foundation, Inc. +% Copyright (C) 1997, 2002--2024 Free Software Foundation, Inc. % Author: Stephen Gildea % Russian translation: Alex Ott diff --git a/etc/refcards/sk-dired-ref.tex b/etc/refcards/sk-dired-ref.tex index b353bd74404..cc15f3edf3b 100644 --- a/etc/refcards/sk-dired-ref.tex +++ b/etc/refcards/sk-dired-ref.tex @@ -1,6 +1,6 @@ % Reference Card for Dired -*- coding: utf-8 -*- -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Evgeny Roubinchtein % Czech translation: Pavel Janík , March 2001 diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex index fe3d352c5b4..30dc61e9bc5 100644 --- a/etc/refcards/sk-refcard.tex +++ b/etc/refcards/sk-refcard.tex @@ -1,6 +1,6 @@ % Reference Card for GNU Emacs -*- coding: utf-8 -*- -% Copyright (C) 1987, 1993, 1996--1997, 2001--2023 Free Software +% Copyright (C) 1987, 1993, 1996--1997, 2001--2024 Free Software % Foundation, Inc. % Author: Stephen Gildea diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex index f7a9ee20722..5adc16ef667 100644 --- a/etc/refcards/sk-survival.tex +++ b/etc/refcards/sk-survival.tex @@ -1,6 +1,6 @@ % Title: GNU Emacs Survival Card -*- coding: utf-8 -*- -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Włodek Bzyl % Czech translation: Pavel Janík , March 2001 diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex index cfa1be8b915..9f071b2aac3 100644 --- a/etc/refcards/survival.tex +++ b/etc/refcards/survival.tex @@ -1,7 +1,7 @@ %&tex % Title: GNU Emacs Survival Card -% Copyright (C) 2000--2023 Free Software Foundation, Inc. +% Copyright (C) 2000--2024 Free Software Foundation, Inc. % Author: Włodek Bzyl diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex index d780a8b1ae8..7e5e0bdcb74 100644 --- a/etc/refcards/vipcard.tex +++ b/etc/refcards/vipcard.tex @@ -1,6 +1,6 @@ % Quick Reference Card for VIP -% Copyright (C) 1987, 2001--2023 Free Software Foundation, Inc. +% Copyright (C) 1987, 2001--2024 Free Software Foundation, Inc. % Author: Masahiko Sato , diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex index 8376179be09..3675c024a98 100644 --- a/etc/refcards/viperCard.tex +++ b/etc/refcards/viperCard.tex @@ -1,6 +1,6 @@ % ViperCard -- The Reference Card for Viper under GNU Emacs -% Copyright (C) 1995--1997, 2001--2023 Free Software Foundation, Inc. +% Copyright (C) 1995--1997, 2001--2024 Free Software Foundation, Inc. % Author: Michael Kifer (Viper) % Aamod Sane (VIP 4.3) diff --git a/etc/schema/locate.rnc b/etc/schema/locate.rnc index 10addaeaa33..bb80aa186e3 100644 --- a/etc/schema/locate.rnc +++ b/etc/schema/locate.rnc @@ -1,4 +1,4 @@ -# Copyright (C) 2003-2004, 2007-2023 Free Software Foundation, Inc. +# Copyright (C) 2003-2004, 2007-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/etc/schema/relaxng.rnc b/etc/schema/relaxng.rnc index 7489dd58c40..451548ac260 100644 --- a/etc/schema/relaxng.rnc +++ b/etc/schema/relaxng.rnc @@ -1,6 +1,6 @@ # RELAX NG XML syntax expressed in RELAX NG Compact syntax. -# Copyright (C) 2003-2004, 2007-2023 Free Software Foundation, Inc. +# Copyright (C) 2003-2004, 2007-2024 Free Software Foundation, Inc. # This file is part of GNU Emacs. diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index 8ac208790bf..f04bba849b4 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -1,5 +1,5 @@ -