From 791024dc8cce36f7abe68c3991cf9f74dc37707c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 2 Jan 2026 19:06:48 +0100 Subject: [PATCH 001/325] Make string-trim faster * lisp/subr.el (string-trim): Avoid intermediate substring allocation. * test/lisp/subr-tests.el (subr-string-trim-left): (subr-string-trim-right): Move here from subr-x-tests.el. (subr-string-trim): New test. --- lisp/subr.el | 13 +++++++++++- test/lisp/emacs-lisp/subr-x-tests.el | 25 ----------------------- test/lisp/subr-tests.el | 30 ++++++++++++++++++++++++++++ 3 files changed, 42 insertions(+), 26 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 2b94cd11e74..4ae3647b7d4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7607,7 +7607,18 @@ REGEXP defaults to \"[ \\t\\n\\r]+\"." TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"." (declare (important-return-value t)) - (string-trim-left (string-trim-right string trim-right) trim-left)) + (let* ((beg (and (string-match (if trim-left + (concat "\\`\\(?:" trim-left "\\)") + "\\`[ \t\n\r]+") + string) + (match-end 0))) + (end (string-match-p (if trim-right + (concat "\\(?:" trim-right "\\)\\'") + "[ \t\n\r]+\\'") + string beg))) + (if (or beg end) + (substring string beg end) + string))) (let ((missing (make-symbol "missing"))) (defsubst hash-table-contains-p (key table) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index f3754d5d37f..cad4dcbb7aa 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -537,31 +537,6 @@ ;; Substring tests -(ert-deftest subr-x-test-string-trim-left () - "Test `string-trim-left' behavior." - (should (equal (string-trim-left "") "")) - (should (equal (string-trim-left " \t\n\r") "")) - (should (equal (string-trim-left " \t\n\ra") "a")) - (should (equal (string-trim-left "a \t\n\r") "a \t\n\r")) - (should (equal (string-trim-left "" "") "")) - (should (equal (string-trim-left "a" "") "a")) - (should (equal (string-trim-left "aa" "a*") "")) - (should (equal (string-trim-left "ba" "a*") "ba")) - (should (equal (string-trim-left "aa" "a*?") "aa")) - (should (equal (string-trim-left "aa" "a+?") "a"))) - -(ert-deftest subr-x-test-string-trim-right () - "Test `string-trim-right' behavior." - (should (equal (string-trim-right "") "")) - (should (equal (string-trim-right " \t\n\r") "")) - (should (equal (string-trim-right " \t\n\ra") " \t\n\ra")) - (should (equal (string-trim-right "a \t\n\r") "a")) - (should (equal (string-trim-right "" "") "")) - (should (equal (string-trim-right "a" "") "a")) - (should (equal (string-trim-right "aa" "a*") "")) - (should (equal (string-trim-right "ab" "a*") "ab")) - (should (equal (string-trim-right "aa" "a*?") ""))) - (ert-deftest subr-x-test-string-remove-prefix () "Test `string-remove-prefix' behavior." (should (equal (string-remove-prefix "" "") "")) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 7aabc6ce6c8..1a64cbff0a1 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1609,6 +1609,36 @@ final or penultimate step during initialization.")) '("A" "B" "C"))) ) +(ert-deftest subr-string-trim-left () + (should (equal (string-trim-left "") "")) + (should (equal (string-trim-left " \t\n\r") "")) + (should (equal (string-trim-left " \t\n\ra") "a")) + (should (equal (string-trim-left "a \t\n\r") "a \t\n\r")) + (should (equal (string-trim-left "" "") "")) + (should (equal (string-trim-left "a" "") "a")) + (should (equal (string-trim-left "aa" "a*") "")) + (should (equal (string-trim-left "ba" "a*") "ba")) + (should (equal (string-trim-left "aa" "a*?") "aa")) + (should (equal (string-trim-left "aa" "a+?") "a"))) + +(ert-deftest subr-string-trim-right () + (should (equal (string-trim-right "") "")) + (should (equal (string-trim-right " \t\n\r") "")) + (should (equal (string-trim-right " \t\n\ra") " \t\n\ra")) + (should (equal (string-trim-right "a \t\n\r") "a")) + (should (equal (string-trim-right "" "") "")) + (should (equal (string-trim-right "a" "") "a")) + (should (equal (string-trim-right "aa" "a*") "")) + (should (equal (string-trim-right "ab" "a*") "ab")) + (should (equal (string-trim-right "aa" "a*?") ""))) + +(ert-deftest subr-string-trim () + (should (equal (string-trim " \t\r abc\t\n \t") "abc")) + (should (equal (string-trim "::abc;;" nil nil) "::abc;;")) + (should (equal (string-trim "::abc;;" nil ";+") "::abc")) + (should (equal (string-trim "::abc;;" ":+" nil) "abc;;")) + (should (equal (string-trim "::abc;;" ":+" ";+") "abc"))) + (defun subr--identity (x) x) (ert-deftest subr-drop-while () From 99750f9fdff60110e8289b2ba975b10df62462bf Mon Sep 17 00:00:00 2001 From: Phil Sainty Date: Mon, 29 Dec 2025 21:53:00 +1300 Subject: [PATCH 002/325] Improve documentation for tab-bar buffer display actions (bug#80092) * doc/lispref/windows.texi: Document the display actions `display-buffer-in-tab' and `display-buffer-in-new-tab' and the associated alist entries `tab-name' and `tab-group'. * lisp/tab-bar.el (display-buffer-in-tab): Restructure docstring for clarity. Describe the `reusable-frames' behaviour first (as if it finds a frame with a suitable tab then the `tab-name' entry is not used). (display-buffer-in-new-tab): Use consistent wording. * lisp/window.el (display-buffer--action-function-custom-type): Add the display actions as customize choices for user options. (display-buffer): Document the display actions and alist entries. --- doc/lispref/windows.texi | 81 ++++++++++++++++++++++++++++++++++++++++ lisp/tab-bar.el | 65 +++++++++++++++++++------------- lisp/window.el | 8 ++++ 3 files changed, 128 insertions(+), 26 deletions(-) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index c659ec8edc8..dd0d925ed7e 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3549,6 +3549,70 @@ the selected window is not used; thus if the selected frame has a single window, it is not used. @end defun +@defun display-buffer-in-new-tab buffer alist +This function tries to display @var{buffer} in a new tab. + +If @var{alist} contains a non-@code{nil} @code{tab-name} entry (which +may be a string or a function), the buffer is displayed in a new tab +with that name. If the @code{tab-name} entry is a function, it is +called with two arguments (@var{buffer} and @var{alist}), and should +return the tab name. + +If the @code{tab-name} entry is omitted or @code{nil}, a new tab is +created without an explicit name. + +If @var{alist} contains a non-@code{nil} @code{tab-group} entry, this +defines the tab group, overriding user option +@code{tab-bar-new-tab-group}. This entry may again be a string or a +function which is called in the same manner as @code{tab-name}. +@end defun + +@defun display-buffer-in-tab buffer alist +This function tries to display @var{buffer} in a new or existing tab. + +If @var{alist} contains a non-@code{nil} @code{reusable-frames} entry +then the frames indicated by its value are searched for an existing tab +which already displays the buffer. The possible values of +@code{reusable-frames} are: + +@itemize @bullet +@item @code{t} +means consider all existing frames. +@item @code{visible} +means consider all visible frames. +@item A frame +means consider that frame only. +@item Any other non-@code{nil} value +means consider the selected frame. +@item @code{nil} +means do not search any frames (equivalent to omitting the entry). Note +that this is different to the typical meaning of the value @code{nil} +for a @code{reusable-frames} entry in a buffer display action alist. +@end itemize + +If @var{alist} contains a non-@code{nil} @code{ignore-current-tab} +entry, then the current tab is skipped when searching for a reusable +tab. Otherwise the current tab is used by preference if it already +displays the buffer. + +If a window displaying the buffer is located in any reusable tab then +that tab and window are selected. + +If no such window is located, the buffer is displayed in a new or +existing tab based on the @var{alist} entry @code{tab-name} (which may +be a string or a function). If a tab with this name already exists then +that tab is selected, otherwise a new tab with that name is created. If +the @code{tab-name} entry is a function, it is called with two arguments +(@var{buffer} and @var{alist}), and should return the tab name. If the +@code{tab-name} entry is omitted or @code{nil}, a new tab is created +without an explicit name. + +If a new tab is created and @var{alist} contains a non-@code{nil} +@code{tab-group} entry, this defines the tab group, overriding user +option @code{tab-bar-new-tab-group}. This entry may again be a string +or a function which is called in the same manner as @code{tab-name}. +@end defun + @defun display-buffer-no-window buffer alist If @var{alist} has a non-@code{nil} @code{allow-no-window} entry, then this function does not display @var{buffer} and returns the symbol @@ -3661,6 +3725,10 @@ well. @code{display-buffer-in-previous-window} consults it when searching for a window that previously displayed the buffer on another frame. +Action function @code{display-buffer-in-tab} searches the tabs of the +frame(s) identified by this entry, and also interprets the value +@code{nil} differently. + @vindex inhibit-switch-frame@r{, a buffer display action alist entry} @item inhibit-switch-frame A non-@code{nil} value prevents another frame from being raised or @@ -3981,6 +4049,19 @@ List, @code{buffer-match-p}}. Thus, if a Lisp program uses a particular @var{symbol} as the category when calling @code{display-buffer}, users can customize how these buffers will be displayed by including such an entry in @code{display-buffer-alist}. + +@vindex tab-name@r{, a buffer display action alist entry} +@item tab-name +The value names the tab in which the buffer should be displayed. This +entry is used by @code{display-buffer-in-new-tab} and (conditionally) by +@code{display-buffer-in-tab}. + +@vindex tab-group@r{, a buffer display action alist entry} +@vindex tab-bar-new-tab-group@r{, override for buffer display actions} +@item tab-group +The value names the tab group to use when creating a new tab, overriding +user option @code{tab-bar-new-tab-group}. This entry is used by +@code{display-buffer-in-new-tab} and @code{display-buffer-in-tab}. @end table By convention, the entries @code{window-height}, @code{window-width} diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 680edae95f1..5c63de5e39f 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2935,27 +2935,39 @@ ALIST is an association list of action symbols and values. See Info node `(elisp) Buffer Display Action Alists' for details of such alists. -If ALIST contains a `tab-name' entry, it creates a new tab with that name and -displays BUFFER in a new tab. If a tab with this name already exists, it -switches to that tab before displaying BUFFER. The `tab-name' entry can be -a function, in which case it is called with two arguments: BUFFER and ALIST, -and should return the tab name. When a `tab-name' entry is omitted, create -a new tab without an explicit name. +If ALIST contains a non-nil `reusable-frames' entry then the frames +indicated by its value are searched for an existing tab which already +displays BUFFER. The possible values of `reusable-frames' are: -The ALIST entry `tab-group' (string or function) defines the tab group. - -If ALIST contains a `reusable-frames' entry, its value determines -which frames to search for a reusable tab: - nil -- do not reuse any frames; - a frame -- just that frame; + t -- all existing frames; `visible' -- all visible frames; - 0 -- all frames on the current terminal; - t -- all frames; - other non-nil values -- use the selected frame. + A frame -- that frame only; + Any other non-nil value -- the selected frame; + nil -- do not search any frames (equivalent to omitting the entry). -If ALIST contains a non-nil `ignore-current-tab' entry, then the buffers -of the current tab are skipped when searching for a reusable tab. -Otherwise, prefer buffers of the current tab. +\(Note that the meaning of nil is different to the typical meaning of +nil for a `reusable-frames' entry in a buffer display action alist.) + +If ALIST contains a non-nil `ignore-current-tab' entry then skip the +current tab when searching for a reusable tab, otherwise prefer the +current tab if it already displays BUFFER. + +If a window displaying BUFFER is located in any reusable tab, select +that tab and window. + +If no such window is located, display BUFFER in a new or existing tab +based on the ALIST entry `tab-name' (string or function). If a tab with +this name already exists then select that tab, otherwise create a new +tab with this name. If `tab-name' is a function it is called with two +arguments (BUFFER and ALIST) and should return the tab name. If +`tab-name' is omitted or nil, create a new tab without an explicit name. + +If a new tab is created and ALIST contains a non-nil `tab-group' entry +\(string or function), this defines the tab group, overriding user +option `tab-bar-new-tab-group'. + +To create a new tab unconditionally, use `display-buffer-in-new-tab' +instead. This is an action function for buffer display, see Info node `(elisp) Buffer Display Action Functions'. It should be @@ -2994,16 +3006,17 @@ ALIST is an association list of action symbols and values. See Info node `(elisp) Buffer Display Action Alists' for details of such alists. -Like `display-buffer-in-tab', but always creates a new tab unconditionally, -without checking if a suitable tab already exists. +If ALIST contains a non-nil `tab-name' entry (string or function) then +display BUFFER in a new tab with this name. If `tab-name' is a function +it is called with two arguments (BUFFER and ALIST) and should return the +tab name. If `tab-name' is omitted or nil, create a new tab without an +explicit name. -If ALIST contains a `tab-name' entry, it creates a new tab with that name -and displays BUFFER in a new tab. The `tab-name' entry can be a function, -in which case it is called with two arguments: BUFFER and ALIST, and should -return the tab name. When a `tab-name' entry is omitted, create a new tab -without an explicit name. +If ALIST contains a non-nil `tab-group' entry (string or function), this +defines the tab group, overriding user option `tab-bar-new-tab-group'. -The ALIST entry `tab-group' (string or function) defines the tab group. +To check for a suitable existing tab to reuse before creating a new tab, +use `display-buffer-in-tab' instead. This is an action function for buffer display, see Info node `(elisp) Buffer Display Action Functions'. It should be diff --git a/lisp/window.el b/lisp/window.el index 6b08706b9ac..df404083b32 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7999,6 +7999,8 @@ See the info node `(elisp)Dedicated Windows' for more details." (const display-buffer-use-least-recent-window) (const display-buffer-use-some-window) (const display-buffer-use-some-frame) + (const display-buffer-in-tab) + (const display-buffer-in-new-tab) (function :tag "Other function")) "Custom type for `display-buffer' action functions.") @@ -8147,6 +8149,8 @@ to an expression containing one of these \"action\" functions: `display-buffer-pop-up-frame' -- Show the buffer on a new frame. `display-buffer-in-child-frame' -- Show the buffer in a child frame. + `display-buffer-in-tab' -- Use an appropriate existing tab or a new tab. + `display-buffer-in-new-tab' -- Use a new tab. `display-buffer-no-window' -- Do not display the buffer and have `display-buffer' return nil immediately. @@ -8310,6 +8314,10 @@ Action alist entries are: `(category . symbol)' in its action argument, then you can match the displayed buffer by using the same category in the condition part of `display-buffer-alist' entries. + ‘tab-name’ -- If non-nil, specifies the name of the tab in which to + display the buffer; see `display-buffer-in-new-tab'. + \\+‘tab-group’ -- If non-nil, specifies the tab group to use when creating + a new tab; see ‘display-buffer-in-new-tab’. The entries `window-height', `window-width', `window-size' and `preserve-size' are applied only when the window used for From bb43055ef08049fa3a1694b7769adbade762c17d Mon Sep 17 00:00:00 2001 From: Phil Sainty Date: Thu, 1 Jan 2026 21:28:59 +1300 Subject: [PATCH 003/325] Support the `reusable-frames' value 0 for `display-buffer-in-tab' * lisp/tab-bar.el (tab-bar--reusable-frames): Implement support for the `reusable-frames' value 0, for better consistency with other buffer display actions. (bug#80092) --- doc/lispref/windows.texi | 2 ++ lisp/tab-bar.el | 15 +++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index dd0d925ed7e..09d58c17c01 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -3580,6 +3580,8 @@ which already displays the buffer. The possible values of means consider all existing frames. @item @code{visible} means consider all visible frames. +@item 0 +means consider all frames on the current terminal. @item A frame means consider that frame only. @item Any other non-@code{nil} value diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 5c63de5e39f..f9df4110757 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -2865,9 +2865,20 @@ with those specified by the selected window configuration." (defun tab-bar--reusable-frames (all-frames) + "Process the `reusable-frames' buffer display action alist entry. +Return a frame list. Used with the `display-buffer-in-tab' action." (cond ((eq all-frames t) (frame-list)) ((eq all-frames 'visible) (visible-frame-list)) + ;; The standard behavior for a `reusable-frames' value of 0 is implemented in + ;; candidate_window_p() in window.c, and we have to go via `window-list-1' to + ;; utilize this. We list the selected frame first. + ((eq all-frames 0) (let (frames) + (dolist (w (window-list-1 nil nil 0)) + (let ((f (window-frame w))) + (unless (memq f frames) + (push f frames)))) + (nreverse frames))) ((framep all-frames) (list all-frames)) (t (list (selected-frame))))) @@ -2883,6 +2894,9 @@ The optional argument ALL-FRAMES specifies the frames to consider: - `visible' means consider all tabs on all visible frames. +- 0 (the number zero) means consider all tabs on all visible and + iconified frames. + - A frame means consider all tabs on that frame only. - Any other value of ALL-FRAMES means consider all tabs on the @@ -2941,6 +2955,7 @@ displays BUFFER. The possible values of `reusable-frames' are: t -- all existing frames; `visible' -- all visible frames; + 0 -- all frames on the current terminal; A frame -- that frame only; Any other non-nil value -- the selected frame; nil -- do not search any frames (equivalent to omitting the entry). From be9371cde31fd2cc58f6469ac8cbaeb3cf31ebee Mon Sep 17 00:00:00 2001 From: Phil Sainty Date: Thu, 1 Jan 2026 23:52:09 +1300 Subject: [PATCH 004/325] Document more display actions in `display-buffer' (bug#80092) * lisp/window.el (display-buffer): Add docs for several missing actions: - display-buffer-in-atom-window - display-buffer-in-direction - display-buffer-in-side-window - display-buffer-reuse-mode-window - display-buffer-use-some-frame Re-arrange the actions into a less-arbitrary sequence. Re-word some descriptions to use a more consistent phrasing. Re-wrap some lines (based on the longest pre-existing line), to reduce the line count. Un-link the `pop-up-frames' symbol in the alist entry listing. (display-buffer--action-function-custom-type): Add missing actions, and re-order as above. (display-buffer-reuse-mode-window): Tweak the docstring for better consistency with other display actions. --- lisp/window.el | 59 ++++++++++++++++++++++++++++++-------------------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/lisp/window.el b/lisp/window.el index df404083b32..3526873c8d9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7987,20 +7987,25 @@ See the info node `(elisp)Dedicated Windows' for more details." (defconst display-buffer--action-function-custom-type '(choice :tag "Function" (const :tag "--" ignore) ; default for insertion - (const display-buffer-reuse-window) - (const display-buffer-pop-up-window) (const display-buffer-same-window) + (const display-buffer-reuse-window) + (const display-buffer-in-previous-window) + (const display-buffer-reuse-mode-window) + (const display-buffer-use-some-window) + (const display-buffer-use-least-recent-window) + (const display-buffer-pop-up-window) (const display-buffer-pop-up-frame) (const display-buffer-full-frame) + (const display-buffer-use-some-frame) (const display-buffer-in-child-frame) + (const display-buffer-in-side-window) + (const display-buffer-in-atom-window) (const display-buffer-below-selected) (const display-buffer-at-bottom) - (const display-buffer-in-previous-window) - (const display-buffer-use-least-recent-window) - (const display-buffer-use-some-window) - (const display-buffer-use-some-frame) + (const display-buffer-in-direction) (const display-buffer-in-tab) (const display-buffer-in-new-tab) + (const display-buffer-no-window) (function :tag "Other function")) "Custom type for `display-buffer' action functions.") @@ -8133,22 +8138,26 @@ To change which window is used, set `display-buffer-alist' to an expression containing one of these \"action\" functions: `display-buffer-same-window' -- Use the selected window. - `display-buffer-reuse-window' -- Use a window already showing - the buffer. - `display-buffer-in-previous-window' -- Use a window that did - show the buffer before. + `display-buffer-reuse-window' -- Use a window already showing the buffer. + `display-buffer-in-previous-window' -- Use a window that has previously + displayed the buffer. + `display-buffer-reuse-mode-window' -- Use a window currently showing a + buffer with the required major mode. `display-buffer-use-some-window' -- Use some existing window. - `display-buffer-use-least-recent-window' -- Try to avoid reusing - windows that have recently been switched to. + `display-buffer-use-least-recent-window' -- Try to avoid reusing windows + that have recently been switched to. `display-buffer-pop-up-window' -- Pop up a new window. + `display-buffer-pop-up-frame' -- Use a new frame. `display-buffer-full-frame' -- Delete other windows and use the full frame. - `display-buffer-below-selected' -- Use or pop up a window below - the selected one. - `display-buffer-at-bottom' -- Use or pop up a window at the - bottom of the selected frame. - `display-buffer-pop-up-frame' -- Show the buffer on a new frame. - `display-buffer-in-child-frame' -- Show the buffer in a - child frame. + `display-buffer-use-some-frame' -- Use a frame meeting a predicate. + `display-buffer-in-child-frame' -- Use a child frame of the selected frame. + `display-buffer-in-side-window' -- Use a side window of the selected frame. + `display-buffer-in-atom-window' -- Use an atomic window. + `display-buffer-below-selected' -- Use or pop up a window below the + selected one. + `display-buffer-at-bottom' -- Use or pop up a window at the bottom of the + selected frame. + `display-buffer-in-direction' -- Use a window in a specified direction. `display-buffer-in-tab' -- Use an appropriate existing tab or a new tab. `display-buffer-in-new-tab' -- Use a new tab. `display-buffer-no-window' -- Do not display the buffer and @@ -8212,7 +8221,7 @@ Action alist entries are: Possible values are nil (the selected frame), t (any live frame), visible (any visible frame), 0 (any visible or iconified frame) or an existing live frame. - `pop-up-frames' -- Same effect as the eponymous variable. + \\+`pop-up-frames' -- Same effect as the eponymous variable. Takes precedence over the variable. `pop-up-frame-parameters' -- The value specifies an alist of frame parameters to give a new frame, if one is created. @@ -8311,9 +8320,9 @@ Action alist entries are: selected regardless of which windows were selected afterwards within this command. `category' -- If the caller of `display-buffer' passes an alist entry - `(category . symbol)' in its action argument, then you can match - the displayed buffer by using the same category in the condition - part of `display-buffer-alist' entries. + `(category . symbol)' in its action argument, then you can match + the displayed buffer by using the same category in the condition + part of `display-buffer-alist' entries. ‘tab-name’ -- If non-nil, specifies the name of the tab in which to display the buffer; see `display-buffer-in-new-tab'. \\+‘tab-group’ -- If non-nil, specifies the tab group to use when creating @@ -8569,7 +8578,9 @@ indirectly called by the latter." (window--maybe-raise-frame (window-frame window))))))) (defun display-buffer-reuse-mode-window (buffer alist) - "Return a window based on the mode of the buffer it displays. + "Display BUFFER in a window with a buffer of the required major mode. + +Return a window based on the major mode of the buffer it displays. Display BUFFER in the returned window. Return nil if no usable window is found. From dc26b0992ab8a294ea632dde8e2ce8904f599911 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 3 Jan 2026 09:23:49 +0100 Subject: [PATCH 005/325] Set `lexical-binding' buffer-local in shadowfile.el * lisp/shadowfile.el (shadow-read-files): Enable `lisp-data-mode'. Set `lexical-binding' cookie. (Bug#80086) --- lisp/shadowfile.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 86d5ce1e383..7fd7dc94ad0 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -683,6 +683,8 @@ Return t unless files were locked; then return nil." (when shadow-info-file (set-buffer (setq shadow-info-buffer (find-file-noselect shadow-info-file 'nowarn))) + (lisp-data-mode) + (setq-local lexical-binding t) (when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-info-file)) @@ -694,6 +696,8 @@ Return t unless files were locked; then return nil." (when shadow-todo-file (set-buffer (setq shadow-todo-buffer (find-file-noselect shadow-todo-file 'nowarn))) + (lisp-data-mode) + (setq-local lexical-binding t) (when (and (not (buffer-modified-p)) (file-newer-than-file-p (make-auto-save-file-name) shadow-todo-file)) From 4606510f6540cbc03624779e4673eacf9df07a37 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 3 Jan 2026 09:24:29 +0100 Subject: [PATCH 006/325] ; * src/lread.c (Feval_buffer): Fix typo in docstring. --- src/lread.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lread.c b/src/lread.c index 6970b382e4e..85c0c107e53 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2381,7 +2381,7 @@ variable and any -*- lexical-binding: t -*- settings in the buffer; if there is no such setting, and the buffer-local value of the variable is nil, the buffer will be -evaluated with the value of `lexical binding' equal to its +evaluated with the value of `lexical-binding' equal to its top-level default value, as returned by `default-toplevel-value'. This function preserves the position of point. */) From 51498a88cf984a6cd82ab4838eb28f8ad6e5cf44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Sat, 3 Jan 2026 09:28:03 +0100 Subject: [PATCH 007/325] Add frame parameters 'cloned-from' and 'undeleted' (bug#80104) * lisp/frame.el (clone-frame): Set the frame parameter 'cloned-from'. (undelete-frame): Set the frame parameter 'undeleted'. * src/frame.c (syms_of_frame): : New DEFSYM. (syms_of_frame): Add 'Qcloned_from' and 'Qundeleted' to 'frame_internal_parameters'. * doc/lispref/frames.texi: Document these frame parameters. * etc/NEWS: Announce the new frame parameters. --- doc/lispref/frames.texi | 17 ++++++++++++++++- etc/NEWS | 12 ++++++++++++ lisp/frame.el | 11 +++++++---- src/frame.c | 4 ++++ 4 files changed, 39 insertions(+), 5 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 8b2a493a5e1..303c047023b 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -198,6 +198,11 @@ A normal hook run by @code{make-frame} before it creates the frame. An abnormal hook run by @code{make-frame} after it created the frame. Each function in @code{after-make-frame-functions} receives one argument, the frame just created. + +You can consult the frame parameters @code{cloned-from} and +@code{undeleted} in your function to determine if a frame was cloned +using @command{clone-frame}, or if it was undeleted using +@command{undelete-frame}. @xref{Frame Parameters}. @end defvar Note that any functions added to these hooks by your initial file are @@ -2206,8 +2211,18 @@ left position ratio is preserved if the @sc{cdr} of the cell is either @code{t} or @code{left-only}. The top position ratio is preserved if the @sc{cdr} of the cell is either @code{t} or @code{top-only}. This parameter has not been yet implemented on text terminals. -@end table +@vindex cloned-from@r{, a frame parameter} +@item cloned-from +The original frame if this frame was made via @code{clone-frame} +(@pxref{Creating Frames,,,emacs, the Emacs Manual}). + +@vindex undeleted@r{, a frame parameter} +@item undeleted +This is non-@code{nil} if this frame was undeleted using the command +@command{undelete-frame} (@pxref{Frame Commands,,,emacs, the Emacs +Manual}). +@end table @node Mouse Dragging Parameters @subsubsection Mouse Dragging Parameters diff --git a/etc/NEWS b/etc/NEWS index bd60249708c..321ce929cb0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -482,6 +482,18 @@ frames into one of these frames and deletes the other one. Unlike with other frame names, an attempt to rename to "F" throws an error when a frame of that name already exists. ++++ +*** New frame parameters 'cloned-from' and 'undeleted'. +The frame parameter 'cloned-from' is set to the frame from which the new +frame is cloned using the command 'clone-frame'. + +The frame parameter 'undeleted is set to t when a frame is undeleted +using the command 'undelete-frame'. + +These are useful if you need to detect a cloned frame or undeleted frame +in hooks like 'after-make-frame-functions' and +'server-after-make-frame-hook'. + ** Mode Line +++ diff --git a/lisp/frame.el b/lisp/frame.el index 071e121246b..b9e47175f66 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -957,9 +957,10 @@ also select the new frame." (windows (unless no-windows (window-state-get (frame-root-window frame)))) (default-frame-alist - (seq-remove (lambda (elem) - (memq (car elem) frame-internal-parameters)) - (frame-parameters frame))) + (append `((cloned-from . ,frame)) + (seq-remove (lambda (elem) + (memq (car elem) frame-internal-parameters)) + (frame-parameters frame)))) new-frame) (when (and frame-resize-pixelwise (display-graphic-p frame)) @@ -3169,7 +3170,9 @@ When called from Lisp, returns the new frame." (if graphic "graphic" "non-graphic")) (setq undelete-frame--deleted-frames (delq frame-data undelete-frame--deleted-frames)) - (let* ((default-frame-alist (nth 1 frame-data)) + (let* ((default-frame-alist + (append `((undeleted . t)) + (nth 1 frame-data))) (frame (make-frame))) (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe) (select-frame-set-input-focus frame) diff --git a/src/frame.c b/src/frame.c index 8d478de7268..ec227ce276d 100644 --- a/src/frame.c +++ b/src/frame.c @@ -7196,6 +7196,8 @@ syms_of_frame (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qforce, "force"); DEFSYM (Qinhibit, "inhibit"); + DEFSYM (Qcloned_from, "cloned-from"); + DEFSYM (Qundeleted, "undeleted"); for (int i = 0; i < ARRAYELTS (frame_parms); i++) { @@ -7580,6 +7582,8 @@ allow `make-frame' to show the current buffer even if its hidden. */); #else frame_internal_parameters = list3 (Qname, Qparent_id, Qwindow_id); #endif + frame_internal_parameters = Fcons (Qcloned_from, frame_internal_parameters); + frame_internal_parameters = Fcons (Qundeleted, frame_internal_parameters); DEFVAR_LISP ("alter-fullscreen-frames", alter_fullscreen_frames, doc: /* How to handle requests to resize fullscreen frames. From 16d27cce553b142f7e5737cd5a1f2b9db217c24b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 11:13:46 +0200 Subject: [PATCH 008/325] ; * lisp/window.el (display-buffer): Fix quotation. --- lisp/window.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/window.el b/lisp/window.el index 3526873c8d9..b6c6c34983e 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -8323,10 +8323,10 @@ Action alist entries are: `(category . symbol)' in its action argument, then you can match the displayed buffer by using the same category in the condition part of `display-buffer-alist' entries. - ‘tab-name’ -- If non-nil, specifies the name of the tab in which to + `tab-name' -- If non-nil, specifies the name of the tab in which to display the buffer; see `display-buffer-in-new-tab'. - \\+‘tab-group’ -- If non-nil, specifies the tab group to use when creating - a new tab; see ‘display-buffer-in-new-tab’. + \\+`tab-group' -- If non-nil, specifies the tab group to use when creating + a new tab; see `display-buffer-in-new-tab'. The entries `window-height', `window-width', `window-size' and `preserve-size' are applied only when the window used for From e5a6b2e2629a2dc7a6c8d9cddf07ea9d0d965a7c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 11:26:56 +0200 Subject: [PATCH 009/325] ; Update CTAGS.good_update in etags tests for copyright year change. --- test/manual/etags/CTAGS.good_update | 32 ++++++++++++++--------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/test/manual/etags/CTAGS.good_update b/test/manual/etags/CTAGS.good_update index 22f7a4421e3..2e29a2cb93e 100644 --- a/test/manual/etags/CTAGS.good_update +++ b/test/manual/etags/CTAGS.good_update @@ -607,7 +607,7 @@ FOR_EACH_ALIST_VALUE c-src/emacs/src/lisp.h /^#define FOR_EACH_ALIST_VALUE(head_ FOR_EACH_TAIL c-src/emacs/src/lisp.h /^#define FOR_EACH_TAIL(hare, list, tortoise, n) \\$/ FRAMEP c-src/emacs/src/lisp.h /^FRAMEP (Lisp_Object a)$/ FRC make-src/Makefile /^FRC:;$/ -FREEFLOOD c-src/emacs/src/gmalloc.c 1863 +FREEFLOOD c-src/emacs/src/gmalloc.c 1866 FSRC make-src/Makefile /^FSRC=entry.for entry.strange_suffix entry.strange$/ FUN0 y-src/parse.y /^yylex FUN0()$/ FUN1 y-src/parse.y /^str_to_col FUN1(char **,str)$/ @@ -953,12 +953,12 @@ Lua_help c-src/etags.c 600 Lua_suffixes c-src/etags.c 598 M ruby-src/test1.ru /^module A::M; end$/ MAGENTA cp-src/screen.hpp 17 -MAGICBYTE c-src/emacs/src/gmalloc.c 1861 -MAGICFREE c-src/emacs/src/gmalloc.c 1860 -MAGICWORD c-src/emacs/src/gmalloc.c 1859 +MAGICBYTE c-src/emacs/src/gmalloc.c 1864 +MAGICFREE c-src/emacs/src/gmalloc.c 1863 +MAGICWORD c-src/emacs/src/gmalloc.c 1862 MAKE make-src/Makefile /^MAKE:=$(MAKE) --no-print-directory$/ MAKESRC make-src/Makefile /^MAKESRC=Makefile$/ -MALLOCFLOOD c-src/emacs/src/gmalloc.c 1862 +MALLOCFLOOD c-src/emacs/src/gmalloc.c 1865 MANY c-src/emacs/src/lisp.h 2833 MARKERP c-src/emacs/src/lisp.h /^# define MARKERP(x) lisp_h_MARKERP (x)$/ MAXPATHLEN c-src/etags.c 115 @@ -1734,7 +1734,7 @@ __malloc_extra_blocks c-src/emacs/src/gmalloc.c 382 __malloc_initialize c-src/emacs/src/gmalloc.c /^__malloc_initialize (void)$/ __malloc_initialized c-src/emacs/src/gmalloc.c 380 __repr__ pyt-src/server.py /^ def __repr__(self):$/ -__sbrk c-src/emacs/src/gmalloc.c 1516 +__sbrk c-src/emacs/src/gmalloc.c 1518 __str__ pyt-src/server.py /^ def __str__(self):$/ __up c.c 160 _aligned_blocks c-src/emacs/src/gmalloc.c 1006 @@ -1869,7 +1869,7 @@ align c-src/emacs/src/gmalloc.c /^align (size_t size)$/ alignas c-src/emacs/src/lisp.h /^# define alignas(alignment) \/* empty *\/$/ aligned c-src/emacs/src/gmalloc.c 199 aligned_alloc c-src/emacs/src/gmalloc.c /^aligned_alloc (size_t alignment, size_t size)$/ -aligned_alloc c-src/emacs/src/gmalloc.c 1722 +aligned_alloc c-src/emacs/src/gmalloc.c 1725 aligned_alloc c-src/emacs/src/gmalloc.c 71 alignlist c-src/emacs/src/gmalloc.c 196 alive cp-src/conway.hpp 7 @@ -2073,7 +2073,7 @@ cacheLRUEntry_s c.c 172 cacheLRUEntry_t c.c 177 calculate_goal_info merc-src/accumulator.m /^:- pred calculate_goal_info(hlds_goal_expr::in, hl/ calloc c-src/emacs/src/gmalloc.c /^calloc (size_t nmemb, size_t size)$/ -calloc c-src/emacs/src/gmalloc.c 1721 +calloc c-src/emacs/src/gmalloc.c 1724 calloc c-src/emacs/src/gmalloc.c 66 calloc c-src/emacs/src/gmalloc.c 70 can_be_null c-src/emacs/src/regex.h 370 @@ -2703,7 +2703,7 @@ frag c-src/emacs/src/gmalloc.c 152 frame_local c-src/emacs/src/lisp.h 2341 free c-src/emacs/src/gmalloc.c /^free (void *ptr)$/ free c-src/emacs/src/gmalloc.c 166 -free c-src/emacs/src/gmalloc.c 1723 +free c-src/emacs/src/gmalloc.c 1726 free c-src/emacs/src/gmalloc.c 67 free c-src/emacs/src/gmalloc.c 72 free_fdesc c-src/etags.c /^free_fdesc (register fdesc *fdp)$/ @@ -2814,7 +2814,7 @@ hash_table_test c-src/emacs/src/lisp.h 1805 hashfn c-src/emacs/src/lisp.h /^ EMACS_UINT (*hashfn) (struct hash_table_test *t,/ hat tex-src/texinfo.tex /^\\def\\hat{\\realbackslash hat}$/ hat tex-src/texinfo.tex /^\\def\\hat{\\realbackslash hat}%$/ -hdr c-src/emacs/src/gmalloc.c 1865 +hdr c-src/emacs/src/gmalloc.c 1868 head_table c-src/emacs/src/keyboard.c 11027 header c-src/emacs/src/lisp.h 1371 header c-src/emacs/src/lisp.h 1388 @@ -3244,7 +3244,7 @@ mach_task_self c-src/machsyscalls.h /^SYSCALL (mach_task_self, -28,$/ mach_thread_self c-src/machsyscalls.h /^SYSCALL (mach_thread_self, -27,$/ macheader tex-src/texinfo.tex /^\\def\\defmac{\\defparsebody\\Edefmac\\defmacx\\defmache/ macx\defmacheader tex-src/texinfo.tex /^\\def\\defmac{\\defparsebody\\Edefmac\\defmacx\\defmache/ -magic c-src/emacs/src/gmalloc.c 1868 +magic c-src/emacs/src/gmalloc.c 1871 mainmagstep tex-src/texinfo.tex /^\\let\\mainmagstep=\\magstep1$/ mainmagstep tex-src/texinfo.tex /^\\let\\mainmagstep=\\magstephalf$/ maintaining.info make-src/Makefile /^maintaining.info: maintaining.texi$/ @@ -3272,7 +3272,7 @@ make_uninit_sub_char_table c-src/emacs/src/lisp.h /^make_uninit_sub_char_table ( make_uninit_vector c-src/emacs/src/lisp.h /^make_uninit_vector (ptrdiff_t size)$/ malloc c-src/emacs/src/gmalloc.c /^extern void *malloc (size_t size) ATTRIBUTE_MALLOC/ malloc c-src/emacs/src/gmalloc.c /^malloc (size_t size)$/ -malloc c-src/emacs/src/gmalloc.c 1719 +malloc c-src/emacs/src/gmalloc.c 1722 malloc c-src/emacs/src/gmalloc.c 64 malloc c-src/emacs/src/gmalloc.c 68 malloc_atfork_handler_child c-src/emacs/src/gmalloc.c /^malloc_atfork_handler_child (void)$/ @@ -3305,7 +3305,7 @@ maybe_gc c-src/emacs/src/lisp.h /^maybe_gc (void)$/ mcCSC cp-src/c.C 6 mcheck c-src/emacs/src/gmalloc.c /^mcheck (void (*func) (enum mcheck_status))$/ mcheck_status c-src/emacs/src/gmalloc.c 283 -mcheck_used c-src/emacs/src/gmalloc.c 2017 +mcheck_used c-src/emacs/src/gmalloc.c 2020 mdbcomp merc-src/accumulator.m /^:- import_module mdbcomp.$/ me22b lua-src/test.lua /^ local function test.me22b (one)$/ me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/ @@ -3639,7 +3639,7 @@ pagealignmacro tex-src/texinfo.tex /^\\global\\let\\pagealignmacro=\\chappager$/ pagealignmacro tex-src/texinfo.tex /^\\global\\let\\pagealignmacro=\\chappager}$/ pagebody tex-src/texinfo.tex /^\\def\\pagebody#1{\\vbox to\\pageheight{\\boxmaxdepth=\\/ pagecontents tex-src/texinfo.tex /^\\gdef\\pagecontents#1{\\ifvoid\\topins\\else\\unvbox\\to/ -pagesize c-src/emacs/src/gmalloc.c 1707 +pagesize c-src/emacs/src/gmalloc.c 1710 pagesofar tex-src/texinfo.tex /^\\def\\pagesofar{\\unvbox\\partialpage %$/ pair merc-src/accumulator.m /^:- import_module pair.$/ par tex-src/texinfo.tex /^\\let\\par=\\lisppar$/ @@ -3854,7 +3854,7 @@ readauxfile tex-src/texinfo.tex /^\\def\\readauxfile{%$/ readline c-src/etags.c /^readline (linebuffer *lbp, FILE *stream)$/ readline_internal c-src/etags.c /^readline_internal (linebuffer *lbp, register FILE / realloc c-src/emacs/src/gmalloc.c /^realloc (void *ptr, size_t size)$/ -realloc c-src/emacs/src/gmalloc.c 1720 +realloc c-src/emacs/src/gmalloc.c 1723 realloc c-src/emacs/src/gmalloc.c 65 realloc c-src/emacs/src/gmalloc.c 69 reallochook c-src/emacs/src/gmalloc.c /^reallochook (void *ptr, size_t size)$/ @@ -4078,7 +4078,7 @@ site cp-src/conway.hpp /^ site(int xi, int yi): x(xi), y(yi), alive(0) {/ site cp-src/conway.hpp 5 size c-src/emacs/src/gmalloc.c 156 size c-src/emacs/src/gmalloc.c 163 -size c-src/emacs/src/gmalloc.c 1867 +size c-src/emacs/src/gmalloc.c 1870 size c-src/emacs/src/lisp.h 1364 size c-src/emacs/src/lisp.h 1390 size c-src/etags.c 236 From 4f2a8d81f8e738daff3bddf5dd330abf23ed02ca Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 11:30:45 +0200 Subject: [PATCH 010/325] ; * test/manual/etags/README: Update the procedure for CTAGS.good_update. --- test/manual/etags/README | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/manual/etags/README b/test/manual/etags/README index f198e584da3..8493794c01c 100644 --- a/test/manual/etags/README +++ b/test/manual/etags/README @@ -51,7 +51,9 @@ corresponding "good" files, one by one. Like this: $ cp ETAGS ETAGS.good_7 $ make check $ cp CTAGS CTAGS.good - $ make check + $ head -n 100 CTAGS.good_update > CTAGS + $ tail -n 100 CTAGS.good_update >> CTAGS + $ ../../../lib-src/etags --ctags -o CTAGS -u - < srclist $ cp CTAGS CTAGS.good_update $ make check $ cp CTAGS CTAGS.good_crlf From f683e7c070c5dce043926c5c54186861e1da9ed0 Mon Sep 17 00:00:00 2001 From: kobarity Date: Sun, 7 Dec 2025 22:19:39 +0900 Subject: [PATCH 011/325] Improve python-shell-completion-get-completions In 'python-shell-completion-get-completions', since output from the inferior Python is expected to be in JSON format, commands being echoed back or warning messages being output caused parsing errors. We improved this by re-parsing only the last line when a parsing error occurs, preventing echo-back or warning messages from affecting parsing. * lisp/progmodes/python.el (python-shell-completion-get-completions): Improved to re-parse only the last line when a JSON parse error occurs. (Bug#79723) --- lisp/progmodes/python.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 1161edfcc32..212a5e1521c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4837,12 +4837,17 @@ With argument MSG show activation/deactivation message." (defun python-shell-completion-get-completions (process input) "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) - (python--parse-json-array - (python-shell-send-string-no-output - (format "%s\nprint(__PYTHON_EL_get_completions(%s))" - python-shell-completion-setup-code - (python-shell--encode-string input)) - process)))) + (let ((completions + (python-shell-send-string-no-output + (format "%s\nprint(__PYTHON_EL_get_completions(%s))" + python-shell-completion-setup-code + (python-shell--encode-string input)) + process))) + (condition-case nil + (python--parse-json-array completions) + (json-parse-error + (python--parse-json-array + (car (last (split-string completions "[\n\r]+" t))))))))) (defun python-shell--get-multiline-input () "Return lines at a multi-line input in Python shell." From 4c24c0f3d3fbeebf0849f78c83d6f19415b1addd Mon Sep 17 00:00:00 2001 From: kobarity Date: Sat, 13 Dec 2025 00:06:39 +0900 Subject: [PATCH 012/325] Do not use codecs.open for Python 3 * lisp/progmodes/python.el (python-shell-eval-file-setup-code): For Python 3, use built-in open instead of codecs.open to address the deprecation of codecs.open in Python 3.14. (Bug#79723) --- lisp/progmodes/python.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 212a5e1521c..9c5e1e5ee6c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3694,13 +3694,18 @@ def __PYTHON_EL_eval(source, filename): (defconst python-shell-eval-file-setup-code "\ def __PYTHON_EL_eval_file(filename, tempname, delete): - import codecs, os, re + import os, re, sys + if sys.version_info.major < 3: + import codecs + _open = codecs.open + else: + _open = open pattern = r'^[ \t\f]*#.*?coding[:=][ \t]*([-_.a-zA-Z0-9]+)' - with codecs.open(tempname or filename, encoding='latin-1') as file: + with _open(tempname or filename, encoding='latin-1') as file: match = re.match(pattern, file.readline()) match = match or re.match(pattern, file.readline()) encoding = match.group(1) if match else 'utf-8' - with codecs.open(tempname or filename, encoding=encoding) as file: + with _open(tempname or filename, encoding=encoding) as file: source = file.read().encode(encoding) if delete and tempname: os.remove(tempname) From 82e0951bda2f86ed7fa7b5ce61965cc362edf508 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 12:30:12 +0200 Subject: [PATCH 013/325] ; Mention in PROBLEMS the issue with XIM character-selection window MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * etc/PROBLEMS: Describe the annoying XIM popup window. Suggested by Francesco Potortì . (Bug#79423) --- etc/PROBLEMS | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 5d8ce5bcf52..340e99c0425 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1382,6 +1382,19 @@ these problems by disabling XIM in your X resources: Emacs.useXIM: false +** When the compose key is pressed, a small window appears that won't go away + +In some circumstances, pressing the compose key under X pops up a small +character-selection window next to the cursor, which can be moved but +not closed; it disappears when some window manager operation is +performed, like creating or deleting a window. You can prevent this +window from appearing by completely disabling the X input method (XIM). +If this is acceptable to you, you should set the 'XMODIFIERS' +environment variable to the value '@im=none', and export it before +calling Emacs, for example by invoking Emacs like so: + + env XMODIFIERS=@im=none emacs + ** On Haiku, BeCJK doesn't work properly with Emacs Some popular Haiku input methods such BeCJK are known to behave badly From 48b80a1e2b98f22d8da21f7c89ecfd9861643408 Mon Sep 17 00:00:00 2001 From: RadioNoiseE Date: Sat, 20 Dec 2025 22:31:52 +0800 Subject: [PATCH 014/325] New function 'window-cursor-info' * src/window.c (Fwindow_cursor_info): New function. (syms_of_window): Defsubr it. * doc/lispref/windows.texi (Window Point): Document it. * etc/NEWS: Announce new function. (Bug#80023) --- doc/lispref/windows.texi | 34 ++++++++++++++++++++++++++++++++++ etc/NEWS | 6 ++++++ src/window.c | 36 ++++++++++++++++++++++++++++++++++++ 3 files changed, 76 insertions(+) diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 09d58c17c01..786308dc310 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5927,6 +5927,40 @@ This function returns the cursor type of @var{window}, defaulting to the selected window. @end defun +@defun window-cursor-info &optional window +This function returns information about the cursor of @var{window}, +defaulting to the selected window. + +The value returned by the function is a vector of the form +@w{@code{[@var{type} @var{x} @var{y} @var{width} @var{height} +@var{ascent}]}}. Here's the description of each components of this +vector: + +@table @var +@item type +The type of the cursor, a symbol. This is the same value returned by +@code{window-cursor-type}. + +@item x +@itemx y +The pixel coordinates of the cursor's top-left corner, relative to the +top-left corner of @var{window}'s text area. + +@item width +@itemx height +The pixel dimensions of the cursor. + +@item ascent +The number of pixels the cursor extends above the baseline. +@end table + +If the cursor is not currently displayed for @var{window}, this function +returns @code{nil}. + +Any element except the first one in the returned vector may be +@code{-1}, meaning the actual value is currently unavailable. +@end defun + @node Window Start and End @section The Window Start and End Positions @cindex window start position diff --git a/etc/NEWS b/etc/NEWS index 321ce929cb0..1844eeb7bf5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -440,6 +440,12 @@ adjacent windows and subsequently operate on that parent. 'uncombine-window' can then be used to restore the window configuration to the state it had before running 'combine-windows'. ++++ +*** New function 'window-cursor-info'. +This function returns a vector of pixel-level information about the +physical cursor in a given window, including its type, coordinates, +dimensions, and ascent. + ** Frames +++ diff --git a/src/window.c b/src/window.c index af8c8dd33d2..dc5444255e6 100644 --- a/src/window.c +++ b/src/window.c @@ -8646,6 +8646,41 @@ WINDOW must be a live window and defaults to the selected one. */) return decode_live_window (window)->cursor_type; } +DEFUN ("window-cursor-info", Fwindow_cursor_info, Swindow_cursor_info, + 0, 1, 0, + doc: /* Return information about the cursor of WINDOW. +WINDOW must be a live window and defaults to the selected one. + +The returned value is a vector of 6 elements: + [TYPE X Y WIDTH HEIGHT ASCENT] +where + TYPE is the symbol representing the type of the cursor. See + `cursor-type' for the meaning of the returned value. + X and Y are pixel coordinates of the cursor's top-left corner, relative + to the top-left corner of WINDOW's text area. + WIDTH and HEIGHT are the pixel dimensions of the cursor. + ASCENT is the number of pixels the cursor extends above the baseline. + +If the cursor is not currently displayed for WINDOW, return nil. + +Note that any element except the first one in the returned vector may be +-1 if the actual value is currently unavailable. */) + (Lisp_Object window) +{ + struct window *w = decode_live_window (window); + + if (!w->phys_cursor_on_p) + return Qnil; + + return CALLN (Fvector, + w->cursor_type, + make_fixnum (w->phys_cursor.x), + make_fixnum (w->phys_cursor.y), + make_fixnum (w->phys_cursor_width), + make_fixnum (w->phys_cursor_height), + make_fixnum (w->phys_cursor_ascent)); +} + /*********************************************************************** Scroll bars @@ -9617,5 +9652,6 @@ name to `'ignore'. */); defsubr (&Sset_window_parameter); defsubr (&Swindow_discard_buffer); defsubr (&Swindow_cursor_type); + defsubr (&Swindow_cursor_info); defsubr (&Sset_window_cursor_type); } From bd5f90fa13c13ac6ffbe61526445cca1b825078a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 12:59:40 +0200 Subject: [PATCH 015/325] ; * src/window.c (Fwindow_cursor_info): Doc fix. --- src/window.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index dc5444255e6..22f53ef9507 100644 --- a/src/window.c +++ b/src/window.c @@ -8655,7 +8655,7 @@ The returned value is a vector of 6 elements: [TYPE X Y WIDTH HEIGHT ASCENT] where TYPE is the symbol representing the type of the cursor. See - `cursor-type' for the meaning of the returned value. + `cursor-type' for the meaning of the value. X and Y are pixel coordinates of the cursor's top-left corner, relative to the top-left corner of WINDOW's text area. WIDTH and HEIGHT are the pixel dimensions of the cursor. From 692f742cafacf54bba4befeb23b2cf6753f81799 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jostein=20Kj=C3=B8nigsen?= Date: Sat, 20 Dec 2025 20:46:02 +0100 Subject: [PATCH 016/325] 'csharp-ts-mode': fix indentation error for try/catch statement * lisp/progmodes/csharp-mode.el (csharp-ts-mode--indent-rules): Fix issue with incomplete try/catch statements when try_definition is parsed, but catch_declaration is not yet parsed (shows in tree as ERROR). (Bug#80029) --- lisp/progmodes/csharp-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index aa165ae9ad3..c6e816430a7 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -717,7 +717,9 @@ compilation and evaluation time conflicts." ((parent-is "arrow_function") parent-bol csharp-ts-mode-indent-offset) ((parent-is "parenthesized_expression") parent-bol csharp-ts-mode-indent-offset) ((parent-is "using_statement") parent-bol 0) - ((parent-is "lambda_expression") parent-bol 0)))) + ((parent-is "lambda_expression") parent-bol 0) + ((parent-is "try_statement") parent-bol 0) + ((parent-is "catch_filter_clause") parent-bol 0)))) (defvar csharp-ts-mode--keywords '("using" "namespace" "class" "if" "else" "throw" "new" "for" From e29d3983994e202d11caef24fc38eef641e9f669 Mon Sep 17 00:00:00 2001 From: john muhl Date: Mon, 22 Dec 2025 18:37:12 -0600 Subject: [PATCH 017/325] Fontify 'table.create' in 'lua-mode' * lisp/progmodes/lua-mode.el (lua--builtins): Add 'create' to list of built-in methods. (Bug#80057) --- lisp/progmodes/lua-mode.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/lua-mode.el b/lisp/progmodes/lua-mode.el index 622adc1d29d..bc042599759 100644 --- a/lisp/progmodes/lua-mode.el +++ b/lisp/progmodes/lua-mode.el @@ -354,8 +354,8 @@ traceback location." ("string" . ("byte" "char" "dump" "find" "format" "gmatch" "gsub" "len" "lower" "match" "pack" "packsize" "rep" "reverse" "sub" "unpack" "upper")) - ("table" . ("concat" "insert" "maxn" "move" "pack" "remove" "sort" - "unpack")) + ("table" . ("concat" "create" "insert" "maxn" "move" "pack" "remove" + "sort" "unpack")) ("utf8" . ("char" "charpattern" "codepoint" "codes" "len" "offset"))))) From 034452e46e20b10cbdbb55cf64f4fe6732f1c725 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Tue, 23 Dec 2025 13:26:37 +0100 Subject: [PATCH 018/325] Refill 'image-dired-display-image-buffer' Bug#68486 * lisp/image/image-dired.el (image-dired-display-image): Refill 'image-dired-display-image-buffer' with image contents instead of killing it. --- lisp/image/image-dired.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/image/image-dired.el b/lisp/image/image-dired.el index e632fa7fbfe..cba090e7c85 100644 --- a/lisp/image/image-dired.el +++ b/lisp/image/image-dired.el @@ -1283,18 +1283,18 @@ which is based on `image-mode'." (setq file (expand-file-name file)) (when (not (file-exists-p file)) (error "No such file: %s" file)) - (let ((buf (get-buffer image-dired-display-image-buffer)) + (let ((buf (get-buffer-create image-dired-display-image-buffer)) (cur-win (selected-window))) - (when buf - (kill-buffer buf)) - (when-let* ((buf (find-file-noselect file nil t))) - (pop-to-buffer buf) - (rename-buffer image-dired-display-image-buffer) - (if (string-match (image-file-name-regexp) file) - (image-dired-image-mode) - ;; Support visiting PDF files. - (normal-mode)) - (select-window cur-win)))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents file) + (if (string-match (image-file-name-regexp) file) + (image-dired-image-mode) + ;; Support visiting PDF files. + (normal-mode)))) + (when buf (pop-to-buffer buf)) + (select-window cur-win))) (defun image-dired-display-this (&optional arg) "Display current thumbnail's original image in display buffer. From 61b1554332cb9b40b25976e12bbc6e1e33e4802e Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Thu, 25 Dec 2025 11:50:05 -0800 Subject: [PATCH 019/325] Use tty reported background and foreground colors (Bug#79765) * lisp/term/xterm.el (xterm--report-background-handler) (xterm--report-foreground-handler): Record tty background and foreground color in terminal parameters. (xterm--version-handler): Also query foreground color. (xterm--init): Also query foreground color; move background and foreground color handling here. (xterm--set-background-mode): Rename from xterm-maybe-set-dark-background-mode; now always set background mode to dark or light. (xterm-maybe-update-default-face): Update default face background and foreground colors to terminal reported values if they have not yet been customized. --- lisp/term/xterm.el | 89 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 69 insertions(+), 20 deletions(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 1e6c9a1a920..f173508d777 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -746,20 +746,22 @@ Return the pasted text as a string." (let ((str (xterm--read-string ?\e ?\\))) (when (string-match "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str) - (let ((recompute-faces - (xterm-maybe-set-dark-background-mode - (string-to-number (match-string 1 str) 16) - (string-to-number (match-string 2 str) 16) - (string-to-number (match-string 3 str) 16)))) + (set-terminal-parameter + nil 'xterm--background-color + (list (string-to-number (match-string 1 str) 16) + (string-to-number (match-string 2 str) 16) + (string-to-number (match-string 3 str) 16)))))) - ;; Recompute faces here in case the background mode was - ;; set to dark. We used to call - ;; `tty-set-up-initial-frame-faces' only once, but that - ;; caused the light background faces to be computed - ;; incorrectly. See: - ;; https://lists.gnu.org/r/emacs-devel/2010-01/msg00439.html - (when recompute-faces - (tty-set-up-initial-frame-faces)))))) +(defun xterm--report-foreground-handler () + ;; The reply is similar to in `xterm--report-background-handler'. + (let ((str (xterm--read-string ?\e ?\\))) + (when (string-match + "rgb:\\([a-f0-9]+\\)/\\([a-f0-9]+\\)/\\([a-f0-9]+\\)" str) + (set-terminal-parameter + nil 'xterm--foreground-color + (list (string-to-number (match-string 1 str) 16) + (string-to-number (match-string 2 str) 16) + (string-to-number (match-string 3 str) 16)))))) (defun xterm--version-handler () ;; The reply should be: \e [ > NUMBER1 ; NUMBER2 ; NUMBER3 c @@ -784,7 +786,9 @@ Return the pasted text as a string." ;; Gnome terminal 3.38.0 reports 65;6200;1. (when (> version 4000) (xterm--query "\e]11;?\e\\" - '(("\e]11;" . xterm--report-background-handler)))) + '(("\e]11;" . xterm--report-background-handler))) + (xterm--query "\e]10;?\e\\" + '(("\e]10;" . xterm--report-foreground-handler)))) (setq version 200)) (when (equal (match-string 1 str) "83") ;; `screen' (which returns 83;40003;0) seems to also lack support for @@ -798,7 +802,9 @@ Return the pasted text as a string." ;; versions do too...) (when (>= version 242) (xterm--query "\e]11;?\e\\" - '(("\e]11;" . xterm--report-background-handler)))) + '(("\e]11;" . xterm--report-background-handler))) + (xterm--query "\e]10;?\e\\" + '(("\e]10;" . xterm--report-foreground-handler)))) ;; If version is 216 (the version when modifyOtherKeys was ;; introduced) or higher, initialize the @@ -953,7 +959,9 @@ We run the first FUNCTION whose STRING matches the input events." (when (memq 'reportBackground xterm-extra-capabilities) (xterm--query "\e]11;?\e\\" - '(("\e]11;" . xterm--report-background-handler)))) + '(("\e]11;" . xterm--report-background-handler))) + (xterm--query "\e]10;?\e\\" + '(("\e]10;" . xterm--report-foreground-handler)))) (when (memq 'modifyOtherKeys xterm-extra-capabilities) (xterm--init-modify-other-keys)) @@ -965,6 +973,27 @@ We run the first FUNCTION whose STRING matches the input events." (when xterm-set-window-title (xterm--init-frame-title)) + + (let ((bg-color (terminal-parameter nil 'xterm--background-color)) + (fg-color (terminal-parameter nil 'xterm--foreground-color))) + (when bg-color + (let ((recompute-faces + (apply #'xterm--set-background-mode bg-color))) + + ;; Recompute faces here in case the background mode was + ;; set to dark. We used to call + ;; `tty-set-up-initial-frame-faces' only once, but that + ;; caused the light background faces to be computed + ;; incorrectly. See: + ;; https://lists.gnu.org/r/emacs-devel/2010-01/msg00439.html + (when recompute-faces + (tty-set-up-initial-frame-faces)))) + (when (or bg-color fg-color) + (add-hook 'after-make-frame-functions 'xterm--maybe-update-default-face) + ;; Manually update, after-make-frame-functions was already called + ;; for initial frame. + (xterm--maybe-update-default-face (selected-frame)))) + (when (and (not xterm-mouse-mode-called) ;; Only automatically enable xterm mouse on terminals ;; confirmed to still support all critical editing @@ -1229,12 +1258,32 @@ versions of xterm." ;; right colors, so clear them. (clear-face-cache))) -(defun xterm-maybe-set-dark-background-mode (redc greenc bluec) +(defun xterm--set-background-mode (redc greenc bluec) ;; Use the heuristic in `frame-set-background-mode' to decide if a ;; frame is dark. - (when (< (+ redc greenc bluec) (* .6 (+ 65535 65535 65535))) - (set-terminal-parameter nil 'background-mode 'dark) - t)) + (set-terminal-parameter + nil 'background-mode + (if (< (+ redc greenc bluec) (* .6 (+ 65535 65535 65535))) + 'dark + 'light))) + +(defun xterm--maybe-update-default-face (frame) + (let ((bg-color (terminal-parameter (frame-terminal frame) + 'xterm--background-color)) + (fg-color (terminal-parameter (frame-terminal frame) + 'xterm--foreground-color)) + (default-bg (face-attribute 'default :background frame)) + (default-fg (face-attribute 'default :foreground frame))) + (when (and bg-color (string-equal default-bg "unspecified-bg")) + (let ((r (car bg-color)) + (g (cadr bg-color)) + (b (caddr bg-color))) + (set-face-background 'default (format "#%04x%04x%04x" r g b) frame))) + (when (and fg-color (string-equal default-fg "unspecified-fg")) + (let ((r (car fg-color)) + (g (cadr fg-color)) + (b (caddr fg-color))) + (set-face-foreground 'default (format "#%04x%04x%04x" r g b) frame))))) (provide 'xterm) ;Backward compatibility. (provide 'term/xterm) From 28aa9a76417a6de700bdf36dcac725011eb4ae2d Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Thu, 25 Dec 2025 21:39:29 -0800 Subject: [PATCH 020/325] Make tty default face show the face widget in customize * lisp/wid-edit.el (widget-color-match): Allow unspecified-fg and unspecified-bg as color names. --- lisp/wid-edit.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 10d92fc3951..6d576a10b73 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -4362,7 +4362,10 @@ is inline." "Non-nil if VALUE is a defined color or a RGB hex string." (and (stringp value) (or (color-defined-p value) - (string-match-p "^#\\(?:[[:xdigit:]]\\{3\\}\\)\\{1,4\\}$" value)))) + (string-match-p "^#\\(?:[[:xdigit:]]\\{3\\}\\)\\{1,4\\}$" value) + ;; TTYs also allow unspecified-fg / unspecified-bg as color + ;; values even though they are technically not colors. + (string-match-p "^unspecified-\\(?:fg\\|bg\\)$" value)))) (defun widget-color-validate (widget) "Check that WIDGET's value is a valid color." From 1d45be0b09aecd2352cdf383ea42b180de079049 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 14:21:19 +0200 Subject: [PATCH 021/325] ; * lisp/format-spec.el (format-spec): Doc fix. (Bug#80078) --- lisp/format-spec.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 5c1acf20c9f..b08c7a1cdee 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -59,7 +59,7 @@ value associated with ?b in SPECIFICATION, either padding it with leading zeros or truncating leading characters until it's ten characters wide\". -the substitution for a specification character can also be a +The substitution for a specification character can also be a function, taking no arguments and returning a string to be used for the replacement. It will only be called if FORMAT uses that character. For example: @@ -73,6 +73,9 @@ like above, so that it is compiled by the byte-compiler. Any text properties of FORMAT are copied to the result, with any text properties of a %-spec itself copied to its substitution. +However, note that face properties from the two sources are not +merged; the face properties of %-spec override the face properties +of substitutions, if any, in the result. IGNORE-MISSING indicates how to handle %-spec characters not present in SPECIFICATION. If it is nil or omitted, emit an From 06adedd439d0fbc6fbe3c77442b9cc6c520b76c9 Mon Sep 17 00:00:00 2001 From: Paul Nelson Date: Tue, 30 Dec 2025 01:50:34 +0800 Subject: [PATCH 022/325] Rmail: fix misplaced "D" after auto-file * lisp/mail/rmailsum.el (rmail-summary-mark-deleted): Move to beginning of line before searching for status indicator. (Bug#80097) --- lisp/mail/rmailsum.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 8dd04f97c21..79c2d04ac4f 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1201,6 +1201,7 @@ a negative argument means to delete and move forward." (or (eobp) (not (overlay-get rmail-summary-overlay 'face)) (let ((buffer-read-only nil)) + (beginning-of-line) (skip-chars-forward " ") (skip-chars-forward "0-9") (if undel From d4dde314ffbc97cb3431e8803e8fb46ce36c2274 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Ekl=C3=B6f?= Date: Sun, 28 Dec 2025 13:44:36 +0100 Subject: [PATCH 023/325] Use Primary Device Attributes to detect OSC-52 support Up until recently, there were no reliable way to detect if a terminal supported OSC-52 or not. A number or terminal emulators decided to remedy this by including '52' in their primary DA response. In short, the presence of 52 in the DA response means the terminal supports *writing* to the clipboard. Reading the clipboard is _usually_ supported, but not guaranteed. It should be noted that Emacs uses both the 'c' and 'p' parameters in OSC-52, to copy to either PRIMARY, or CLIPBOARD, while the specification only requires the terminal to implement 'c'. If a terminal doesn't support 'p', the OSC-52 request will be silently ignored. * lisp/term/xterm.el (xterm--init, xterm--primary-da-handler): Query primary device attributes for OSC-52 support. (Bug#80083) Copyright-paperwork-exempt: yes --- lisp/term/xterm.el | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index f173508d777..3300c2d83cc 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -822,6 +822,16 @@ Return the pasted text as a string." ;;(xterm--init-activate-get-selection) (xterm--init-activate-set-selection)))))) +(defun xterm--primary-da-handler () + ;; The reply should be: \e [ ? NUMBER1 ; ... ; NUMBER_N c + (let ((str (xterm--read-string ?c))) + (when (member "52" (split-string str ";" t)) + ;; Many modern terminals include 52 in their primary DA response, + ;; to indicate support for *writing* to the OS clipboard. The + ;; specification does not guarantee the clipboard can be read. See + ;; https://github.com/contour-terminal/vt-extensions/blob/master/clipboard-extension.md + (xterm--init-activate-set-selection)))) + (defvar xterm-query-timeout 2 "Seconds to wait for an answer from the terminal. Can be nil to mean \"no timeout\".") @@ -948,14 +958,18 @@ We run the first FUNCTION whose STRING matches the input events." (tty-set-up-initial-frame-faces) (if (eq xterm-extra-capabilities 'check) - ;; Try to find out the type of terminal by sending a "Secondary - ;; Device Attributes (DA)" query. - (xterm--query "\e[>0c" - ;; Some terminals (like macOS's Terminal.app) respond to - ;; this query as if it were a "Primary Device Attributes" - ;; query instead, so we should handle that too. - '(("\e[?" . xterm--version-handler) - ("\e[>" . xterm--version-handler))) + (progn + ;; Try to find out the type of terminal by sending a "Secondary + ;; Device Attributes (DA)" query. + (xterm--query "\e[>0c" + ;; Some terminals (like macOS's Terminal.app) respond to + ;; this query as if it were a "Primary Device Attributes" + ;; query instead, so we should handle that too. + '(("\e[?" . xterm--version-handler) + ("\e[>" . xterm--version-handler))) + ;; Check primary DA for OSC-52 support + (xterm--query "\e[c" + '(("\e[?" . xterm--primary-da-handler)))) (when (memq 'reportBackground xterm-extra-capabilities) (xterm--query "\e]11;?\e\\" From b5f534a25e5799b74728100516778e2ee5a554e4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Ekl=C3=B6f?= Date: Sun, 28 Dec 2025 13:56:51 +0100 Subject: [PATCH 024/325] Automatically enable xterm-mouse-mode in the foot terminal Foot supports all features required for this (OSC-52, DECSET1000, DECSET1003). * lisp/term/xterm.el (xterm--auto-xt-mouse-allowed-names): Add foot. (Bug#80083) Copyright-paperwork-exempt: yes --- lisp/term/xterm.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 3300c2d83cc..dd179c4e3eb 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -89,7 +89,8 @@ capabilities, and only when that terminal understands bracketed paste." "WezTerm" ;; "XTerm" ;Disabled because OSC52 support is opt-in only. "iTerm2" ;OSC52 support has opt-in/out UI on first usage - "kitty") + "kitty" + "foot") word-end) "Regexp for terminals that automatically enable `xterm-mouse-mode' at startup. This will get matched against the terminal's XTVERSION string. From a9611b10221a705789a0e9a396870a987cfd06f9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 16:39:39 +0200 Subject: [PATCH 025/325] Unbreak a build --without-x * src/window.c (Fwindow_cursor_info): Provide values for TTY frames. (Bug#80023) --- src/window.c | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/window.c b/src/window.c index 22f53ef9507..09516b66cda 100644 --- a/src/window.c +++ b/src/window.c @@ -8672,13 +8672,25 @@ Note that any element except the first one in the returned vector may be if (!w->phys_cursor_on_p) return Qnil; + /* Default values for TTY frames. */ + int phys_cursor_width = 1, phys_cursor_height = 1, phys_cursor_ascent = 1; + struct frame *f = XFRAME (WINDOW_FRAME (w)); + +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + { + phys_cursor_width = w->phys_cursor_width; + phys_cursor_height = w->phys_cursor_height; + phys_cursor_ascent = w->phys_cursor_ascent; + } +#endif return CALLN (Fvector, w->cursor_type, make_fixnum (w->phys_cursor.x), make_fixnum (w->phys_cursor.y), - make_fixnum (w->phys_cursor_width), - make_fixnum (w->phys_cursor_height), - make_fixnum (w->phys_cursor_ascent)); + make_fixnum (phys_cursor_width), + make_fixnum (phys_cursor_height), + make_fixnum (phys_cursor_ascent)); } From 04112d04f2d5d89e144850bb51b7c221fe2bf51c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 3 Jan 2026 15:46:22 +0100 Subject: [PATCH 026/325] Mitigate uutils coreutils problems in Tramp * lisp/net/tramp-sh.el (tramp-get-ls-command): Prefer gnuls over ls. (tramp-get-remote-readlink): Prefer gnureadlink over readlink. (Bug#79956, Bug#80075) --- lisp/net/tramp-sh.el | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a40803a53f1..e7e21684298 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -5823,9 +5823,10 @@ Nonexistent directories are removed from spec." (or (catch 'ls-found (dolist (cmd - ;; Prefer GNU ls on *BSD and macOS. + ;; Prefer GNU ls on *BSD and macOS. See also + ;; Bug#80075 for Linux. (if (tramp-check-remote-uname vec tramp-bsd-unames) - '("gls" "ls" "gnuls") '("ls" "gnuls" "gls"))) + '("gls" "ls" "gnuls") '("gnuls" "ls" "gls"))) (let ((dl (tramp-get-remote-path vec)) result) (while (and dl (setq result (tramp-find-executable vec cmd dl t t))) @@ -5966,11 +5967,14 @@ Nonexistent directories are removed from spec." "Determine remote `readlink' command." (with-tramp-connection-property vec "readlink" (tramp-message vec 5 "Finding a suitable `readlink' command") - (when-let* ((result (tramp-find-executable - vec "readlink" (tramp-get-remote-path vec))) - ((tramp-send-command-and-check - vec (format "%s --canonicalize-missing /" result)))) - result))) + ;; See Bug#80075. + (catch 'readlink-found + (dolist (cmd '("gnureadlink" "readlink")) + (when-let* ((result (tramp-find-executable + vec cmd (tramp-get-remote-path vec))) + ((tramp-send-command-and-check + vec (format "%s --canonicalize-missing /" result)))) + (throw 'readlink-found result)))))) (defun tramp-get-remote-touch (vec) "Determine remote `touch' command." From ea1b7d53d2a166ced296d4049bb55f94c78f92ad Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 17:31:15 +0200 Subject: [PATCH 027/325] ; * lisp/emacs-lisp/inline.el (define-inline): Fix Info link (bug#80122). --- lisp/emacs-lisp/inline.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index 9a1faaca126..25be0dd9c40 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -134,7 +134,7 @@ After VARS is handled, BODY is evaluated in the new environment." This is halfway between `defmacro' and `defun'. BODY is used as a blueprint both for the body of the function and for the body of the compiler-macro used to generate the code inlined at each call site. -See Info node `(elisp)Inline Functions for more details. +See Info node `(elisp)Inline Functions' for more details. A (noinline t) in the `declare' form prevents the definition of the compiler macro. This is for the rare case in which you want to use this From c1b8a00da923c0c88821675537f173d630ddb8b3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 3 Jan 2026 17:34:52 +0200 Subject: [PATCH 028/325] ; * src/window.c (Fwindow_cursor_info): More cleanup. --- src/window.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 09516b66cda..434d17994d4 100644 --- a/src/window.c +++ b/src/window.c @@ -8674,9 +8674,9 @@ Note that any element except the first one in the returned vector may be /* Default values for TTY frames. */ int phys_cursor_width = 1, phys_cursor_height = 1, phys_cursor_ascent = 1; - struct frame *f = XFRAME (WINDOW_FRAME (w)); #ifdef HAVE_WINDOW_SYSTEM + struct frame *f = XFRAME (WINDOW_FRAME (w)); if (FRAME_WINDOW_P (f)) { phys_cursor_width = w->phys_cursor_width; From 6696a738b4c348df55d0de8deb6f45b1eabe2c31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 4 Jan 2026 02:55:04 +0000 Subject: [PATCH 029/325] Eglot: fix thinko in recent diagnostics logic change If the pushed diagnostics are outdated and we have pulled diagnostics, we want to report them. And if the pushed diagnostics are up to date, we want to report them along with any pulled ones. The do-nothing update happens only if the pulled response indicated so explicitly or if there are no pulled diagnostics and the pushed ones are out-of-date. * lisp/progmodes/eglot.el (eglot--flymake-report): Tweak. --- lisp/progmodes/eglot.el | 38 ++++++++++++++++++++------------------ 1 file changed, 20 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b2dd76f0ea8..979de22c1df 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3291,33 +3291,35 @@ When response arrives call registered `eglot--flymake-report-fn'." (remove origin (eglot--managed-buffers server)))))))) (cl-defun eglot--flymake-report - (&optional void + (&optional keep &aux - (diags (append (car eglot--pulled-diagnostics) - (car eglot--pushed-diagnostics))) - (version (cadr eglot--pushed-diagnostics))) + (pushed-docver (cadr eglot--pushed-diagnostics)) + (pushed-outdated-p (and pushed-docver (< pushed-docver eglot--docver)))) "Push previously collected diagnostics to `eglot--flymake-report-fn'. -If VOID, knowingly push a dummy do-nothing update." +If KEEP, knowingly push a dummy do-nothing update." (unless eglot--flymake-report-fn ;; Occasionally called from contexts where report-fn not setup, such ;; as a `didOpen''ed but yet undisplayed buffer. (cl-return-from eglot--flymake-report)) (eglot--widening - (if (or void (and version (< version eglot--docver))) - ;; Here, we don't have anything interesting to give to Flymake: we - ;; just want to keep whatever diagnostics it has annotated in the - ;; buffer. However, as a nice-to-have, we still want to signal - ;; we're alive and clear a possible "Wait" state. We hackingly - ;; achieve this by reporting an empty list and making sure it - ;; pertains to a 0-length region. + (if (or keep (and (null eglot--pulled-diagnostics) pushed-outdated-p)) + ;; Here, we don't have anything interesting to give to + ;; Flymake. Either a textDocument/diagnostics response + ;; specifically told use that nothing changed, or + ;; `flymake-start' kicked in before server had a chance to + ;; push something. We just want to keep whatever diagnostics + ;; it has annotated in the buffer but as a nice-to-have, we + ;; want to signal we're alive and clear a possible "Wait" + ;; state. We hackingly achieve this by reporting an empty + ;; list and making sure it pertains to a 0-length region. (funcall eglot--flymake-report-fn nil :region (cons (point-min) (point-min))) - (funcall eglot--flymake-report-fn diags - ;; If the buffer hasn't changed since last - ;; call to the report function, flymake won't - ;; delete old diagnostics. Using :region - ;; keyword forces flymake to delete - ;; them (github#159). + ;; Using :region keyword always forces Flymake to delete them + ;; (github#159). + (funcall eglot--flymake-report-fn + (append (car eglot--pulled-diagnostics) + (unless pushed-outdated-p + (car eglot--pushed-diagnostics))) :region (cons (point-min) (point-max)))))) (defun eglot-xref-backend () "Eglot xref backend." 'eglot) From 06d3d97e74c2602c86653c251b4bcd7ca67841e7 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Sat, 3 Jan 2026 19:51:15 +0100 Subject: [PATCH 030/325] ; Fix simple logic in OpenBSD's random test * test/src/fns-tests.el (fns-tests-random): Do not test on OpenBSD since either equal or not equal is a valid result here. (Bug#80125) --- test/src/fns-tests.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 4740d8b3bf2..fa00cec6118 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -38,10 +38,9 @@ (should (= (random 1) 0)) (should (>= (random 10) 0)) (should (< (random 10) 10)) - ;; On OpenBSD random is non-deterministic. - (if (and (eq system-type 'berkeley-unix) - (string-match-p "openbsd" system-configuration)) - (should (not (equal (random "seed") (random "seed")))) + ;; On OpenBSD random is always non-deterministic. + (unless (and (eq system-type 'berkeley-unix) + (string-match-p "openbsd" system-configuration)) (should (equal (random "seed") (random "seed")))) ;; The probability of four calls being the same is low. ;; This makes sure that the value isn't constant. From 8819a9e763627867fb9a262502f101a044f84771 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 4 Jan 2026 11:37:42 +0000 Subject: [PATCH 031/325] ; * src/keyboard.c: Fix style in two comments. --- src/keyboard.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 55716c23738..6a4faa7aba7 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12483,7 +12483,7 @@ set_waiting_for_input (struct timespec *time_to_clear) { input_available_clear_time = time_to_clear; - /* Tell handle_interrupt to throw back to read_char, */ + /* Tell handle_interrupt to throw back to read_char. */ waiting_for_input = true; /* If handle_interrupt was called before and buffered a C-g, @@ -12891,7 +12891,8 @@ See also `current-input-mode'. */) error ("QUIT must be an ASCII character"); #ifndef DOS_NT - /* this causes startup screen to be restored and messes with the mouse */ + /* This causes startup screen to be restored and messes with the + mouse. */ reset_sys_modes (tty); #endif From b8ff1c1fae9860f48a954bd97d68b5cf2c643285 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 4 Jan 2026 14:11:19 +0000 Subject: [PATCH 032/325] * lisp/progmodes/project.el (Version): Bump to 0.11.2 (bug#79809) --- lisp/progmodes/project.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index d4a1f2a60b4..662bb905769 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2026 Free Software Foundation, Inc. -;; Version: 0.11.1 +;; Version: 0.11.2 ;; Package-Requires: ((emacs "26.1") (xref "1.7.0")) ;; This is a GNU ELPA :core package. Avoid functionality that is not From 93793260ea3606f28c883ec90e27f15bfa0ba787 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 4 Jan 2026 14:11:45 +0000 Subject: [PATCH 033/325] Eglot: require project 0.11.2 (bug#79809) * lisp/progmodes/eglot.el (Package-Requires): Require project 0.11.2 --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 979de22c1df..94e6c175be2 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -7,7 +7,7 @@ ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot ;; Keywords: convenience, languages -;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.9.8") (seq "2.23") (xref "1.6.2")) +;; Package-Requires: ((emacs "26.3") (eldoc "1.14.0") (external-completion "0.1") (flymake "1.4.2") (jsonrpc "1.0.26") (project "0.11.2") (seq "2.23") (xref "1.6.2")) ;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any From b0aa799b009364bc28b213741c52bdfe5b2d198c Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Sun, 4 Jan 2026 17:52:30 +0100 Subject: [PATCH 034/325] Update to Transient v0.12.0-15-gfe5214e6 --- doc/misc/transient.texi | 109 +++--- lisp/transient.el | 736 ++++++++++++++++++++-------------------- 2 files changed, 430 insertions(+), 415 deletions(-) diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index 15f6b3bf025..25d0e11fac7 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -25,13 +25,13 @@ General Public License for more details. @dircategory Emacs misc features @direntry -* Transient: (transient). Transient Commands. +* Transient: (transient). Transient Commands. @end direntry @finalout @titlepage @title Transient User and Developer Manual -@subtitle for version 0.11.0 +@subtitle for version 0.12.0 @author Jonas Bernoulli @page @vskip 0pt plus 1filll @@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive tutorial, available at @uref{https://github.com/positron-solutions/transient-showcase}. @noindent -This manual is for Transient version 0.11.0. +This manual is for Transient version 0.12.0. @insertcopying @end ifnottex @@ -385,7 +385,7 @@ than outlined above and even customizable.} If the user does not save the value and just exits using a regular suffix command, then the value is merely saved to the transient's history. That value won't be used when the transient is next invoked, -but it is easily accessible (see @ref{Using History}). +but it is easily accessible (@pxref{Using History}). Option @code{transient-common-command-prefix} controls the prefix key used in the following bindings. For simplicity's sake the default, @kbd{C-x}, @@ -454,8 +454,8 @@ previously used values. Usually the same keys as those mentioned above are bound to those commands. Authors of transients should arrange for different infix commands that -read the same kind of value to also use the same history key (see -@ref{Suffix Slots}). +read the same kind of value to also use the same history key +(@pxref{Suffix Slots}). Both kinds of history are saved to a file when Emacs is exited. @@ -785,7 +785,7 @@ menu buffer. The menu buffer is displayed in a window using The value of this option has the form @code{(@var{FUNCTION} . @var{ALIST})}, where @var{FUNCTION} is a function or a list of functions. Each such function should accept two arguments: a buffer to display and an -alist of the same form as @var{ALIST}. See @ref{Choosing Window,,,elisp,}, +alist of the same form as @var{ALIST}. @xref{Choosing Window,,,elisp,}, for details. The default is: @@ -798,8 +798,8 @@ The default is: @end lisp This displays the window at the bottom of the selected frame. -For alternatives see @ref{Buffer Display Action Functions,,,elisp,}, -and @ref{Buffer Display Action Alists,,,elisp,}. +For alternatives @xref{Buffer Display Action Functions,,,elisp,}, +and @xref{Buffer Display Action Alists,,,elisp,}. When you switch to a different ACTION, you should keep the ALIST entries for @code{dedicated} and @code{inhibit-same-window} in most cases. @@ -861,7 +861,7 @@ used to draw the line. This user option may be overridden if @code{:mode-line-format} is passed when creating a new prefix with @code{transient-define-prefix}. -Otherwise this can be any mode-line format. See @ref{Mode Line Format,,,elisp,}, for details. +Otherwise this can be any mode-line format. @xref{Mode Line Format,,,elisp,}, for details. @end defopt @defopt transient-semantic-coloring @@ -1002,8 +1002,8 @@ That buffer is current and empty when this hook is runs. @cindex modifying existing transients -To an extent, transients can be customized interactively, see -@ref{Enabling and Disabling Suffixes}. This section explains how existing +To an extent, transients can be customized interactively, +@xref{Enabling and Disabling Suffixes}. This section explains how existing transients can be further modified non-interactively. Let's begin with an example: @@ -1029,10 +1029,10 @@ which can be included in multiple prefixes. See TODO@. as expected by @code{transient-define-prefix}. Note that an infix is a special kind of suffix. Depending on context ``suffixes'' means ``suffixes (including infixes)'' or ``non-infix suffixes''. Here it -means the former. See @ref{Suffix Specifications}. +means the former. @xref{Suffix Specifications}. @var{SUFFIX} may also be a group in the same form as expected by -@code{transient-define-prefix}. See @ref{Group Specifications}. +@code{transient-define-prefix}. @xref{Group Specifications}. @item @var{LOC} is a key description (a string as returned by @code{key-description} @@ -1055,9 +1055,9 @@ the function @code{transient--get-layout}. These functions operate on the information stored in the @code{transient--layout} property of the @var{PREFIX} symbol. Elements in that -tree are not objects but have the form @code{(@var{CLASS} @var{PLIST}) for suffixes} and +tree are not objects but have the form @code{(@var{CLASS} @var{PLIST})} for suffixes and @code{[CLASS PLIST CHILDREN]} for groups. At the root of the tree is an -element @code{[N Nil CHILDREN]}, where @code{N} is the version of the layout format, +element @code{[N nil CHILDREN]}, where @code{N} is the version of the layout format, currently and hopefully for a long time 2. While that element looks like a group vector, that element does not count when identifying a group using a coordinate vector, i.e., @code{[0]} is its first child, not the @@ -1072,7 +1072,7 @@ or after @var{LOC}. Conceptually adding a binding to a transient prefix is similar to adding a binding to a keymap, but this is complicated by the fact that multiple suffix commands can be bound to the same key, provided -they are never active at the same time, see @ref{Predicate Slots}. +they are never active at the same time, @xref{Predicate Slots}. Unfortunately both false-positives and false-negatives are possible. To deal with the former, use non-@code{nil} @var{KEEP-OTHER@.} The symbol @code{always} @@ -1205,14 +1205,14 @@ enabled. One benefit of the Transient interface is that it remembers history not only on a global level (``this command was invoked using these arguments, and previously it was invoked using those other arguments''), but also remembers the values of individual arguments -independently. See @ref{Using History}. +independently. @xref{Using History}. After a transient prefix command is invoked, @kbd{C-h @var{KEY}} can be used to show the documentation for the infix or suffix command that @kbd{@var{KEY}} is -bound to (see @ref{Getting Help for Suffix Commands}), and infixes and +bound to (@pxref{Getting Help for Suffix Commands}), and infixes and suffixes can be removed from the transient using @kbd{C-x l @var{KEY}}. Infixes and suffixes that are disabled by default can be enabled the same way. -See @ref{Enabling and Disabling Suffixes}. +@xref{Enabling and Disabling Suffixes}. Transient ships with support for a few different types of specialized infix commands. A command that sets a command line option, for example, @@ -1263,7 +1263,7 @@ explicitly. @var{GROUP}s add key bindings for infix and suffix commands and specify how these bindings are presented in the menu buffer. At least one -@var{GROUP} has to be specified. See @ref{Binding Suffix and Infix Commands}. +@var{GROUP} has to be specified. @xref{Binding Suffix and Infix Commands}. The @var{BODY} is optional. If it is omitted, then @var{ARGLIST} is ignored and the function definition becomes: @@ -1314,11 +1314,13 @@ GROUPs have the same form as for @code{transient-define-prefix}. @section Binding Suffix and Infix Commands The macro @code{transient-define-prefix} is used to define a transient. -This defines the actual transient prefix command (see @ref{Defining Transients}) and adds the transient's infix and suffix bindings, as +This defines the actual transient prefix command (@pxref{Defining +Transients}) and adds the transient's infix and suffix bindings, as described below. Users and third-party packages can add additional bindings using -functions such as @code{transient-insert-suffix} (see @ref{Modifying Existing Transients}). These functions take a ``suffix specification'' as one of +functions such as @code{transient-insert-suffix} (@pxref{Modifying Existing Transients}). +These functions take a ``suffix specification'' as one of their arguments, which has the same form as the specifications used in @code{transient-define-prefix}. @@ -1334,7 +1336,7 @@ for a set of suffixes. Several group classes exist, some of which organize suffixes in subgroups. In most cases the class does not have to be specified -explicitly, but see @ref{Group Classes}. +explicitly, but @xref{Group Classes}. Groups are specified in the call to @code{transient-define-prefix}, using vectors. Because groups are represented using vectors, we cannot use @@ -1344,10 +1346,13 @@ brackets to do the latter. Group specifications then have this form: @lisp -[@{LEVEL@} @{DESCRIPTION@} @{KEYWORD VALUE@}... ELEMENT...] +[@{@var{LEVEL}@} @{@var{DESCRIPTION}@} + @{@var{KEYWORD} @var{VALUE}@}... + @var{ELEMENT}...] @end lisp -The @var{LEVEL} is optional and defaults to 4. See @ref{Enabling and Disabling Suffixes}. +The @var{LEVEL} is optional and defaults to 4. @xref{Enabling and +Disabling Suffixes}. The @var{DESCRIPTION} is optional. If present, it is used as the heading of the group. @@ -1378,7 +1383,7 @@ useful while rebase is already in progress; and another that uses initiate a rebase. These predicates can also be used on individual suffixes and are -only documented once, see @ref{Predicate Slots}. +only documented once, @xref{Predicate Slots}. @item The value of @code{:hide}, if non-@code{nil}, is a predicate that controls @@ -1483,13 +1488,13 @@ The form of suffix specifications is documented in the next node. @cindex suffix specifications A transient's suffix and infix commands are bound when the transient -prefix command is defined using @code{transient-define-prefix}, see -@ref{Defining Transients}. The commands are organized into groups, see -@ref{Group Specifications}. Here we describe the form used to bind an +prefix command is defined using @code{transient-define-prefix}, +@xref{Defining Transients}. The commands are organized into groups, +@xref{Group Specifications}. Here we describe the form used to bind an individual suffix command. The same form is also used when later binding additional commands -using functions such as @code{transient-insert-suffix}, see @ref{Modifying Existing Transients}. +using functions such as @code{transient-insert-suffix}, @xref{Modifying Existing Transients}. Note that an infix is a special kind of suffix. Depending on context ``suffixes'' means ``suffixes (including infixes)'' or ``non-infix @@ -1498,7 +1503,9 @@ suffixes''. Here it means the former. Suffix specifications have this form: @lisp -([LEVEL] [KEY [DESCRIPTION]] COMMAND|ARGUMENT [KEYWORD VALUE]...) +([@var{LEVEL}] + [@var{KEY} [@var{DESCRIPTION}]] + @var{COMMAND}|@var{ARGUMENT} [@var{KEYWORD} @var{VALUE}]...) @end lisp @var{LEVEL}, @var{KEY} and @var{DESCRIPTION} can also be specified using the @var{KEYWORD}s @@ -1509,8 +1516,8 @@ the object's values just for the binding inside this transient. @itemize @item -@var{LEVEL} is the suffix level, an integer between 1 and 7. See -@ref{Enabling and Disabling Suffixes}. +@var{LEVEL} is the suffix level, an integer between 1 and 7. +@xref{Enabling and Disabling Suffixes}. @item KEY is the key binding, a string in the format returned by @@ -1584,7 +1591,7 @@ guessed based on the long argument. If the argument ends with @samp{=} Finally, details can be specified using optional @var{KEYWORD}-@var{VALUE} pairs. Each keyword has to be a keyword symbol, either @code{:class} or a keyword -argument supported by the constructor of that class. See @ref{Suffix Slots}. +argument supported by the constructor of that class. @xref{Suffix Slots}. If a keyword argument accepts a function as value, you an use a @code{lambda} expression. As a special case, the @code{##} macro (which returns a @code{lambda} @@ -1702,7 +1709,7 @@ should be used. @end defun @defun transient-get-value -This function returns the value of the current prefix. +This function returns the value of the extant prefix. This function is intended to be used when setting up a menu and its suffixes. It is not intended to be used when a suffix command is @@ -1934,8 +1941,8 @@ means that all outer prefixes are exited at once. @item The behavior for non-suffixes can be set for a particular prefix, by the prefix's @code{transient-non-suffix} slot to a boolean, a suitable -pre-command function, or a shorthand for such a function. See -@ref{Pre-commands for Non-Suffixes}. +pre-command function, or a shorthand for such a function. +@xref{Pre-commands for Non-Suffixes}. @item The common behavior for the suffixes of a particular prefix can be @@ -2260,7 +2267,7 @@ Transient itself provides a single class for prefix commands, @code{transient-prefix}, but package authors may wish to define specialized classes. Doing so makes it possible to change the behavior of the set of prefix commands that use that class, by implementing specialized -methods for certain generic functions (see @ref{Prefix Methods}). +methods for certain generic functions (@pxref{Prefix Methods}). A transient prefix command's object is stored in the @code{transient--prefix} property of the command symbol. While a transient is active, a clone @@ -2275,7 +2282,7 @@ object should not affect later invocations. @item All suffix and infix classes derive from @code{transient-suffix}, which in turn derives from @code{transient-child}, from which @code{transient-group} also -derives (see @ref{Group Classes}). +derives (@pxref{Group Classes}). @item All infix classes derive from the abstract @code{transient-infix} class, @@ -2283,13 +2290,13 @@ which in turn derives from the @code{transient-suffix} class. Infixes are a special type of suffixes. The primary difference is that infixes always use the @code{transient--do-stay} pre-command, while -non-infix suffixes use a variety of pre-commands (see @ref{Transient State}). Doing that is most easily achieved by using this class, +non-infix suffixes use a variety of pre-commands (@pxref{Transient State}). Doing that is most easily achieved by using this class, though theoretically it would be possible to define an infix class that does not do so. If you do that then you get to implement many methods. Also, infixes and non-infix suffixes are usually defined using -different macros (see @ref{Defining Suffix and Infix Commands}). +different macros (@pxref{Defining Suffix and Infix Commands}). @item Classes used for infix commands that represent arguments should @@ -2699,7 +2706,7 @@ secondary value, called a ``scope''. See @code{transient-define-prefix}. @code{transient-suffix}, @code{transient-non-suffix} and @code{transient-switch-frame} play a part when determining whether the currently active transient prefix command remains active/transient when a suffix or arbitrary -non-suffix command is invoked. See @ref{Transient State}. +non-suffix command is invoked. @xref{Transient State}. @item @code{refresh-suffixes} Normally suffix objects and keymaps are only setup @@ -2781,7 +2788,7 @@ of the same symbol. @item @code{level} The level of the prefix commands. The suffix commands whose -layer is equal or lower are displayed. See @ref{Enabling and Disabling Suffixes}. +layer is equal or lower are displayed. @pxref{Enabling and Disabling Suffixes}. @item @code{value} The likely outdated value of the prefix. Instead of accessing @@ -2805,15 +2812,15 @@ Here we document most of the slots that are only available for suffix objects. Some slots are shared by suffix and group objects, they are documented in @ref{Predicate Slots}. -Also see @ref{Suffix Classes}. +Also @xref{Suffix Classes}. @anchor{Slots of @code{transient-child}} @subheading Slots of @code{transient-child} This is the abstract superclass of @code{transient-suffix} and @code{transient-group}. -This is where the shared @code{if*} and @code{inapt-if*} slots (see @ref{Predicate Slots}), -the @code{level} slot (see @ref{Enabling and Disabling Suffixes}), and the @code{advice} -and @code{advice*} slots (see @ref{Slots of @code{transient-suffix}}) are defined. +This is where the shared @code{if*} and @code{inapt-if*} slots (@pxref{Predicate Slots}), +the @code{level} slot (@pxref{Enabling and Disabling Suffixes}), and the @code{advice} +and @code{advice*} slots (@pxref{Slots of @code{transient-suffix}}) are defined. @itemize @item @@ -2839,7 +2846,7 @@ which is useful for alignment purposes. @code{command} The command, a symbol. @item -@code{transient} Whether to stay transient. See @ref{Transient State}. +@code{transient} Whether to stay transient. @xref{Transient State}. @item @code{format} The format used to display the suffix in the menu buffer. @@ -3063,14 +3070,14 @@ currently cannot be invoked. By default these predicates run when the prefix command is invoked, but this can be changes, using the @code{refresh-suffixes} prefix slot. -See @ref{Prefix Slots}. +@xref{Prefix Slots}. One more slot is shared between group and suffix classes, @code{level}. Like the slots documented above, it is a predicate, but it is used for a different purpose. The value has to be an integer between 1 and 7. @code{level} controls whether a suffix or a group should be available depending on user preference. -See @ref{Enabling and Disabling Suffixes}. +@xref{Enabling and Disabling Suffixes}. @node FAQ @appendix FAQ diff --git a/lisp/transient.el b/lisp/transient.el index a464a6f09ef..a7e2e5daa23 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -5,7 +5,7 @@ ;; Author: Jonas Bernoulli ;; URL: https://github.com/magit/transient ;; Keywords: extensions -;; Version: 0.11.0 +;; Version: 0.12.0 ;; SPDX-License-Identifier: GPL-3.0-or-later @@ -33,7 +33,7 @@ ;;; Code: ;;;; Frontmatter -(defconst transient-version "v0.11.0-10-g6637364e-builtin") +(defconst transient-version "v0.12.0-15-gfe5214e6-builtin") (require 'cl-lib) (require 'eieio) @@ -669,15 +669,16 @@ See also option `transient-highlight-mismatched-keys'." (insert-file-contents file) (read (current-buffer)))))) -(defun transient--pp-to-file (list file) - (make-directory (file-name-directory file) t) - (setq list (cl-sort (copy-sequence list) #'string< :key #'car)) - (with-temp-file file - (let ((print-level nil) - (print-length nil) - (pp-default-function 'pp-28) - (fill-column 999)) - (pp list (current-buffer))))) +(defun transient--pp-to-file (value file) + (when (or value (file-exists-p file)) + (make-directory (file-name-directory file) t) + (setq value (cl-sort (copy-sequence value) #'string< :key #'car)) + (with-temp-file file + (let ((print-level nil) + (print-length nil) + (pp-default-function 'pp-28) + (fill-column 999)) + (pp value (current-buffer)))))) (defvar transient-values (transient--read-file-contents transient-values-file) @@ -1215,15 +1216,15 @@ commands are aliases for." (while-let ((arg (car args)) (arg (cond - ;; Inline group definition. - ((vectorp arg) - (pop args)) - ;; Quoted include, as one would expect. - ((eq (car-safe arg) 'quote) - (cadr (pop args))) - ;; Unquoted include, for compatibility. - ((and arg (symbolp arg)) - (pop args))))) + ;; Inline group definition. + ((vectorp arg) + (pop args)) + ;; Quoted include, as one would expect. + ((eq (car-safe arg) 'quote) + (cadr (pop args))) + ;; Unquoted include, for compatibility. + ((and arg (symbolp arg)) + (pop args))))) (push arg suffixes)) (when (eq (car-safe (car args)) 'declare) (setq declare (car args)) @@ -1234,11 +1235,11 @@ commands are aliases for." (unless (cdr declare) (setq declare nil))) (cond - ((not args)) - (nobody - (error "%s: No function body allowed" form)) - ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) - (error "%s: Interactive form missing" form))) + ((not args)) + (nobody + (error "%s: No function body allowed" form)) + ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) + (error "%s: Interactive form missing" form))) (list (if (eq (car-safe class) 'quote) (cadr class) class) @@ -1502,40 +1503,40 @@ Intended for use in a group's `:setup-children' function." (symbol suffix))) (`(,elt ,group) (transient--locate-child prefix loc))) (cond - ((not elt) - (funcall (if transient-error-on-insert-failure #'error #'message) - "Cannot insert %S into %s; %s not found" - suffix prefix loc)) - ((or (and (vectorp suffix) (not (vectorp elt))) - (and (listp suffix) (vectorp elt)) - (and (stringp suffix) (vectorp elt))) - (funcall (if transient-error-on-insert-failure #'error #'message) - "Cannot place %S into %s at %s; %s" - suffix prefix loc - "suffixes and groups cannot be siblings")) - (t - (when-let* ((_(not (eq keep-other 'always))) - (bindingp (listp suf)) - (key (transient--suffix-key suf)) - (conflict (car (transient--locate-child prefix key))) - (conflictp - (and (not (and (eq action 'replace) - (eq conflict elt))) - (or (not keep-other) - (eq (plist-get (transient--suffix-props suf) - :command) - (plist-get (transient--suffix-props conflict) - :command))) - (equal (transient--suffix-predicate suf) - (transient--suffix-predicate conflict))))) - (transient-remove-suffix prefix key) - (pcase-setq `(,elt ,group) (transient--locate-child prefix loc))) - (let ((mem (memq elt (aref group 2)))) - (pcase-exhaustive action - ('insert (setcdr mem (cons elt (cdr mem))) - (setcar mem suf)) - ('append (setcdr mem (cons suf (cdr mem)))) - ('replace (setcar mem suf)))))))) + ((not elt) + (funcall (if transient-error-on-insert-failure #'error #'message) + "Cannot insert %S into %s; %s not found" + suffix prefix loc)) + ((or (and (vectorp suffix) (not (vectorp elt))) + (and (listp suffix) (vectorp elt)) + (and (stringp suffix) (vectorp elt))) + (funcall (if transient-error-on-insert-failure #'error #'message) + "Cannot place %S into %s at %s; %s" + suffix prefix loc + "suffixes and groups cannot be siblings")) + (t + (when-let* ((_(not (eq keep-other 'always))) + (bindingp (listp suf)) + (key (transient--suffix-key suf)) + (conflict (car (transient--locate-child prefix key))) + (conflictp + (and (not (and (eq action 'replace) + (eq conflict elt))) + (or (not keep-other) + (eq (plist-get (transient--suffix-props suf) + :command) + (plist-get (transient--suffix-props conflict) + :command))) + (equal (transient--suffix-predicate suf) + (transient--suffix-predicate conflict))))) + (transient-remove-suffix prefix key) + (pcase-setq `(,elt ,group) (transient--locate-child prefix loc))) + (let ((mem (memq elt (aref group 2)))) + (pcase-exhaustive action + ('insert (setcdr mem (cons elt (cdr mem))) + (setcar mem suf)) + ('append (setcdr mem (cons suf (cdr mem)))) + ('replace (setcar mem suf)))))))) ;;;###autoload (defun transient-insert-suffix (prefix loc suffix &optional keep-other) @@ -1644,20 +1645,20 @@ See info node `(transient)Modifying Existing Transients'." (setq group (transient--get-layout group))) (when (vectorp loc) (setq loc (append loc nil))) - (if (listp loc) - (and-let* ((match (transient--nth (pop loc) (aref group 2)))) - (if loc - (transient--locate-child - match (cond ((or (stringp (car loc)) - (symbolp (car loc))) - (car loc)) - ((symbolp match) - (vconcat (cons 0 loc))) - ((vconcat loc)))) - (list match group))) - (seq-some (lambda (child) - (transient--match-child group loc child)) - (aref group 2)))) + (cond* + ((atom loc) + (seq-some (lambda (child) + (transient--match-child group loc child)) + (aref group 2))) + ((bind-and* (match (transient--nth (pop loc) (aref group 2)))) + (cond (loc (transient--locate-child + match (cond ((or (stringp (car loc)) + (symbolp (car loc))) + (car loc)) + ((symbolp match) + (vconcat (cons 0 loc))) + ((vconcat loc))))) + ((list match group)))))) (defun transient--match-child (group loc child) (cl-etypecase child @@ -1931,23 +1932,23 @@ probably use this instead: (or transient--suffixes transient-current-suffixes)))) (cond - ((length= suffixes 1) - (car suffixes)) - ((cl-find-if (lambda (obj) - (equal (listify-key-sequence (kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) - suffixes)) - ;; COMMAND is only provided if `this-command' is meaningless, in - ;; which case `this-command-keys' is also meaningless, making it - ;; impossible to disambiguate bindings for the same command. - (command (car suffixes)) - ;; If COMMAND is nil, then failure to disambiguate likely means - ;; that there is a bug somewhere. - ((length> suffixes 1) - (error "BUG: Cannot unambiguously determine suffix object")) - ;; It is legitimate to use this function as a predicate of sorts. - ;; `transient--pre-command' and `transient-help' are examples. - (t nil)))) + ((length= suffixes 1) + (car suffixes)) + ((cl-find-if (lambda (obj) + (equal (listify-key-sequence (kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + ;; COMMAND is only provided if `this-command' is meaningless, in + ;; which case `this-command-keys' is also meaningless, making it + ;; impossible to disambiguate bindings for the same command. + (command (car suffixes)) + ;; If COMMAND is nil, then failure to disambiguate likely means + ;; that there is a bug somewhere. + ((length> suffixes 1) + (error "BUG: Cannot unambiguously determine suffix object")) + ;; It is legitimate to use this function as a predicate of sorts. + ;; `transient--pre-command' and `transient-help' are examples. + (t nil)))) ((bind-and* (obj (transient--suffix-prototype (or command this-command))) (obj (clone obj))) (transient-init-scope obj) @@ -2254,31 +2255,31 @@ of the corresponding object." ((cl-typep obj 'transient-infix) 'infix) (t 'suffix))) (pre (cond - ((oref obj inactive) nil) - ((oref obj inapt) #'transient--do-warn-inapt) - ((slot-boundp obj 'transient) - (pcase (list kind - (transient--resolve-pre-command - (oref obj transient) nil t) - return) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix nil ,_) #'transient--do-stack) - (`(infix t ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(,_ nil ,_) #'transient--do-exit) - (`(,_ ,do ,_) do))) - ((not (lookup-key transient-predicate-map id)) - (pcase (list kind default return) - (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_) - #'transient--do-recurse) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix ,_ ,_) #'transient--do-stack) - (`(infix ,_ ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(suffix nil nil) #'transient--do-exit) - (`(suffix ,do ,_) do)))))) + ((oref obj inactive) nil) + ((oref obj inapt) #'transient--do-warn-inapt) + ((slot-boundp obj 'transient) + (pcase (list kind + (transient--resolve-pre-command + (oref obj transient) nil t) + return) + (`(prefix t ,_) #'transient--do-recurse) + (`(prefix nil ,_) #'transient--do-stack) + (`(infix t ,_) #'transient--do-stay) + (`(suffix t ,_) #'transient--do-call) + ('(suffix nil t) #'transient--do-return) + (`(,_ nil ,_) #'transient--do-exit) + (`(,_ ,do ,_) do))) + ((not (lookup-key transient-predicate-map id)) + (pcase (list kind default return) + (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_) + #'transient--do-recurse) + (`(prefix t ,_) #'transient--do-recurse) + (`(prefix ,_ ,_) #'transient--do-stack) + (`(infix ,_ ,_) #'transient--do-stay) + (`(suffix t ,_) #'transient--do-call) + ('(suffix nil t) #'transient--do-return) + (`(suffix nil nil) #'transient--do-exit) + (`(suffix ,do ,_) do)))))) (when pre (if-let* ((alt (lookup-key map id))) (unless (eq alt pre) @@ -2336,24 +2337,24 @@ EDIT may be non-nil." (transient--debug 'setup) (transient--with-emergency-exit :setup (cond - ((not name) - ;; Switching between regular and edit mode. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (setq name (oref transient--prefix command)) - (setq params (list :scope (oref transient--prefix scope)))) - (transient--prefix - ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" - ;; of an outer prefix. Unlike the usual `transient--do-stack', - ;; these predicates fail to clean up after the outer prefix. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map)) - ((not (or layout ; resuming parent/suspended prefix - transient-current-command)) ; entering child prefix - (transient--stack-zap)) ; replace suspended prefix, if any - (edit - ;; Returning from help to edit. - (setq transient--editp t))) + ((not name) + ;; Switching between regular and edit mode. + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map) + (setq name (oref transient--prefix command)) + (setq params (list :scope (oref transient--prefix scope)))) + (transient--prefix + ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" + ;; of an outer prefix. Unlike the usual `transient--do-stack', + ;; these predicates fail to clean up after the outer prefix. + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map)) + ((not (or layout ; resuming parent/suspended prefix + transient-current-command)) ; entering child prefix + (transient--stack-zap)) ; replace suspended prefix, if any + (edit + ;; Returning from help to edit. + (setq transient--editp t))) (transient--env-apply (lambda () (transient--init-transient name layout params) @@ -2570,25 +2571,25 @@ value. Otherwise return CHILDREN as is.") (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived default) (cond - (if (funcall if)) - (if-not (not (funcall if-not))) - (if-non-nil (symbol-value if-non-nil)) - (if-nil (not (symbol-value if-nil))) - (if-mode (if (atom if-mode) - (eq major-mode if-mode) - (memq major-mode if-mode))) - (if-not-mode (not (if (atom if-not-mode) - (eq major-mode if-not-mode) - (memq major-mode if-not-mode)))) - (if-derived (if (or (atom if-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-derived) - (apply #'derived-mode-p if-derived))) - (if-not-derived (not (if (or (atom if-not-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-not-derived) - (apply #'derived-mode-p if-not-derived)))) - (default))) + (if (funcall if)) + (if-not (not (funcall if-not))) + (if-non-nil (symbol-value if-non-nil)) + (if-nil (not (symbol-value if-nil))) + (if-mode (if (atom if-mode) + (eq major-mode if-mode) + (memq major-mode if-mode))) + (if-not-mode (not (if (atom if-not-mode) + (eq major-mode if-not-mode) + (memq major-mode if-not-mode)))) + (if-derived (if (or (atom if-derived) + (>= emacs-major-version 30)) + (derived-mode-p if-derived) + (apply #'derived-mode-p if-derived))) + (if-not-derived (not (if (or (atom if-not-derived) + (>= emacs-major-version 30)) + (derived-mode-p if-not-derived) + (apply #'derived-mode-p if-not-derived)))) + (default))) (defun transient--suffix-predicate (spec) (let ((props (transient--suffix-props spec))) @@ -2649,30 +2650,30 @@ value. Otherwise return CHILDREN as is.") (not (transient--get-pre-command this-command nil 'suffix))) (setq this-command this-original-command)) (cond - ((memq this-command '(transient-update transient-quit-seq)) - (transient--pop-keymap 'transient--redisplay-map)) - ((and transient--helpp - (not (memq this-command transient--quit-commands))) - (cond - ((transient-help) - (transient--do-suspend) - (setq this-command 'transient-suspend) - (transient--pre-exit)) - ((not (transient--edebug-command-p)) - (setq this-command 'transient-undefined)))) - ((and transient--editp - (transient-suffix-object) - (not (memq this-command - (cons 'transient-help transient--quit-commands)))) - (setq this-command 'transient-set-level) - (transient--wrap-command)) - (t - (setq transient--exitp nil) - (let ((exitp (eq (transient--call-pre-command) transient--exit))) - (transient--wrap-command) - (when exitp - (transient--maybe-set-value 'exit) - (transient--pre-exit))))))) + ((memq this-command '(transient-update transient-quit-seq)) + (transient--pop-keymap 'transient--redisplay-map)) + ((and transient--helpp + (not (memq this-command transient--quit-commands))) + (cond + ((transient-help) + (transient--do-suspend) + (setq this-command 'transient-suspend) + (transient--pre-exit)) + ((not (transient--edebug-command-p)) + (setq this-command 'transient-undefined)))) + ((and transient--editp + (transient-suffix-object) + (not (memq this-command + (cons 'transient-help transient--quit-commands)))) + (setq this-command 'transient-set-level) + (transient--wrap-command)) + (t + (setq transient--exitp nil) + (let ((exitp (eq (transient--call-pre-command) transient--exit))) + (transient--wrap-command) + (when exitp + (transient--maybe-set-value 'exit) + (transient--pre-exit))))))) (defun transient--pre-exit () (transient--debug 'pre-exit) @@ -2787,25 +2788,25 @@ value. Otherwise return CHILDREN as is.") (advice (lambda (fn &rest args) (interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (let ((debugger #'transient--exit-and-debug)) - (if-let* ((obj suffix) - (grp (oref obj parent)) - (adv (or (oref obj advice*) - (oref grp advice*)))) - (funcall - adv #'advice-eval-interactive-spec spec) - (advice-eval-interactive-spec spec))) - (setq abort nil)) - (when abort - (when-let* ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind command)) - (when (symbolp command) - (remove-function (symbol-function command) advice)) - (oset prefix unwind-suffix nil)))))) + (lambda (spec) + (let ((abort t)) + (unwind-protect + (prog1 (let ((debugger #'transient--exit-and-debug)) + (if-let* ((obj suffix) + (grp (oref obj parent)) + (adv (or (oref obj advice*) + (oref grp advice*)))) + (funcall + adv #'advice-eval-interactive-spec spec) + (advice-eval-interactive-spec spec))) + (setq abort nil)) + (when abort + (when-let* ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-interactive) + (funcall unwind command)) + (when (symbolp command) + (remove-function (symbol-function command) advice)) + (oset prefix unwind-suffix nil)))))) (unwind-protect (let ((debugger #'transient--exit-and-debug)) (if-let* ((obj suffix) @@ -3316,21 +3317,22 @@ transient is active." ;;;; Help -(defun transient-help (&optional interactive) +(defun transient-help (&optional interactivep) "Show help for the active transient or one of its suffixes. \n(fn)" (interactive (list t)) - (if interactive - (setq transient--helpp t) - (with-demoted-errors "transient-help: %S" - (when (lookup-key transient--transient-map - (this-single-command-raw-keys)) - (setq transient--helpp nil) - (transient--display-help #'transient-show-help - (if (eq this-original-command 'transient-help) - transient--prefix - (or (transient-suffix-object) - this-original-command))))))) + (cond + (interactivep + (setq transient--helpp t)) + ((lookup-key transient--transient-map + (this-single-command-raw-keys)) + (setq transient--helpp nil) + (with-demoted-errors "transient-help: %S" + (transient--display-help #'transient-show-help + (if (eq this-original-command 'transient-help) + transient--prefix + (or (transient-suffix-object) + this-original-command))))))) (transient-define-suffix transient-describe () "From a transient menu, describe something in another buffer. @@ -3358,55 +3360,55 @@ For example: (defun transient-set-level (&optional command level) "Set the level of the transient or one of its suffix commands." (interactive - (let ((command this-original-command) - (prefix (oref transient--prefix command))) - (and (or (not (eq command 'transient-set-level)) - (and transient--editp - (setq command prefix))) - (list command - (let ((keys (this-single-command-raw-keys))) - (and (lookup-key transient--transient-map keys) - (progn - (transient--show) - (string-to-number - (transient--read-number-N - (format "Set level for `%s': " command) - nil nil (not (eq command prefix))))))))))) + (let ((command this-original-command) + (prefix (oref transient--prefix command))) + (and (or (not (eq command 'transient-set-level)) + (and transient--editp + (setq command prefix))) + (list command + (let ((keys (this-single-command-raw-keys))) + (and (lookup-key transient--transient-map keys) + (progn + (transient--show) + (string-to-number + (transient--read-number-N + (format "Set level for `%s': " command) + nil nil (not (eq command prefix))))))))))) (cond - ((not command) - (setq transient--editp t) - (transient-setup)) - (level - (let* ((prefix (oref transient--prefix command)) - (alist (alist-get prefix transient-levels)) - (akey command)) - (cond ((eq command prefix) - (oset transient--prefix level level) - (setq akey t)) - (t - (oset (transient-suffix-object command) level level) - (when (cdr (cl-remove-if-not (lambda (obj) - (eq (oref obj command) command)) - transient--suffixes)) - (setq akey (cons command (this-command-keys)))))) - (setf (alist-get akey alist) level) - (setf (alist-get prefix transient-levels) alist)) - (transient-save-levels) - (transient--show)) - (t - (transient-undefined)))) + ((not command) + (setq transient--editp t) + (transient-setup)) + (level + (let* ((prefix (oref transient--prefix command)) + (alist (alist-get prefix transient-levels)) + (akey command)) + (cond ((eq command prefix) + (oset transient--prefix level level) + (setq akey t)) + (t + (oset (transient-suffix-object command) level level) + (when (cdr (cl-remove-if-not (lambda (obj) + (eq (oref obj command) command)) + transient--suffixes)) + (setq akey (cons command (this-command-keys)))))) + (setf (alist-get akey alist) level) + (setf (alist-get prefix transient-levels) alist)) + (transient-save-levels) + (transient--show)) + (t + (transient-undefined)))) (transient-define-suffix transient-toggle-level-limit () "Toggle whether to temporarily display suffixes on all levels." :description (lambda () (cond - (transient--all-levels-p - (format "Hide suffix %s" - (propertize - (format "levels > %s" (oref (transient-prefix-object) level)) - 'face 'transient-higher-level))) - ("Show all suffix levels"))) + (transient--all-levels-p + (format "Hide suffix %s" + (propertize + (format "levels > %s" (oref (transient-prefix-object) level)) + 'face 'transient-higher-level))) + ("Show all suffix levels"))) :transient t (interactive) (setq transient--all-levels-p (not transient--all-levels-p)) @@ -3695,13 +3697,13 @@ it\", in which case it is pointless to preserve history.)" 'transient--history)) (value (cond - (reader (funcall reader prompt initial-input history)) - (multi-value - (completing-read-multiple prompt choices nil nil - initial-input history)) - (choices - (completing-read prompt choices nil t initial-input history)) - ((read-string prompt initial-input history))))) + (reader (funcall reader prompt initial-input history)) + (multi-value + (completing-read-multiple prompt choices nil nil + initial-input history)) + (choices + (completing-read prompt choices nil t initial-input history)) + ((read-string prompt initial-input history))))) (cond ((and (equal value "") (not allow-empty)) (setq value nil)) ((and (equal value "\"\"") allow-empty) @@ -4097,17 +4099,19 @@ a string, using the empty string for the empty value, or nil if the option does not appear in ARGS. Append \"=\ to ARG to indicate that it is an option." - (if (string-suffix-p "=" arg) - (save-match-data - (and-let* ((match (let ((case-fold-search nil) - (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'" - (substring arg 0 -1)))) - (cl-find-if (lambda (a) - (and (stringp a) - (string-match re a))) - args)))) - (or (match-string 1 match) ""))) - (and (member arg args) t))) + (save-match-data + (cond* + ((member arg args) t) + ((bind-and* + (_(string-suffix-p "=" arg)) + (match (let ((case-fold-search nil) + (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'" + (substring arg 0 -1)))) + (cl-find-if (lambda (a) + (and (stringp a) + (string-match re a))) + args)))) + (match-string 1 match))))) ;;;; Return @@ -4177,21 +4181,23 @@ be non-nil. If either is non-nil, try the following in order: class definition or using its `transient-init-scope' method. If no prefix matches, return nil." - (if (or prefixes classes) - (let ((prefixes (ensure-list prefixes)) - (type (if (symbolp classes) classes (cons 'or classes)))) - (if-let* ((obj (cl-flet ((match (obj) - (and obj - (or (memq (oref obj command) prefixes) - (cl-typep obj type)) - obj))) - (or (match transient-current-prefix) - (match transient--prefix))))) - (oref obj scope) - (and (get (car prefixes) 'transient--prefix) - (oref (transient--init-prefix (car prefixes)) scope)))) - (and-let* ((obj (transient-prefix-object))) - (oref obj scope)))) + (cond* + ((or prefixes classes) + (let* ((prefixes (ensure-list prefixes)) + (type (if (symbolp classes) classes (cons 'or classes))) + (match (lambda (obj) + (and obj + (or (memq (oref obj command) prefixes) + (cl-typep obj type)) + obj)))) + (cond* + ((bind-and* (obj (or (funcall match transient-current-prefix) + (funcall match transient--prefix)))) + (oref obj scope)) + ((get (car prefixes) 'transient--prefix) + (oref (transient--init-prefix (car prefixes)) scope))))) + ((bind-and* (obj (transient-prefix-object))) + (oref obj scope)))) ;;;; History @@ -4309,15 +4315,15 @@ have a history of their own.") (and (minibuffer-selected-window) (selected-window)))) (cond - ((eq (car (window-parameter win 'quit-restore)) 'other) - ;; Window used to display another buffer. - (set-window-parameter win 'no-other-window - (window-parameter win 'prev--no-other-window)) - (set-window-parameter win 'prev--no-other-window nil)) - ((with-demoted-errors "Error while exiting transient: %S" - (if (window-parent win) - (delete-window win) - (delete-frame (window-frame win) t))))) + ((eq (car (window-parameter win 'quit-restore)) 'other) + ;; Window used to display another buffer. + (set-window-parameter win 'no-other-window + (window-parameter win 'prev--no-other-window)) + (set-window-parameter win 'prev--no-other-window nil)) + ((with-demoted-errors "Error while exiting transient: %S" + (if (window-parent win) + (delete-window win) + (delete-frame (window-frame win) t))))) (when remain-in-minibuffer-window (select-window remain-in-minibuffer-window)))) (when (buffer-live-p transient--buffer) @@ -4576,49 +4582,49 @@ as a button." (let ((len (length transient--redisplay-key)) (seq (cl-coerce (edmacro-parse-keys key t) 'list))) (cond - ((member (seq-take seq len) - (list transient--redisplay-key - (thread-last transient--redisplay-key - (cl-substitute ?- 'kp-subtract) - (cl-substitute ?= 'kp-equal) - (cl-substitute ?+ 'kp-add)))) - (let ((pre (key-description (vconcat (seq-take seq len)))) - (suf (key-description (vconcat (seq-drop seq len))))) - (setq pre (string-replace "RET" "C-m" pre)) - (setq pre (string-replace "TAB" "C-i" pre)) - (setq suf (string-replace "RET" "C-m" suf)) - (setq suf (string-replace "TAB" "C-i" suf)) - ;; We use e.g., "-k" instead of the more correct "- k", - ;; because the former is prettier. If we did that in - ;; the definition, then we want to drop the space that - ;; is reinserted above. False-positives are possible - ;; for silly bindings like "-C-c C-c". - (unless (string-search " " key) - (setq pre (string-replace " " "" pre)) - (setq suf (string-replace " " "" suf))) - (concat (propertize pre 'face 'transient-unreachable-key) - (and (string-prefix-p (concat pre " ") key) " ") - (propertize suf 'face (transient--key-face cmd key)) - (save-excursion - (and (string-match " +\\'" key) - (propertize (match-string 0 key) - 'face 'fixed-pitch)))))) - ((transient--lookup-key transient-sticky-map (kbd key)) - (propertize key 'face (transient--key-face cmd key))) - (t - (propertize key 'face 'transient-unreachable-key)))) + ((member (seq-take seq len) + (list transient--redisplay-key + (thread-last transient--redisplay-key + (cl-substitute ?- 'kp-subtract) + (cl-substitute ?= 'kp-equal) + (cl-substitute ?+ 'kp-add)))) + (let ((pre (key-description (vconcat (seq-take seq len)))) + (suf (key-description (vconcat (seq-drop seq len))))) + (setq pre (string-replace "RET" "C-m" pre)) + (setq pre (string-replace "TAB" "C-i" pre)) + (setq suf (string-replace "RET" "C-m" suf)) + (setq suf (string-replace "TAB" "C-i" suf)) + ;; We use e.g., "-k" instead of the more correct "- k", + ;; because the former is prettier. If we did that in + ;; the definition, then we want to drop the space that + ;; is reinserted above. False-positives are possible + ;; for silly bindings like "-C-c C-c". + (unless (string-search " " key) + (setq pre (string-replace " " "" pre)) + (setq suf (string-replace " " "" suf))) + (concat (propertize pre 'face 'transient-unreachable-key) + (and (string-prefix-p (concat pre " ") key) " ") + (propertize suf 'face (transient--key-face cmd key)) + (save-excursion + (and (string-match " +\\'" key) + (propertize (match-string 0 key) + 'face 'fixed-pitch)))))) + ((transient--lookup-key transient-sticky-map (kbd key)) + (propertize key 'face (transient--key-face cmd key))) + (t + (propertize key 'face 'transient-unreachable-key)))) (propertize key 'face (transient--key-face cmd key))))) (cl-defmethod transient-format-key :around ((obj transient-argument)) "Handle `transient-highlight-mismatched-keys'." (let ((key (cl-call-next-method obj))) (cond - ((not transient-highlight-mismatched-keys) key) - ((not (slot-boundp obj 'shortarg)) - (transient--add-face key 'transient-nonstandard-key)) - ((not (string-equal key (oref obj shortarg))) - (transient--add-face key 'transient-mismatched-key)) - (key)))) + ((not transient-highlight-mismatched-keys) key) + ((not (slot-boundp obj 'shortarg)) + (transient--add-face key 'transient-nonstandard-key)) + ((not (string-equal key (oref obj shortarg))) + (transient--add-face key 'transient-mismatched-key)) + (key)))) (cl-defgeneric transient-format-description (obj) "Format OBJ's `description' for display and return the result.") @@ -4631,7 +4637,7 @@ and its value is returned to the caller." (cl-defmethod transient-format-description ((obj transient-value-preset)) (pcase-let* (((eieio description key set) obj) - ((eieio value) transient--prefix) + (value (transient--get-extended-value)) (active (seq-set-equal-p set value))) (format "%s %s" @@ -4752,23 +4758,24 @@ apply the face `transient-unreachable' to the complete string." (propertize "|" 'face 'transient-delimiter)))))) (cl-defmethod transient--get-description ((obj transient-child)) - (and-let* ((desc (oref obj description))) - (if (functionp desc) - (if (= (car (transient--func-arity desc)) 1) - (funcall desc obj) - (funcall desc)) - desc))) + (cond* + ((bind* (desc (oref obj description)))) + ((functionp desc) + (condition-case nil + (funcall desc obj) + (wrong-number-of-arguments (funcall desc)))) + (desc))) (cl-defmethod transient--get-face ((obj transient-suffix) slot) - (and-let* ((_(slot-boundp obj slot)) - (face (slot-value obj slot))) - (if (and (not (facep face)) - (functionp face)) - (let ((transient--pending-suffix obj)) - (if (= (car (transient--func-arity face)) 1) - (funcall face obj) - (funcall face))) - face))) + (cond* + ((not (slot-boundp obj slot)) nil) + ((bind* (face (slot-value obj slot)))) + ((facep face) face) + ((functionp face) + (let ((transient--pending-suffix obj)) + (condition-case nil + (funcall face obj) + (wrong-number-of-arguments (funcall face))))))) (defun transient--add-face (string face &optional append beg end) (let ((str (copy-sequence string))) @@ -4875,7 +4882,7 @@ prefix method." ((eq this-command 'transient-help) (transient-show-help transient--prefix)) ((bind-and* (prefix (get (oref obj command) 'transient--prefix)) - (n/a (not (eq (oref transient--prefix command) this-command)))) + (_(not (eq (oref transient--prefix command) this-command)))) (transient-show-help prefix)) ((bind-and* (show-help (oref obj show-help))) (funcall show-help obj)) @@ -5116,20 +5123,20 @@ See `forward-button' for information about N." (defun transient--goto-button (command) (cond - ((stringp command) - (when (re-search-forward (concat "^" (regexp-quote command)) nil t) - (goto-char (match-beginning 0)))) - (command - (cl-flet ((found () - (and-let* ((button (button-at (point)))) - (eq (button-get button 'command) command)))) - (while (and (ignore-errors (forward-button 1)) - (not (found)))) - (unless (found) - (goto-char (point-min)) - (ignore-errors (forward-button 1)) - (unless (found) - (goto-char (point-min)))))))) + ((stringp command) + (when (re-search-forward (concat "^" (regexp-quote command)) nil t) + (goto-char (match-beginning 0)))) + (command + (cl-flet ((found () + (and-let* ((button (button-at (point)))) + (eq (button-get button 'command) command)))) + (while (and (ignore-errors (forward-button 1)) + (not (found)))) + (unless (found) + (goto-char (point-min)) + (ignore-errors (forward-button 1)) + (unless (found) + (goto-char (point-min)))))))) (defun transient--heading-at-point () (and (eq (get-text-property (point) 'face) 'transient-heading) @@ -5253,7 +5260,7 @@ that binding back, then call this function in your init file like so: Individual transients may already bind \\`q' to something else and such a binding would shadow the quit binding. If that is the case then \\`Q' is bound to whatever \\`q' would have been bound -to by setting `transient-substitute-key-function' to a function +to, by setting `transient-substitute-key-function' to a function that does that. Of course \\`Q' may already be bound to something else, so that function binds \\`M-q' to that command instead. Of course \\`M-q' may already be bound to something else, but @@ -5275,9 +5282,6 @@ we stop there." (face-remap-reset-base 'default) (face-remap-add-relative 'default 'fixed-pitch)) -(defun transient--func-arity (fn) - (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn)))) - (defun transient--seq-reductions-from (function sequence initial-value) (let ((acc (list initial-value))) (seq-doseq (elt sequence) @@ -5373,7 +5377,11 @@ as stand-in for elements of exhausted lists." ;;;; _ (provide 'transient) ;; Local Variables: -;; indent-tabs-mode: nil ;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") +;; indent-tabs-mode: nil +;; lisp-indent-local-overrides: ( +;; (cond . 0) +;; (cond* . 0) +;; (interactive . 0)) ;; End: ;;; transient.el ends here From b64e39f1b9a418fda213da8781bb37995c796d3c Mon Sep 17 00:00:00 2001 From: JD Smith Date: Sun, 4 Jan 2026 18:56:19 -0500 Subject: [PATCH 035/325] repeat: handle non-character keys with hint strings When a repeat hint string exists, the hint is formatted using `read-multiple-choice' formatting. But `rmc--add-key-description' only works on characters, not symbols like 'right or 'left. * lisp/repeat.el (repeat-echo-message-string): check for chars --- lisp/repeat.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/repeat.el b/lisp/repeat.el index 9ac72f50384..1b32558f426 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -591,14 +591,17 @@ This function can be used to force exit of repetition while it's active." (if-let* ((hint (and (symbolp cmd) (get cmd 'repeat-hint))) (last (aref key (1- (length key))))) - ;; Reuse `read-multiple-choice' formatting. - (if (= (length key) 1) + ;; Possibly reuse `read-multiple-choice' formatting. + (if (and (= (length key) 1) (characterp last)) (cdr (rmc--add-key-description (list last hint))) (format "%s (%s)" (propertize (key-description key) 'face 'read-multiple-choice-face) - (cdr (rmc--add-key-description - (list (event-basic-type last) hint))))) + (if (characterp (event-basic-type last)) + (cdr (rmc--add-key-description + (list (event-basic-type last) hint))) + hint))) + ;; No hint (propertize (key-description key) 'face 'read-multiple-choice-face)))) keys ", ") From 68418691267ad7cdbb2c5f0462a4f906e112f861 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 5 Jan 2026 09:29:09 +0100 Subject: [PATCH 036/325] In Elisp manual warn about unpredictable changes of point (Bug#79927) * doc/lispref/positions.texi (Point): Define "buffer point". * doc/lispref/windows.texi (Window Point): Say that buffer point can change in unpredictable ways when windows get selected (Bug#79927). --- doc/lispref/positions.texi | 16 ++++++++++------ doc/lispref/windows.texi | 12 ++++++++++++ 2 files changed, 22 insertions(+), 6 deletions(-) diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi index 89fdca1791e..9fcffee2ee0 100644 --- a/doc/lispref/positions.texi +++ b/doc/lispref/positions.texi @@ -57,14 +57,18 @@ buffer size plus 1. If narrowing is in effect (@pxref{Narrowing}), then point is constrained to fall within the accessible portion of the buffer (possibly at one end of it). +@cindex buffer point Each buffer has its own value of point, which is independent of the value of point in other buffers. Each window also has a value of point, -which is independent of the value of point in other windows on the same -buffer. This is why point can have different values in various windows -that display the same buffer. When a buffer appears in only one window, -the buffer's point and the window's point normally have the same value, -so the distinction is rarely important. @xref{Window Point}, for more -details. +which is independent of the value of point in other windows showing the +same buffer. This is why the cursor may appear at different positions +in various windows that display the same buffer. Wherever necessary, we +use the terms @dfn{buffer point} for the unique position of point of a +specific buffer and the term @dfn{window point} for the position of +point in a specific window showing that buffer. When a buffer appears +in only one window, its buffer's point and that window's point normally +have the same value, so the distinction is rarely important. +@xref{Window Point}, for more details. @defun point @cindex current buffer position diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 786308dc310..940f19985ea 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -5872,6 +5872,18 @@ the other windows are stored in those windows. @item As long as the selected window displays the current buffer, the window's point and the buffer's point always move together; they remain equal. + +@item +Many Emacs functions temporarily select a window in order to operate on +its contents. This will move the buffer point (@pxref{Point}) of that +window's buffer to the position of the window point of that window and +not restore the buffer point to its previous position when terminating +the temporary selection. This means that when one and the same buffer +is simultaneously displayed in more than one window, its buffer point +may change in unpredictable ways to the position of window point of any +of these windows as a side-effect of things like redisplay, calling +@code{with-selected-window} (@pxref{Selecting Windows}) or running +@code{window-configuration-change-hook} (@pxref{Window Hooks}). @end itemize @cindex cursor From 80360ec4a72ee107c480217587718f05db8865bb Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 5 Jan 2026 10:24:45 +0100 Subject: [PATCH 037/325] Fix calculation of outer frame height in NS builds (Bug#80077) * src/nsfns.m (frame_geometry): Include tool bar height when calculating a frame's outer height (Bug#80077). --- src/nsfns.m | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/nsfns.m b/src/nsfns.m index 8890a05e68f..4bd488478a8 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3479,16 +3479,17 @@ ATTRIBUTES return the outer edges of FRAME (Qouter_edges), the inner || EQ (fullscreen_symbol, Qfullscreen)); int border = fullscreen ? 0 : f->border_width; int title_height = fullscreen ? 0 : FRAME_NS_TITLEBAR_HEIGHT (f); + int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); int native_width = FRAME_PIXEL_WIDTH (f); int native_height = FRAME_PIXEL_HEIGHT (f); int outer_width = native_width + 2 * border; - int outer_height = native_height + 2 * border + title_height; + int outer_height + = native_height + 2 * border + title_height + tool_bar_height; int native_left = f->left_pos + border; int native_top = f->top_pos + border + title_height; int native_right = f->left_pos + outer_width - border; int native_bottom = f->top_pos + outer_height - border; int internal_border_width = FRAME_INTERNAL_BORDER_WIDTH (f); - int tool_bar_height = FRAME_TOOLBAR_HEIGHT (f); int tool_bar_width = (tool_bar_height ? outer_width - 2 * internal_border_width : 0); From 3ffbc5a70943970c2be807a81c9cdaf0af251117 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Mon, 5 Jan 2026 18:30:10 +0100 Subject: [PATCH 038/325] Fix typo in 'set-frame-size-and-position' * lisp/frame.el (set-frame-size-and-position): Fix typo. Reported by Al Haji-Ali . --- lisp/frame.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/frame.el b/lisp/frame.el index b9e47175f66..d1b70a78c66 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1667,7 +1667,7 @@ resize and move FRAME." (setq text-height (- (round (* height parent-or-workarea-height)) outer-minus-text-height))) - (width + (height (user-error "Invalid height specification"))) (cond From d55a455ec282aef56ee083b5197ea8f769735808 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Mon, 5 Jan 2026 17:41:01 +0000 Subject: [PATCH 039/325] Eglot: prevent textDocument/diagnostic from being sent before didOpen Set eglot--docver to -1 in LSP documents not yet 'didOpen'ed, then add a check for this in the jsonrpc-connection-ready-p predicate. We do this because the call to eglot-flymake-backend may come in so fast that textDocument/diagnostic actually makes it into the jsonrpc queue before the didOpen. Much like, say, completions before didChange, some servers don't like that, understandibly. So use the existing "deferred" mechanism checks to make sure, as usual, that requests targetting a specific LSP document come after the didOpen/didChange informing the server of the actual state of the buffer. I _could_ have used nil instead of -1, and it would probably be cleaner. But -1 is safer, we never know if a version comparison won't slip outside the didOpen period. Might change my mind about this. * lisp/progmodes/eglot.el (eglot--docver): Init to -1. (eglot--managed-mode): Set eglot--docver to -1 when unmanaging. (jsonrpc-connection-ready-p): Check eglot--docver non-negative. (eglot--signal-textDocument/didClose): Set eglot--docver to -1. --- lisp/progmodes/eglot.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 94e6c175be2..00f549937d5 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1309,7 +1309,7 @@ If optional MARKERS, make markers instead." (cl-defmethod initialize-instance :before ((_server eglot-lsp-server) &optional args) (cl-remf args :initializationOptions)) -(defvar-local eglot--docver 0 +(defvar-local eglot--docver -1 "LSP document version. Bumped on `eglot--after-change'.") (defvar eglot--servers-by-project (make-hash-table :test #'equal) @@ -2286,6 +2286,7 @@ LSP Document version reported for DIAGNOSTICS (comparable to (eldoc-mode 1)) (cl-pushnew (current-buffer) (eglot--managed-buffers (eglot-current-server)))) (t + (setq eglot--docver -1) (eglot-inlay-hints-mode -1) (eglot-semantic-tokens-mode -1) (eglot--delete-overlays 'eglot--overlay) @@ -2952,7 +2953,7 @@ buffer." (cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what) "Tell if SERVER is ready for WHAT in current buffer." - (and (cl-call-next-method) (not eglot--recent-changes))) + (and (cl-call-next-method) (not (cl-minusp eglot--docver)) (not eglot--recent-changes))) (defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.") @@ -3158,6 +3159,7 @@ When called interactively, use the currently active server" (defun eglot--signal-textDocument/didClose () "Send textDocument/didClose to server." + (setq eglot--docver -1) (with-demoted-errors "[eglot] error sending textDocument/didClose: %s" (jsonrpc-notify From 28fe937d5d312246706060b80ba7e11a9ab9fe38 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 5 Jan 2026 21:39:42 +0200 Subject: [PATCH 040/325] ; * lisp/treesit.el (treesit-font-lock-level): Doc fix. (Bug#80136) --- lisp/treesit.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index 4421523d0be..120b668bba0 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1469,7 +1469,10 @@ done via `customize-variable'. To see which syntactical categories are fontified by each level in a particular major mode, examine the buffer-local value of the -variable `treesit-font-lock-feature-list'." +variable `treesit-font-lock-feature-list'. + +Setting this variable directly with `setq' or `let' doesn't work; +use `setopt' or \\[customize-option] instead." :type 'integer :set #'treesit--font-lock-level-setter :version "29.1") From 381a76c72b419f5c8b5578550286a46d2c5cba53 Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Mon, 5 Jan 2026 15:07:04 -0800 Subject: [PATCH 041/325] ; Time Stamps doc: Expand examples, add summaries * doc/emacs/files.texi: (Time Stamps): Expand the examples and add node-end summaries. Thanks to Ruth for her help with the clarity of the documentation. --- doc/emacs/files.texi | 70 +++++++++++++++++++++++++++++++------------- 1 file changed, 49 insertions(+), 21 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index a7f5751ca4a..84d9c3b97ee 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1000,17 +1000,17 @@ File Shadowing is not available on MS Windows. @cindex modification dates @cindex last modified time -You can arrange to have a time stamp in a file be updated -automatically each time you save the file. -(A time stamp may also be called a date stamp or a last modified time.) Having a time stamp in the text of a file ensures that the time the file was written will be preserved even if the file is copied or transformed in a way that loses the file system's modification time. +A time stamp may also be called a date stamp or a last modified time. +You can arrange to have a time stamp in a file update +automatically each time you save the file. There are two steps to setting up automatic time stamping. -First, the file needs a time stamp template -somewhere in the first eight lines. -The template looks like this: +First, the file needs a time stamp template. +By default, the template occurs somewhere in the first eight lines +and looks like this: @example Time-stamp: <> @@ -1026,10 +1026,9 @@ Time-stamp: " " @findex time-stamp With that template in place, you can update the current buffer's time stamp once immediately with the command @kbd{M-x time-stamp}. -Emacs will check for a template; if a template is found, +The Emacs editor will check for a template; if a template is found, Emacs will write the current date, time, author, and/or -other info between the brackets or quotes. -(If the buffer has no template, @code{time-stamp} does nothing.) +other info between the angle brackets or quotes. After the first time stamp, the line might look like this: @example @@ -1039,13 +1038,25 @@ Time-stamp: <1993-07-06 11:05:14 terryg> Second, configure your Emacs to run @code{time-stamp} whenever it saves a file, by adding @code{time-stamp} to @code{before-save-hook} (@pxref{Hooks}). -You can either use @kbd{M-x customize-option} (@pxref{Specific -Customization}) to customize the option @code{before-save-hook}, -or you can edit your init file adding this line: +There are two ways to do this: you can +@itemize +@item +use @kbd{M-x customize-option} (@pxref{Specific Customization}) +to customize the option @code{before-save-hook}, or + +@item +edit your initialization file (@pxref{Init File}), +adding this line: @example (add-hook 'before-save-hook 'time-stamp) @end example +@end itemize + +Now every time you save a file, Emacs will look for a time stamp. +If the buffer has no template, @code{time-stamp} does nothing; +any file that does have a time stamp will have it kept up to date +automatically. @menu * Time Stamp Customization:: How to customize with time-stamp-pattern. @@ -1064,14 +1075,17 @@ identify a template and where in the file to look for the pattern using @code{time-stamp-pattern}; for details, see the variable's built-in documentation (with @kbd{C-h v}, @pxref{Name Help}). -As a simple example, if this line occurs near the top of a file: +As a simple example, suppose you want a manuscript to say the year +and city of publication. +You would like the year updated as you make revisions. +You could have this line near the top of a file: @example publishing_year_and_city = "Published nnnn in Boston, Mass."; @end example @noindent -then the following comment at the end of the same file tells +and the following comment at the end of the same file to tell @code{time-stamp} how to identify and update that custom template: @example @@ -1084,12 +1098,24 @@ then the following comment at the end of the same file tells This pattern says that the text before the start of the time stamp is ``Published '', and the text after the end is `` in Boston''. -If @code{time-stamp} finds both in one of the first eight lines, -what is between will be replaced by the current year, as requested by -the @code{%Y} format. +If @code{time-stamp} finds both the start and the end in one of the +first eight lines, +what is between will be updated as specified by the format, @code{%Y} in +this example. Since @code{%Y} requests the year, the result might look +like this: -After any change to file-local variables, -type @kbd{M-x normal-mode} to re-read them. +@example +publishing_year_and_city = "Published 2025 in Boston, Mass."; +@end example + +By specifying a format of @code{%Y}, we get exactly the year +substituted; other parts of the default format (day, time and +author) are not part of this example pattern and so do not appear in the +result. + +After changing the value of @code{time-stamp-pattern} +(or any file-local variable), +type @kbd{M-x normal-mode} so that Emacs notices. Here is another example, with the time stamp inserted into the last paragraph of an HTML document. @@ -1126,7 +1152,7 @@ for specifics on formatting and other variables that affect it. If you are working on a file with multiple authors, and you cannot be sure the other authors have enabled time-stamping globally in -their Emacs init files, you can force it to be enabled for a +their Emacs initialization files, you can force it to be enabled for a particular file by adding @code{time-stamp} to that buffer's @code{before-save-hook} in that file's local variables list. To extend one of the previous examples: @@ -1140,11 +1166,13 @@ To extend one of the previous examples: @end group @end example -@noindent Although this example shows them both set together, you can use @code{eval} without also setting @code{time-stamp-pattern} if you like the default pattern. +The extra arguments to @code{add-hook} used here, @code{nil} and @code{t}, +are necessary to have the added hook affect only this buffer. + @node Reverting @section Reverting a Buffer @findex revert-buffer From ba6e702bff4a00c73b9af3e785e71f1f49daeb5b Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Mon, 5 Jan 2026 15:19:41 -0800 Subject: [PATCH 042/325] time-stamp-helper-string-used: New test * test/lisp/time-stamp-tests.el (time-stamp-helper-string-used): New test. --- test/lisp/time-stamp-tests.el | 36 +++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el index 0c83e8cc80d..76126c77602 100644 --- a/test/lisp/time-stamp-tests.el +++ b/test/lisp/time-stamp-tests.el @@ -434,15 +434,15 @@ say EXPECTED should not be run through `format-time-string'." (do-one (lambda (conv expected reftime) `(,should-fn (time-stamp-test--string-equal - (time-stamp-string ,conv ,reftime) - ,(let ((fmt-form + (time-stamp-string ,conv ,reftime) + ,(let ((fmt-form (if literal expected `(format-time-string ,expected ,reftime time-stamp-time-zone)))) - (dolist (fn filter-list fmt-form) - (setq fmt-form `(funcall ',fn ,fmt-form)))) - )))) + (dolist (fn filter-list fmt-form) + (setq fmt-form `(funcall ',fn ,fmt-form)))) + )))) (result (list 'progn))) (when (memq :literal filter-list) (setq literal t) @@ -784,7 +784,7 @@ This is a separate function so it can have an `ert-explainer' property." (ert-deftest time-stamp-format-letter-case () "Test `time-stamp' upcase and downcase modifiers not tested elsewhere." (with-time-stamp-test-env - (time-stamp-test ("%*^A" "%*#A") "%^A") + (time-stamp-test-AB ("%*^A" "%*#A") "%^A") )) ;;; Tests of helper functions @@ -796,6 +796,30 @@ This is a separate function so it can have an `ert-explainer' property." (time-stamp-string time-stamp-format ref-time1))) (should (equal (time-stamp-string 'not-a-string ref-time1) nil)))) +(ert-deftest time-stamp-helper-string-used () + "Test that `time-stamp' uses `time-stamp-string'." + ;; Because the formatting tests use only time-stamp-string, we + ;; test that time-stamp-string is actually used by time-stamp. + (with-time-stamp-test-env + (let ((time-stamp-format "not the default string used %Y%%") + (ts-string-calls 0)) + (cl-letf (((symbol-function 'time-stamp-string) + (lambda (&optional ts-format _time) + (should (equal ts-format time-stamp-format)) + (incf ts-string-calls) + "tss-res"))) + (with-temp-buffer + ;; no template, no call to time-stamp-string expected + (time-stamp) + (should (= ts-string-calls 0)) + (should (equal (buffer-string) "")) + ;; with template, expect one call + (insert "Time-stamp: <>") + (time-stamp) + (should (= ts-string-calls 1)) + (should (equal (buffer-string) "Time-stamp: ")) + ))))) + (ert-deftest time-stamp-helper-zone-type-p () "Test `time-stamp-zone-type-p'." (should (time-stamp-zone-type-p t)) From fd1602796ac82bcd067ccf6ef763eb525a9e6abb Mon Sep 17 00:00:00 2001 From: Stephen Gildea Date: Mon, 5 Jan 2026 15:53:47 -0800 Subject: [PATCH 043/325] ; time-stamp-inserts-lines: Clearer doc string * lisp/time-stamp.el (time-stamp-inserts-lines): Clarify the two cases in the doc string. (time-stamp-count): Add xref to time-stamp-inserts-lines. --- lisp/time-stamp.el | 55 ++++++++++++++++++++++++++++++---------------- 1 file changed, 36 insertions(+), 19 deletions(-) diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index d401836fd4b..dc7c918816b 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -236,27 +236,43 @@ your init file, you would be incompatible with other people's files.") (defvar time-stamp-inserts-lines nil ;Do not change! "Whether \\[time-stamp] can change the number of lines in a file. -If nil, \\[time-stamp] skips as many lines as there are newlines in -`time-stamp-format' before looking for the `time-stamp-end' pattern, -thus it tries not to change the number of lines in the buffer. -If non-nil, \\[time-stamp] starts looking for the end pattern -immediately after the start pattern. This behavior can cause -unexpected changes in the buffer if used carelessly, but it is useful -for generating repeated time stamps. +When `time-stamp-format' contains newline characters, the intent +is ambiguous: does the author want to update a single multi-line +time stamp, or create a repeated time stamp by inserting new lines? +This variable controls the interpretation. + +If nil, `time-stamp' tries not to change the number of lines in the +buffer and treats the format as one single, multi-line time stamp. +The `time-stamp-end' must start N lines after the end of +`time-stamp-start', where N is the number of newlines in +`time-stamp-format'. + +If this variable is non-nil, `time-stamp' is willing to add lines +to the buffer. The end pattern must start somewhere in the +remainder of the same line where the start pattern ends. +This behavior lets a file accumulate repeated time stamps. + +In the most common case that `time-stamp-format' contains no +newlines, this variable has no effect; the end of the start +and the start of the end are always on the same line. These variables are best changed with file-local variables. -If you were to change `time-stamp-end' or `time-stamp-inserts-lines' in -your init file, you would be incompatible with other people's files.") +If you were to change `time-stamp-start', `time-stamp-end' or +`time-stamp-inserts-lines' in your init file, you would be +incompatible with other people's files.") ;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable #'booleanp) (defvar time-stamp-count 1 ;Do not change! "How many templates \\[time-stamp] will look for in a buffer. -If the value is greater than 1, the same time stamp will be written in -each case. If you want to insert different text on different lines, +If the value is greater than 1, the same time stamp will be +written in each case. + +If you want to insert different text on different lines, then instead of changing this variable, include a newline (written as \"\\n\") in `time-stamp-format' or the format part of `time-stamp-pattern'. +See the variable `time-stamp-inserts-lines'. `time-stamp-count' is best changed with a file-local variable. If you were to change it in your init file, you would be incompatible @@ -279,8 +295,8 @@ value of `time-stamp-line-limit' as the number. The second part is a regexp identifying the pattern preceding the time stamp. This part may be omitted to use the value of `time-stamp-start'. -The third part specifies the format of the time stamp inserted. Specify -this part as \"%%\" to use the value of `time-stamp-format'. +The third part specifies the format of the time stamp inserted. +This part may be \"%%\" to use the value of `time-stamp-format'. The fourth part is a regexp identifying the pattern following the time stamp. This part may be omitted to use the value of `time-stamp-end'. @@ -331,9 +347,9 @@ of the file before running this function, by default can look like one of the following (your choice): Time-stamp: <> Time-stamp: \" \" -This function writes the current time between the brackets or quotes, -by default formatted like this: - Time-stamp: <2024-08-07 17:10:21 gildea> +This function writes the current time between the angle brackets +or quotes, by default formatted like this: + Time-stamp: <2025-08-07 17:10:21 gildea> Although you can run this function manually to update a time stamp once, usually you want automatic time stamp updating. @@ -351,7 +367,8 @@ If the file has no time stamp template or if `time-stamp-active' is nil, this function does nothing. You can set `time-stamp-pattern' in a file's local variables list -to customize the information in the time stamp and where it is written." +to customize the information in the time stamp, the surrounding +template, and where in the file it can occur." (interactive) (let ((line-limit time-stamp-line-limit) (ts-start time-stamp-start) @@ -528,7 +545,7 @@ time is used. The time zone is determined by `time-stamp-time-zone'." ;;; ambiguous formats--formats that are changing (over time) incompatibly. (defun time-stamp-string-preprocess (format &optional time) - "Use a FORMAT to format date, time, file, and user information. + "Use FORMAT to format date, time, and user information. Optional second argument TIME is only for testing. This is an internal routine implementing extensions to `format-time-string' and all `time-stamp-format' compatibility." @@ -879,7 +896,7 @@ TYPE is :short for the unqualified name, :full for the full name." When non-nil, `time-stamp' warns about unstable and soon-to-be-changing conversions found in that buffer's `time-stamp-format' value. The warning is displayed only -when a buffer's time-stamp is updated; merely viewing a file +when a buffer's time stamp is updated; merely viewing a file does not warn. If nil, these warnings are disabled, which would be a bad idea. From db4ce0ddff86dd792ff8a4163aa6d96ff56dd094 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 5 Jan 2026 22:55:40 -0800 Subject: [PATCH 044/325] ; * lisp/treesit.el (treesit-font-lock-recompute-features): Fix doc. --- lisp/treesit.el | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index 120b668bba0..c72b3a39b2c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1699,15 +1699,16 @@ no match, return 3." (&optional add-list remove-list language) "Enable/disable font-lock features and validate and compile queries. -Enable each feature in ADD-LIST, disable each feature in -REMOVE-LIST. +When either ADD-LIST or REMOVE-LIST is non-nil, enable/disable features +according to ADD-LIST and REMOVE-LIST, on top of the currently enabled +features in the buffer. -If both ADD-LIST and REMOVE-LIST are omitted, recompute each -feature according to `treesit-font-lock-feature-list' and +If (and only if) both ADD-LIST and REMOVE-LIST are omitted, recompute +each feature according to `treesit-font-lock-feature-list' and `treesit-font-lock-level'. If the value of `treesit-font-lock-level', is N, then the features in the first N sublists of -`treesit-font-lock-feature-list' are enabled, and the rest of -the features are disabled. +`treesit-font-lock-feature-list' are enabled, and the rest of the +features are disabled. ADD-LIST and REMOVE-LIST are lists of feature symbols. The same feature symbol cannot appear in both lists; the function From 7653bdf63fdedae882a7ef7dde990b8de16088f0 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Mon, 5 Jan 2026 22:57:12 -0800 Subject: [PATCH 045/325] ; Add new functions to treesit-declare-unavailable-functions * lisp/treesit.el (treesit-declare-unavailable-functions): Add missing functions. --- lisp/treesit.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/treesit.el b/lisp/treesit.el index c72b3a39b2c..ee19606c1b2 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -78,7 +78,9 @@ in a Emacs not built with tree-sitter library." (declare-function treesit-node-p "treesit.c") (declare-function treesit-compiled-query-p "treesit.c") (declare-function treesit-query-p "treesit.c") + (declare-function treesit-query-eagerly-compiled-p "treesit.c") (declare-function treesit-query-language "treesit.c") + (declare-function treesit-query-source "treesit.c") (declare-function treesit-node-parser "treesit.c") @@ -88,8 +90,12 @@ in a Emacs not built with tree-sitter library." (declare-function treesit-parser-buffer "treesit.c") (declare-function treesit-parser-language "treesit.c") (declare-function treesit-parser-tag "treesit.c") + (declare-function treesit-parser-embed-level "treesit.c") + (declare-function treesit-parser-set-embed-level "treesit.c") + (declare-function treesit-parser-changed-regions "treesit.c") (declare-function treesit-parser-root-node "treesit.c") + (declare-function treesit-parse-string "treesit.c") (declare-function treesit-parser-set-included-ranges "treesit.c") (declare-function treesit-parser-included-ranges "treesit.c") @@ -994,9 +1000,6 @@ is nil." (null (treesit-parser-embed-level parser))))) parsers)) -(declare-function treesit-parser-set-embed-level "treesit.c") -(declare-function treesit-parser-embed-level "treesit.c") - (defun treesit--update-ranges-non-local ( host-parser query embed-lang modified-tick embed-level &optional beg end offset range-fn) @@ -2178,8 +2181,6 @@ parser." (signal 'treesit-no-parser nil)))) (car (treesit-parser-list)))) -(declare-function treesit-parser-changed-regions "treesit.c") - (defun treesit--pre-redisplay (&rest _) "Force a reparse on primary parser and mark regions to be fontified." (unless (eq treesit--pre-redisplay-tick (buffer-chars-modified-tick)) From d7a219ef776e363e25e6c1ac2c120b91815cf272 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Tue, 6 Jan 2026 09:52:04 +0100 Subject: [PATCH 046/325] ; Consistently use "window point" and "buffer point" in Elisp manual * doc/lispref/windows.texi (Window History, Window Point) (Window Configurations): * doc/lispref/processes.texi (Filter Functions): Consistently use "window point" and "buffer point" without "the" throughout descriptions. --- doc/lispref/processes.texi | 10 +++++----- doc/lispref/windows.texi | 18 +++++++++--------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index ee262a4eda0..555f795dcfd 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1842,11 +1842,11 @@ text arrives, you could insert a line like the following just before the To force point to the end of the new output, no matter where it was previously, eliminate the variable @code{moving} from the example and call @code{goto-char} unconditionally. Note that this doesn't -necessarily move the window point. The default filter actually uses -@code{insert-before-markers} which moves all markers, including the -window point. This may move unrelated markers, so it's generally -better to move the window point explicitly, or set its insertion type -to @code{t} (@pxref{Window Point}). +necessarily move window point. The default filter actually uses +@code{insert-before-markers} which moves all markers, including window +point. This may move unrelated markers, so it's generally better to +move window point explicitly, or set its insertion type to @code{t} +(@pxref{Window Point}). @ignore In earlier Emacs versions, every filter function that did regular diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 940f19985ea..169f15cc898 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4909,8 +4909,8 @@ Each list element has the form @code{(@var{buffer} @var{window-start} @var{window-pos})}, where @var{buffer} is a buffer previously shown in the window, @var{window-start} is the window start position (@pxref{Window Start and End}) when that buffer was last shown, and -@var{window-pos} is the point position (@pxref{Window Point}) when -that buffer was last shown in @var{window}. +@var{window-pos} is the window point position (@pxref{Window Point}) +when that buffer was last shown in @var{window}. The list is ordered so that earlier elements correspond to more recently-shown buffers, and the first element usually corresponds to the @@ -5857,8 +5857,8 @@ makes it useful to have multiple windows showing one buffer. @itemize @bullet @item -The window point is established when a window is first created; it is -initialized from the buffer's point, or from the window point of another +Window point is established when a window is first created; it is +initialized from the buffer's point, or from window point of another window opened on the buffer if such a window exists. @item @@ -5875,9 +5875,9 @@ point and the buffer's point always move together; they remain equal. @item Many Emacs functions temporarily select a window in order to operate on -its contents. This will move the buffer point (@pxref{Point}) of that -window's buffer to the position of the window point of that window and -not restore the buffer point to its previous position when terminating +its contents. This will move point (@pxref{Point}) of that +window's buffer to the position of window point of that window and +not restore buffer point to its previous position when terminating the temporary selection. This means that when one and the same buffer is simultaneously displayed in more than one window, its buffer point may change in unpredictable ways to the position of window point of any @@ -7314,8 +7314,8 @@ function may also delete windows which were found live by Each entry in the list that is passed as the second argument to the function is itself a list of six values: the window whose buffer was -found dead, the dead buffer or its name, the positions of window-start -(@pxref{Window Start and End}) and window-point (@pxref{Window Point}) +found dead, the dead buffer or its name, the positions of window start +(@pxref{Window Start and End}) and window point (@pxref{Window Point}) of the buffer in that window, the dedicated state of the window as previously reported by @code{window-dedicated-p} and a flag that is @code{t} if the window has been found to be alive by From 52e0c9eb2aff62f548bd9b846ce0308fbd9335bc Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Tue, 6 Jan 2026 10:05:51 +0100 Subject: [PATCH 047/325] ; Fix doc-string of Fset_frame_position * src/frame.c (Fset_frame_position): In doc-string say that for a child frame X and Y are relative to FRAME's parent frame. --- src/frame.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/frame.c b/src/frame.c index ec227ce276d..a03be0cd52f 100644 --- a/src/frame.c +++ b/src/frame.c @@ -4525,10 +4525,11 @@ DEFUN ("set-frame-position", Fset_frame_position, doc: /* Set position of FRAME to (X, Y). FRAME must be a live frame and defaults to the selected one. X and Y, if positive, specify the coordinate of the left and top edge of FRAME's -outer frame in pixels relative to an origin (0, 0) of FRAME's display. -If any of X or Y is negative, it specifies the coordinates of the right -or bottom edge of the outer frame of FRAME relative to the right or -bottom edge of FRAME's display. */) +outer frame in pixels relative to an origin (0, 0) of FRAME's display +or, if FRAME is a child frame, its parent frame. If any of X or Y is +negative, it specifies the coordinates of the right or bottom edge of +the outer frame of FRAME relative to the right or bottom edge of FRAME's +display or parent frame. */) (Lisp_Object frame, Lisp_Object x, Lisp_Object y) { struct frame *f = decode_live_frame (frame); From 8343ce6c52963f4fd89c0cc68557fb7a5fe04f1b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 6 Jan 2026 15:20:58 +0100 Subject: [PATCH 048/325] External Tramp methods can be used in multi-hops * doc/misc/tramp.texi (External methods): Mention, how external methods are used for multi-hops. (Ad-hoc multi-hops): Change requirement of method. * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.8.2-pre". * etc/NEWS: External Tramp methods can be used in multi-hops. Presentational fixes and improvements. * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): Check for `tramp-method-out-of-band-p' explicitly. Don't flush directory properties. (tramp-method-out-of-band-p): There shouldn't be a multi-hop. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory): Don't flush directory properties. * lisp/net/tramp.el (tramp-methods): Adapt docstring. (tramp-barf-if-file-missing) (with-parsed-tramp-file-name): Adapt debug spec. (tramp-skeleton-copy-directory): Flush directory properties. (tramp-add-hops): Check for `tramp-login-args' property. --- doc/misc/tramp.texi | 6 +- doc/misc/trampver.texi | 2 +- etc/NEWS | 37 +++++++------ lisp/net/tramp-sh.el | 121 +++++++++++++++++++++-------------------- lisp/net/tramp-smb.el | 7 +-- lisp/net/tramp.el | 20 ++++--- lisp/net/trampver.el | 6 +- 7 files changed, 104 insertions(+), 95 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index e76620bb6f2..c916588a060 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1132,9 +1132,11 @@ an external transfer program. External methods save on the overhead of encoding and decoding of inline methods. +@vindex tramp-copy-size-limit Since external methods have the overhead of opening a new channel, files smaller than @code{tramp-copy-size-limit} still use inline -methods. +methods. If an external method is used inside a multi-hop connection +(@pxref{Multi-hops}), its inherent inline method is used as well. @table @asis @cindex method @option{rcp} @@ -3891,7 +3893,7 @@ proxy @samp{bird@@bastion} to a remote file on @samp{you@@remotehost}: ssh@value{postfixhop}you@@remotehost@value{postfix}/path @key{RET}} @end example -Each involved method must be an inline method (@pxref{Inline methods}). +Each involved method must be handled by @value{tramp}'s @code{tramp-sh} backend. @value{tramp} adds the ad-hoc definitions as an ephemeral record to @code{tramp-default-proxies-alist}, which are available for reuse diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index ed18ab9bf4c..6eddd0e71c5 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -7,7 +7,7 @@ @c In the Tramp GIT, the version number and the bug report address @c are auto-frobbed from configure.ac. -@set trampver 2.8.1 +@set trampver 2.8.2-pre @set trampurl https://www.gnu.org/software/tramp/ @set tramp-bug-report-address tramp-devel@@gnu.org @set emacsver 28.1 diff --git a/etc/NEWS b/etc/NEWS index 1844eeb7bf5..7cc2cca65f8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -471,7 +471,7 @@ either resize the frame and change the fullscreen status accordingly or keep the frame size unchanged. The value t means to first reset the fullscreen status and then resize the frame. -*** New commands to set frame size and position in one compound step. +*** New functions to set frame size and position in one compound step. 'set-frame-size-and-position' sets the new size and position of a frame in one compound step. Both, size and position, can be specified as with the corresponding frame parameters 'width', 'height', 'left' and 'top'. @@ -493,7 +493,7 @@ an error when a frame of that name already exists. The frame parameter 'cloned-from' is set to the frame from which the new frame is cloned using the command 'clone-frame'. -The frame parameter 'undeleted is set to t when a frame is undeleted +The frame parameter 'undeleted' is set to t when a frame is undeleted using the command 'undelete-frame'. These are useful if you need to detect a cloned frame or undeleted frame @@ -1057,11 +1057,11 @@ The new variable 'forward-comment-function' is set to the new function 'treesit-forward-comment' if a major mode defines the thing 'comment'. +++ -*** New function 'treesit-query-eagerly-compiled-p' +*** New function 'treesit-query-eagerly-compiled-p'. This function returns non-nil if a query was eagerly compiled. +++ -*** New function 'treesit-query-source' +*** New function 'treesit-query-source'. This function returns the string or sexp source query of a compiled query. +++ @@ -1153,8 +1153,9 @@ convention. Also, the ':match?' predicate can now take the regexp as either the first or second argument, so it works with both tree-sitter convention (regexp arg second) and Emacs convention (regexp arg first). +** Track changes + +++ -** Track-changes *** New variable 'track-changes-undo-only' to distinguish undo changes. ** Hideshow @@ -1170,7 +1171,7 @@ blocks. This command hides or shows all the blocks in the current buffer. --- -*** 'hs-hide-level' no longer hide all the blocks in the current buffer. +*** 'hs-hide-level' no longer hides all the blocks in the current buffer. If 'hs-hide-level' was not inside a code block it would hide all the blocks in the buffer like 'hs-hide-all'. Now it should only hide all the second level blocks. @@ -1229,7 +1230,6 @@ buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp', *** 'hs-hide-level' and 'hs-cycle' can now hide comments too. This is controlled by 'hs-hide-comments-when-hiding-all'. - ** C-ts mode +++ @@ -1644,7 +1644,6 @@ is the default. This user option is in sympathy with recentf, and savehist autosave timers. - ** Savehist --- @@ -2014,7 +2013,7 @@ for docstrings where symbols 'nil' and 't' are in quotes. In most cases, having it enabled leads to a large amount of false positives. -*** New file-local variable 'lisp-indent-local-overrides' +*** New file-local variable 'lisp-indent-local-overrides'. This variable can be used to locally override the indent specification of symbols. @@ -2083,6 +2082,10 @@ connections after you close remote-file buffers without having to either cherry-pick via 'tramp-cleanup-connection' or clear them all via 'tramp-cleanup-all-connections'. ++++ +*** External methods can now be used in multi-hop connections. +This is implemented for 'tramp-sh' methods, like "/scp:user@host|sudo::". + +++ *** New command 'tramp-dired-find-file-with-sudo'. This command, bound to '@' in Dired, visits the file or directory on the @@ -2463,7 +2466,7 @@ appearance of the list can be customized with the new faces +++ *** Printing root branch logs has moved to 'C-x v b L'. -Previously the command to print the root log for a branch was bound to +Previously, the command to print the root log for a branch was bound to 'C-x v b l'. It has now been renamed from 'vc-print-branch-log' to 'vc-print-root-branch-log', and bound to 'C-x v b L'. This is more consistent with the rest of the 'C-x v' keymap, and makes room for a new @@ -2676,7 +2679,7 @@ bindings: *** New display of outgoing revisions count in VC Directory. If there are outgoing revisions, VC Directory now includes a count of how many in its headers, to remind you to push them. -You can disable this by customizing vc-dir-show-outgoing-count to nil. +You can disable this by customizing 'vc-dir-show-outgoing-count' to nil. +++ *** New user option 'vc-async-checkin' to enable async checkin operations. @@ -3312,7 +3315,7 @@ the source, or to 'antlr-v3' otherwise. *** New command 'antlr-v4-mode' is a derived mode of 'antlr-mode'. It sets 'antlr-tool-version' to value 'antlr-v4', and is automatically -used for files with extension "g4". +used for files with extension ".g4". *** The variable 'antlr-language' is now used more generally. The variable has a symbol as value which determines which of the @@ -3325,8 +3328,8 @@ ObjC, Python and Ruby, additional to Java and Cpp. *** New user option 'antlr-run-tool-on-buffer-file'. Command 'antlr-run-tool' now usually runs on the file for the current -buffer. Customize this user option to have value ' nil' to get the -previous behavior back. +buffer. Customize this user option to nil to get the previous behavior +back. ** Hi Lock @@ -3497,8 +3500,8 @@ separator, are also supported. --- ** The experimental variable 'binary-as-unsigned' has been removed. -Instead of (let ((binary-as-unsigned t)) (format "%x" N)) you can use -(format "%x" (logand N MASK)) where MASK is for the desired word size, +Instead of '(let ((binary-as-unsigned t)) (format "%x" N))' you can use +'(format "%x" (logand N MASK))' where MASK is for the desired word size, e.g., #x3fffffffffffffff for typical Emacs fixnums. +++ @@ -3862,7 +3865,7 @@ called on progress steps, and DONE-CALLBACK, called when the progress reporter is done. See the 'make-progress-reporter' docstring for a full specification of these new optional arguments. -** Add binary format specifications '%b' and '%B'. +** Binary format specifications '%b' and '%B' added. These produce the binary representation of a number. '%#b' and '%#B' prefix the bits with '0b' and '0B', respectively. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e7e21684298..97b72ba00ad 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2098,66 +2098,67 @@ ID-FORMAT valid values are `string' and `integer'." "Like `copy-directory' for Tramp files." (tramp-skeleton-copy-directory dirname newname keep-date parents copy-contents - (let ((t1 (tramp-tramp-file-p dirname)) - (t2 (tramp-tramp-file-p newname)) - target) - (with-parsed-tramp-file-name (if t1 dirname newname) nil - (cond - ((and copy-directory-create-symlink - (setq target (file-symlink-p dirname)) - (tramp-equal-remote dirname newname)) - (make-symbolic-link - target - (if (directory-name-p newname) - (concat newname (file-name-nondirectory dirname)) newname) - t)) + (let* ((v1 (and (tramp-tramp-file-p dirname) + (tramp-dissect-file-name dirname))) + (v2 (and (tramp-tramp-file-p newname) + (tramp-dissect-file-name newname))) + (v (or v1 v2)) + target) + (cond + ((and copy-directory-create-symlink + (setq target (file-symlink-p dirname)) + (tramp-equal-remote dirname newname)) + (make-symbolic-link + target + (if (directory-name-p newname) + (concat newname (file-name-nondirectory dirname)) newname) + t)) - ;; Shortcut: if method, host, user are the same for both - ;; files, we invoke `cp' on the remote host directly. - ((and (not copy-contents) - (tramp-equal-remote dirname newname)) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-already-exists newname)) - (setq dirname (directory-file-name (expand-file-name dirname)) - newname (directory-file-name (expand-file-name newname))) - (tramp-do-copy-or-rename-file-directly - 'copy dirname newname - 'ok-if-already-exists keep-date 'preserve-uid-gid)) + ;; Shortcut: if method, host, user are the same for both files, + ;; we invoke `cp' on the remote host directly. + ((and (not copy-contents) + (tramp-equal-remote dirname newname)) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) + (setq dirname (directory-file-name (expand-file-name dirname)) + newname (directory-file-name (expand-file-name newname))) + (tramp-do-copy-or-rename-file-directly + 'copy dirname newname + 'ok-if-already-exists keep-date 'preserve-uid-gid)) - ;; scp or rsync DTRT. - ((and (not copy-contents) - (tramp-get-method-parameter v 'tramp-copy-recursive) - ;; When DIRNAME and NEWNAME are remote, they must have - ;; the same method. - (or (null t1) (null t2) - (string-equal - (tramp-file-name-method (tramp-dissect-file-name dirname)) - (tramp-file-name-method (tramp-dissect-file-name newname))))) - (when (and (file-directory-p newname) - (not (directory-name-p newname))) - (tramp-error v 'file-already-exists newname)) - (setq dirname (directory-file-name (expand-file-name dirname)) - newname (directory-file-name (expand-file-name newname))) - (when (and (file-directory-p newname) - (not (string-equal (file-name-nondirectory dirname) - (file-name-nondirectory newname)))) - (setq newname - (expand-file-name (file-name-nondirectory dirname) newname))) - (unless (file-directory-p (file-name-directory newname)) - (make-directory (file-name-directory newname) parents)) - (tramp-do-copy-or-rename-file-out-of-band - 'copy dirname newname 'ok-if-already-exists keep-date)) + ;; scp or rsync DTRT. + ((and (not copy-contents) + (tramp-get-method-parameter v 'tramp-copy-recursive) + ;; When DIRNAME and NEWNAME are remote, they must have + ;; the same method. None of them must be multi-hop. + (or (and (null v1) (tramp-method-out-of-band-p v2 0)) + (and (null v2) (tramp-method-out-of-band-p v1 0)) + (and v1 v2 + (tramp-method-out-of-band-p v1 0) + (tramp-method-out-of-band-p v2 0) + (string-equal + (tramp-file-name-method v1) + (tramp-file-name-method v2))))) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) + (setq dirname (directory-file-name (expand-file-name dirname)) + newname (directory-file-name (expand-file-name newname))) + (when (and (file-directory-p newname) + (not (string-equal (file-name-nondirectory dirname) + (file-name-nondirectory newname)))) + (setq newname + (expand-file-name (file-name-nondirectory dirname) newname))) + (unless (file-directory-p (file-name-directory newname)) + (make-directory (file-name-directory newname) parents)) + (tramp-do-copy-or-rename-file-out-of-band + 'copy dirname newname 'ok-if-already-exists keep-date)) - ;; We must do it file-wise. - (t (tramp-run-real-handler - #'copy-directory - (list dirname newname keep-date parents copy-contents)))) - - ;; NEWNAME has wrong cached values. - (when t2 - (with-parsed-tramp-file-name (expand-file-name newname) nil - (tramp-flush-file-properties v localname))))))) + ;; We must do it file-wise. + (t (tramp-run-real-handler + #'copy-directory + (list dirname newname keep-date parents copy-contents))))))) (defun tramp-sh-handle-rename-file (filename newname &optional ok-if-already-exists) @@ -5679,7 +5680,11 @@ raises an error." (and ;; It shall be an out-of-band method. (tramp-get-method-parameter vec 'tramp-copy-program) - ;; There must be a size, otherwise the file doesn't exist. + ;; There shouldn't be a multi-hop. + (or (not (tramp-multi-hop-p vec)) + (null (cdr (tramp-compute-multi-hops vec)))) + ;; There must be a SIZE, otherwise the file doesn't exist. A zero + ;; SIZE is used for directories. (numberp size) ;; Either the file size is large enough, or (in rare cases) there ;; does not exist a remote encoding. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 076f18bb391..10ab64929eb 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -577,12 +577,7 @@ arguments to pass to the OPERATION." ;; Set the mode. (unless keep-date - (set-file-modes newname (tramp-default-file-modes dirname))) - - ;; When newname did exist, we have wrong cached values. - (when t2 - (with-parsed-tramp-file-name newname nil - (tramp-flush-file-properties v localname)))) + (set-file-modes newname (tramp-default-file-modes dirname)))) ;; We must do it file-wise. (t diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ebbe6df06a8..1614fe5f7a3 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -296,9 +296,8 @@ pair of the form (KEY VALUE). The following KEYs are defined: - \"%a\" adds the pseudo-terminal allocation argument \"-t\" in asynchronous processes, if the connection type is not `pipe'. - The existence of `tramp-login-args', combined with the - absence of `tramp-copy-args', is an indication that the - method is capable of multi-hops. + The existence of `tramp-login-args' is an indication that the method + is capable of multi-hops. * `tramp-async-args' When an asynchronous process is started, we know already that @@ -2137,7 +2136,7 @@ of `current-buffer'." "Execute BODY and return the result. In case of an error, raise a `file-missing' error if FILENAME does not exist, otherwise propagate the error." - (declare (indent 2) (debug (tramp-file-name-p form &rest body))) + (declare (indent 2) (debug t)) (let ((err (make-symbol "err"))) `(condition-case ,err (let (signal-hook-function) ,@body) @@ -2176,7 +2175,7 @@ Remaining args are Lisp expressions to be evaluated (inside an implicit If VAR is nil, then we bind `v' to the structure and `method', `user', `domain', `host', `port', `localname', `hop' to the components." - (declare (indent 2) (debug (form symbolp &rest body))) + (declare (indent 2) (debug t)) (let ((bindings (mapcar (lambda (elem) @@ -3585,7 +3584,7 @@ User is always nil." ;;; Skeleton macros for file name handler functions. (defmacro tramp-skeleton-copy-directory - (directory _newname &optional _keep-date _parents _copy-contents &rest body) + (directory newname &optional _keep-date _parents _copy-contents &rest body) "Skeleton for `tramp-*-handle-copy-directory'. BODY is the backend specific code." (declare (indent 5) (debug t)) @@ -3596,7 +3595,12 @@ BODY is the backend specific code." (unless (file-exists-p ,directory) (tramp-error (tramp-dissect-file-name ,directory) 'file-missing ,directory)) - ,@body)) + ,@body + + ;; NEWNAME has wrong cached values. + (when (tramp-tramp-file-p ,newname) + (with-parsed-tramp-file-name (expand-file-name ,newname) nil + (tramp-flush-file-properties v localname))))) (defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) "Skeleton for `tramp-*-handle-delete-directory'. @@ -5148,7 +5152,7 @@ Do not set it manually, it is used buffer-local in `tramp-get-lock-pid'.") "Whether the method of VEC is capable of multi-hops." (let ((tramp-verbose 0)) (and (tramp-sh-file-name-handler-p vec) - (not (tramp-get-method-parameter vec 'tramp-copy-program))))) + (tramp-get-method-parameter vec 'tramp-login-args)))) (defun tramp-add-hops (vec) "Add ad-hoc proxy definitions to `tramp-default-proxies-alist'." diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index f813fe869d4..b900ab377aa 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.8.1 +;; Version: 2.8.2-pre ;; Package-Requires: ((emacs "28.1")) ;; Package-Type: multi ;; URL: https://www.gnu.org/software/tramp/ @@ -40,7 +40,7 @@ ;; ./configure" to change them. ;;;###tramp-autoload -(defconst tramp-version "2.8.1" +(defconst tramp-version "2.8.2-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -76,7 +76,7 @@ ;; Check for Emacs version. (let ((x (if (not (string-version-lessp emacs-version "28.1")) "ok" - (format "Tramp 2.8.1 is not fit for %s" + (format "Tramp 2.8.2-pre is not fit for %s" (replace-regexp-in-string "\n" "" (emacs-version)))))) (unless (string-equal "ok" x) (error "%s" x))) From 073455ccb8024d1ce1a46305913390a193136429 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 6 Jan 2026 23:06:06 -0500 Subject: [PATCH 049/325] (package-install): Refine fix for bug#79881 * lisp/emacs-lisp/package.el (package-install): Demote `user-error` to `message` if the call is not interactive. --- lisp/emacs-lisp/package.el | 46 ++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 54e905109b3..9ba9cb1827f 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2250,7 +2250,7 @@ package archive." :version "29.1") ;;;###autoload -(defun package-install (pkg &optional dont-select) +(defun package-install (pkg &optional dont-select interactive) "Install the package PKG. PKG can be a `package-desc', or a symbol naming one of the available @@ -2278,33 +2278,35 @@ had been enabled." "Install package: " package-archive-contents nil t)) - nil))) + nil + 'interactive))) (cl-check-type pkg (or symbol package-desc)) (package--archives-initialize) (add-hook 'post-command-hook #'package-menu--post-refresh) (let ((name (if (package-desc-p pkg) (package-desc-name pkg) pkg))) - (when (or (and package-install-upgrade-built-in - (package--active-built-in-p pkg)) - (package-installed-p pkg)) - (user-error "`%s' is already installed" name)) - (unless (or dont-select (package--user-selected-p name)) - (package--save-selected-packages - (cons name package-selected-packages))) - (when (and (or current-prefix-arg package-install-upgrade-built-in) - (package--active-built-in-p pkg)) - (setq pkg (or (cadr (assq name package-archive-contents)) pkg))) - (if-let* ((transaction - (if (package-desc-p pkg) - (unless (package-installed-p pkg) - (package-compute-transaction (list pkg) - (package-desc-reqs pkg))) - (package-compute-transaction () (list (list pkg)))))) - (progn - (package-download-transaction transaction) - (package--quickstart-maybe-refresh) - (message "Package `%s' installed." name))))) + (if (or (and package-install-upgrade-built-in + (package--active-built-in-p pkg)) + (package-installed-p pkg)) + (funcall (if interactive #'user-error #'message) + "`%s' is already installed" name) + (unless (or dont-select (package--user-selected-p name)) + (package--save-selected-packages + (cons name package-selected-packages))) + (when (and (or current-prefix-arg package-install-upgrade-built-in) + (package--active-built-in-p pkg)) + (setq pkg (or (cadr (assq name package-archive-contents)) pkg))) + (if-let* ((transaction + (if (package-desc-p pkg) + (unless (package-installed-p pkg) + (package-compute-transaction (list pkg) + (package-desc-reqs pkg))) + (package-compute-transaction () (list (list pkg)))))) + (progn + (package-download-transaction transaction) + (package--quickstart-maybe-refresh) + (message "Package `%s' installed." name)))))) (declare-function package-vc-upgrade "package-vc" (pkg)) From d7fd87b403d5b9ae0e2c2937ddd23e855f3263a2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Jan 2026 10:08:45 +0100 Subject: [PATCH 050/325] shadowfile.el uses eqhemeral buffer names now * etc/NEWS: shadowfile.el uses eqhemeral buffer names now. * lisp/shadowfile.el (shadow-find-file-noselect): New function. (shadow-read-files, shadow-write-info-file) (shadow-write-todo-file): Use it. --- etc/NEWS | 5 +++++ lisp/shadowfile.el | 16 ++++++++++++---- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 7cc2cca65f8..a9d5329bce8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3339,6 +3339,11 @@ If an active region exists, the commands 'hi-lock-line-face-buffer' and 'hi-lock-face-phrase-buffer' now use its contents as their default value. Previously, only 'hi-lock-face-buffer' supported this. +** Shadowfile + +*** 'shadow-info-buffer' and 'shadow-todo-buffer' use eqhemeral buffer names now. +This excludes the buffers from save buffer predicates. + * New Modes and Packages in Emacs 31.1 diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 7fd7dc94ad0..7f4f5b56a1f 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -667,6 +667,12 @@ PAIR must be `eq' to one of the elements of that list." (setq shadow-files-to-copy (cl-remove-if (lambda (s) (eq s pair)) shadow-files-to-copy))) +(defun shadow-find-file-noselect (filename &optional nowarn) + "Like `find-file-noselect', but make buffer name ephemeral." + (with-current-buffer (find-file-noselect filename nowarn) + (rename-buffer (format " *%s*" (buffer-name))) + (current-buffer))) + (defun shadow-read-files () "Visit and load `shadow-info-file' and `shadow-todo-file'. Thus restores shadowfile's state from your last Emacs session. @@ -682,7 +688,7 @@ Return t unless files were locked; then return nil." (save-current-buffer (when shadow-info-file (set-buffer (setq shadow-info-buffer - (find-file-noselect shadow-info-file 'nowarn))) + (shadow-find-file-noselect shadow-info-file 'nowarn))) (lisp-data-mode) (setq-local lexical-binding t) (when (and (not (buffer-modified-p)) @@ -695,7 +701,7 @@ Return t unless files were locked; then return nil." (eval-buffer)) (when shadow-todo-file (set-buffer (setq shadow-todo-buffer - (find-file-noselect shadow-todo-file 'nowarn))) + (shadow-find-file-noselect shadow-todo-file 'nowarn))) (lisp-data-mode) (setq-local lexical-binding t) (when (and (not (buffer-modified-p)) @@ -717,7 +723,8 @@ defined, the old hashtable info is invalid." (if shadow-info-file (save-current-buffer (if (not shadow-info-buffer) - (setq shadow-info-buffer (find-file-noselect shadow-info-file))) + (setq shadow-info-buffer + (shadow-find-file-noselect shadow-info-file))) (set-buffer shadow-info-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max)) @@ -730,7 +737,8 @@ defined, the old hashtable info is invalid." With non-nil argument also saves the buffer." (save-excursion (if (not shadow-todo-buffer) - (setq shadow-todo-buffer (find-file-noselect shadow-todo-file))) + (setq shadow-todo-buffer + (shadow-find-file-noselect shadow-todo-file))) (set-buffer shadow-todo-buffer) (setq buffer-read-only nil) (delete-region (point-min) (point-max)) From 68b6137eb028f692869a2722b5c9f297f9fd1c64 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Jan 2026 14:17:11 +0100 Subject: [PATCH 051/325] ; Fix typo --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index a9d5329bce8..f08766d986b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3341,7 +3341,7 @@ value. Previously, only 'hi-lock-face-buffer' supported this. ** Shadowfile -*** 'shadow-info-buffer' and 'shadow-todo-buffer' use eqhemeral buffer names now. +*** 'shadow-info-buffer' and 'shadow-todo-buffer' use ephemeral buffer names now. This excludes the buffers from save buffer predicates. From ba7c2debefdaf3faabd464694059438bbb510fa8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Jan 2026 10:55:11 -0500 Subject: [PATCH 052/325] * admin/notes/elpa.md: Update to match current reality * admin/notes/elpa: Rename to `elpa.md`. * admin/notes/elpa.md: Rename from `elpa`, adjust to recently changed repository location, mention the "new" NonGNU repository. --- admin/notes/elpa | 35 ----------------------------------- admin/notes/elpa.md | 43 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 43 insertions(+), 35 deletions(-) delete mode 100644 admin/notes/elpa create mode 100644 admin/notes/elpa.md diff --git a/admin/notes/elpa b/admin/notes/elpa deleted file mode 100644 index afcda71d1dd..00000000000 --- a/admin/notes/elpa +++ /dev/null @@ -1,35 +0,0 @@ -NOTES ON THE EMACS PACKAGE ARCHIVE - -The GNU Emacs package archive, at elpa.gnu.org, is managed using a Git -repository named "elpa", hosted on Savannah. To check it out: - - git clone https://git.savannah.gnu.org/git/emacs/elpa - cd elpa - make setup - -That leaves the elpa/packages directory empty; you must check out the -ones you want. - -If you wish to check out all the packages into the packages directory, -you can run the command: - - make worktrees - -You can check out a specific package into the packages -directory with: - - make packages/ - - -Changes to this repository propagate to elpa.gnu.org via a -"deployment" script run daily. This script generates the content -visible at https://elpa.gnu.org/packages. - -A new package is released as soon as the "version number" of that -package is changed. So you can use 'elpa' to work on a package -without fear of releasing those changes prematurely. And once the -code is ready, just bump the version number to make a new release of -the package. - -It is easy to use the elpa branch to deploy a "local" copy of the -package archive. For details, see the README file in the elpa branch. diff --git a/admin/notes/elpa.md b/admin/notes/elpa.md new file mode 100644 index 00000000000..791f0dec677 --- /dev/null +++ b/admin/notes/elpa.md @@ -0,0 +1,43 @@ +# NOTES ON THE EMACS PACKAGE ARCHIVE + +The Emacs package archives at `elpa.gnu.org` (GNU ELPA and NonGNU ELPA) +are managed using two Git repositories named `gnu.git` and `nongnu.git` +hosted in the `elpa` group on Savannah. +To check them out: + + git clone https://git.savannah.gnu.org/git/elpa/gnu.git + cd gnu + make setup + +resp. + + git clone https://git.savannah.gnu.org/git/elpa/nongnu.git + cd nongnu + make setup + +That leaves the `(non)gnu/packages` directory empty; you must check out the +ones you want. + +If you wish to check out all the packages into the packages directory, +you can run the command: + + make worktrees + +You can check out a specific package into the packages +directory with: + + make packages/ + +Changes to this repository propagate to `elpa.gnu.org` via a +"deployment" script run daily. This script generates the content +visible at https://elpa.gnu.org/packages and https://elpa.nongnu.org/nongnu + +A new package is released as soon as the "version number" of that +package is changed (as found in the `;; Version:` header of the main +ELisp file of the package). So you can use `elpa/(non)gnu.git` to work +on a package without fear of releasing those changes prematurely. +And once the code is ready, just bump the version number to make a new +release of the package. + +It is easy to use these repositories to deploy a "local" copy of the +package archive. For details, see the README file after cloning them. From b5b7504c730597dfaa88f9c681a4b3e2f5eefd44 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 7 Jan 2026 10:58:27 -0500 Subject: [PATCH 053/325] (package-test-install-single): Fix test failure * test/lisp/emacs-lisp/package-tests.el (package-test-install-single): We signal an error only for interactive calls now. --- test/lisp/emacs-lisp/package-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index cb78c1c2290..a8c34e8e45b 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -242,7 +242,7 @@ Must called from within a `tar-mode' buffer." (should (package-installed-p 'simple-single)) ;; Check if we properly report an "already installed". (should (condition-case nil - (progn (package-install 'simple-single) nil) + (progn (package-install 'simple-single nil 'interactive) nil) (user-error t))) (should (package-installed-p 'simple-single)) (let* ((simple-pkg-dir (file-name-as-directory From d5b9fc55792399e4b6565f83967a5a2363925bdc Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 7 Jan 2026 18:49:16 +0100 Subject: [PATCH 054/325] ; Fix last entry in etc/NEWS --- etc/NEWS | 1 - 1 file changed, 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index f08766d986b..564479d2b1d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3342,7 +3342,6 @@ value. Previously, only 'hi-lock-face-buffer' supported this. ** Shadowfile *** 'shadow-info-buffer' and 'shadow-todo-buffer' use ephemeral buffer names now. -This excludes the buffers from save buffer predicates. * New Modes and Packages in Emacs 31.1 From 804f9655773e03b5257eea112433457b4aa9959a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 7 Jan 2026 09:13:21 +0000 Subject: [PATCH 055/325] Unobsolete and autoload M-x eglot-manual, mention it in manual The only alternative I've found is M-: ( i n f o " ( e g l o t ) " ) RET which isn't really very user friendly. * lisp/progmodes/eglot.el (eglot-manual): Unobsolete. * doc/misc/eglot.texi (Top): Mention M-x eglot-manual. * etc/EGLOT-NEWS: Mention unobsoletion. --- doc/misc/eglot.texi | 4 +++- etc/EGLOT-NEWS | 5 +++++ lisp/progmodes/eglot.el | 5 ++--- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 5b5b3f98dc4..532416f17ad 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -87,7 +87,9 @@ Eglot itself is completely language-agnostic, but it can support any programming language for which there is a language server and an Emacs major mode. -This manual documents how to configure, use, and customize Eglot. +This manual documents how to configure, use, and customize Eglot. To +read this manual from within Emacs, type @kbd{M-x eglot-manual +@key{RET}}. @insertcopying diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 3d78a835469..9c7786f09b9 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -45,6 +45,11 @@ controlling which token types and modifiers to consider, as well as faces for customizing their appearance. The minor mode is on by default: consult the manual on how to turn it off. +** Reading the Eglot manual in Emacs is easy again + +The command 'M-x eglot-manual' is now easier to reach and directly drops +the user into the manual. + * Changes in Eglot 1.19 (23/10/2025) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 00f549937d5..8be3a459b95 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2402,9 +2402,8 @@ If it is activated, also signal textDocument/didOpen." (when update-mode-line (force-mode-line-update t))))))) -(defun eglot-manual () "Read Eglot's manual." - (declare (obsolete info "1.10")) - (interactive) (info "(eglot)")) +;;;###autoload +(defun eglot-manual () "Read Eglot's manual." (interactive) (info "(eglot)")) ;;;###autoload (defun eglot-upgrade-eglot (&rest _) "Update Eglot to latest version." From 7905fc4a3d961d4e686562190ba9ccc8fc099fae Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Jan 2026 17:50:25 -0500 Subject: [PATCH 056/325] trace.el: Avoid inf-loops when tracing "core functions" This makes it possible to trace at least some of the functions used by the tracer, such as the cl-print functions. * lisp/emacs-lisp/trace.el (trace--entry-message) (trace--exit-message): Don't trace the tracing code. --- lisp/emacs-lisp/trace.el | 56 +++++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 59162e213c6..1cb755577d7 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -163,36 +163,38 @@ You can call this function to add internal values in the trace buffer." "Generate a string that describes that FUNCTION has been entered. LEVEL is the trace level, ARGS is the list of arguments passed to FUNCTION." (unless inhibit-trace - (trace--insert - (let ((ctx (funcall context)) - (print-circle t) - (print-escape-newlines t)) - (format "%s%s%d -> %s%s\n" - (mapconcat #'char-to-string - (make-string (max 0 (1- level)) ?|) " ") - (if (> level 1) " " "") - level - ;; FIXME: Make it so we can click the function name to - ;; jump to its definition and/or untrace it. - (cl-prin1-to-string (cons function args)) - ctx))))) + (let ((inhibit-trace t)) + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d -> %s%s\n" + (mapconcat #'char-to-string + (make-string (max 0 (1- level)) ?|) " ") + (if (> level 1) " " "") + level + ;; FIXME: Make it so we can click the function name to + ;; jump to its definition and/or untrace it. + (cl-prin1-to-string (cons function args)) + ctx)))))) (defun trace--exit-message (function level value context) "Generate a string that describes that FUNCTION has exited. LEVEL is the trace level, VALUE value returned by FUNCTION." (unless inhibit-trace - (trace--insert - (let ((ctx (funcall context)) - (print-circle t) - (print-escape-newlines t)) - (format "%s%s%d <- %s: %s%s\n" - (mapconcat 'char-to-string (make-string (1- level) ?|) " ") - (if (> level 1) " " "") - level - function - ;; Do this so we'll see strings: - (cl-prin1-to-string value) - ctx))))) + (let ((inhibit-trace t)) + (trace--insert + (let ((ctx (funcall context)) + (print-circle t) + (print-escape-newlines t)) + (format "%s%s%d <- %s: %s%s\n" + (mapconcat #'char-to-string (make-string (1- level) ?|) " ") + (if (> level 1) " " "") + level + function + ;; Do this so we'll see strings: + (cl-prin1-to-string value) + ctx)))))) (defvar trace--timer nil) @@ -261,7 +263,7 @@ If `current-prefix-arg' is non-nil, also read a buffer and a \"context\" (cons (let ((default (function-called-at-point))) (intern (completing-read (format-prompt prompt default) - obarray 'fboundp t nil nil + obarray #'fboundp t nil nil (if default (symbol-name default))))) (when current-prefix-arg (list @@ -307,7 +309,7 @@ the output buffer or changing the window configuration." (trace-function-internal function buffer t context)) ;;;###autoload -(defalias 'trace-function 'trace-function-foreground) +(defalias 'trace-function #'trace-function-foreground) (defun untrace-function (function) "Untraces FUNCTION and possibly activates all remaining advice. From d9cc684d104e83dd0e020d76616914f200836f6f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 9 Jan 2026 09:09:04 +0100 Subject: [PATCH 057/325] * test/README: Specify, how to invoke "make". (Bug#80112) --- test/README | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/README b/test/README index 3cd01627d09..d897e9e2c8b 100644 --- a/test/README +++ b/test/README @@ -29,6 +29,10 @@ following tags are recognized: * :unstable The test is under development. It shall run on demand only. +The following examples expect this directory as the current working +directory. If you call make from Emacs' root directory, use "make -C +test" instead. + The Makefile sets the environment variable $EMACS_TEST_DIRECTORY, which points to this directory. This environment variable does not exist when the tests are run outside make. The Makefile supports the From cdfb7354d6e1eacc8fa4cf567861c9cef0f07dac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 9 Jan 2026 15:25:35 +0100 Subject: [PATCH 058/325] Less stingy lisp-eval-depth supply for debugger * src/eval.c (call_debugger, signal_or_quit): Raise extra headroom to 200 levels. The debugger is sometimes entered via handler-bind so we raise the bar there as well (bug#80154). --- src/eval.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/eval.c b/src/eval.c index 73a2e2a54a2..7ca9d761a7e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -285,11 +285,10 @@ call_debugger (Lisp_Object arg) specpdl_ref count = SPECPDL_INDEX (); Lisp_Object val; - /* 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 (100); + /* The debugger currently requires 77 additional frames to print lists + nested 8 deep (the value of print-level used in the debugger) using + cl-prin1 (bug#31919), with a margin to be on the safe side. */ + max_ensure_room (200); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -1982,7 +1981,9 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool continuable) if (!NILP (find_handler_clause (h->tag_or_ch, conditions))) { specpdl_ref count = SPECPDL_INDEX (); - max_ensure_room (20); + /* Add some room in case this is for debugging, as in + call_debugger. */ + max_ensure_room (200); push_handler (make_fixnum (skip + h->bytecode_dest), SKIP_CONDITIONS); calln (h->val, error); From 7eabec8c5d91bce5bf2ab89dfa52dc5ba2f7415b Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 9 Jan 2026 19:46:49 +0100 Subject: [PATCH 059/325] ; Prepare extraction of package.el's activation core This change just renames package.el to package-core.el to preserve the file history. The original package.el will be preserved in a seperate branch and merged back together. (Bug#80079) --- lisp/emacs-lisp/{package.el => package-activate.el} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename lisp/emacs-lisp/{package.el => package-activate.el} (100%) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package-activate.el similarity index 100% rename from lisp/emacs-lisp/package.el rename to lisp/emacs-lisp/package-activate.el From 65090ec691d9bd82a9ba3bd25756227e0d43bd80 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Jan 2026 13:51:33 -0500 Subject: [PATCH 060/325] (project-files): Revert part of commit 6c832af15705 * lisp/progmodes/project.el (project-files): Don't add `ignores` twice. --- lisp/progmodes/project.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 662bb905769..4f3e19bd981 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -698,9 +698,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (if backend (vc-call-backend backend 'project-list-files dir ignores) (project--files-in-directory - dir (append ignores (append - (project-ignores nil nil) - ignores)))))) + dir (append ignores (project-ignores nil nil)))))) (or dirs (list (project-root project))))) From ab36f5892203e4b1f59da7c995e0f1fa0a81d1b6 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 9 Jan 2026 19:51:48 +0100 Subject: [PATCH 061/325] Extract definitions from package.el used during activation This change removes all definitions that we move to package-activate.el in a parallel branch, and then merge back together. We do this to retain the file history of both files. (Bug#80079) --- lisp/emacs-lisp/package.el | 461 +------------------------------------ 1 file changed, 2 insertions(+), 459 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 9ba9cb1827f..bd5bee0a9ca 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -143,6 +143,8 @@ ;;; Code: +(require 'package-activate) + (require 'cl-lib) (eval-when-compile (require 'subr-x)) (eval-when-compile (require 'epg)) ;For setf accessors. @@ -184,30 +186,6 @@ your `early-init-file'." :type 'boolean :version "24.1") -(defcustom package-load-list '(all) - "List of packages for `package-activate-all' to make available. -Each element in this list should be a list (NAME VERSION), or the -symbol `all'. The symbol `all' says to make available the latest -installed versions of all packages not specified by other -elements. - -For an element (NAME VERSION), NAME is a package name (a symbol). -VERSION should be t, a string, or nil. -If VERSION is t, the most recent version is made available. -If VERSION is a string, only that version is ever made available. - Any other version, even if newer, is silently ignored. - Hence, the package is \"held\" at that version. -If VERSION is nil, the package is not made available (it is \"disabled\")." - :type '(repeat (choice (const all) - (list :tag "Specific package" - (symbol :tag "Package name") - (choice :tag "Version" - (const :tag "disable" nil) - (const :tag "most recent" t) - (string :tag "specific version"))))) - :risky t - :version "24.1") - (defcustom package-archives `(("gnu" . ,(format "http%s://elpa.gnu.org/packages/" (if (gnutls-available-p) "s" ""))) @@ -459,86 +437,6 @@ synchronously." ;; but keep in mind there could be multiple `package-desc's with the ;; same name. -(defvar package--default-summary "No description available.") - -(define-inline package-vc-p (pkg-desc) - "Return non-nil if PKG-DESC is a VC package." - (inline-letevals (pkg-desc) - (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc)))) - -(cl-defstruct (package-desc - ;; Rename the default constructor from `make-package-desc'. - (:constructor package-desc-create) - ;; Has the same interface as the old `define-package', - ;; which is still used in the "foo-pkg.el" files. Extra - ;; options can be supported by adding additional keys. - (:constructor - package-desc-from-define - (name-string version-string &optional summary requirements - &rest rest-plist - &aux - (name (intern name-string)) - (version (if (eq (car-safe version-string) 'vc) - (version-to-list (cdr version-string)) - (version-to-list version-string))) - (reqs (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - (if (eq 'quote (car requirements)) - (nth 1 requirements) - requirements))) - (kind (plist-get rest-plist :kind)) - (archive (plist-get rest-plist :archive)) - (extras (let (alist) - (while rest-plist - (unless (memq (car rest-plist) '(:kind :archive)) - (let ((value (cadr rest-plist))) - (when value - (push (cons (car rest-plist) - (if (eq (car-safe value) 'quote) - (cadr value) - value)) - alist)))) - (setq rest-plist (cddr rest-plist))) - alist))))) - "Structure containing information about an individual package. -Slots: - -`name' Name of the package, as a symbol. - -`version' Version of the package, as a version list. - -`summary' Short description of the package, typically taken from - the first line of the file. - -`reqs' Requirements of the package. A list of (PACKAGE - VERSION-LIST) naming the dependent package and the minimum - required version. - -`kind' The distribution format of the package. Currently, it is - either `single', `tar', or (temporarily only) `dir'. In - addition, there is distribution format `vc', which is handled - by package-vc.el. - -`archive' The name of the archive (as a string) whence this - package came. - -`dir' The directory where the package is installed (if installed), - `builtin' if it is built-in, or nil otherwise. - -`extras' Optional alist of additional keyword-value pairs. - -`signed' Flag to indicate that the package is signed by provider." - name - version - (summary package--default-summary) - reqs - kind - archive - dir - extras - signed) - (defun package--from-builtin (bi-desc) "Create a `package-desc' object from BI-DESC. BI-DESC should be a `package--bi-desc' object." @@ -547,46 +445,6 @@ BI-DESC should be a `package--bi-desc' object." :summary (package--bi-desc-summary bi-desc) :dir 'builtin)) -;; Pseudo fields. -(defun package-version-join (vlist) - "Return the version string corresponding to the list VLIST. -This is, approximately, the inverse of `version-to-list'. -\(Actually, it returns only one of the possible inverses, since -`version-to-list' is a many-to-one operation.)" - (if (null vlist) - "" - (let ((str-list (list "." (int-to-string (car vlist))))) - (dolist (num (cdr vlist)) - (cond - ((>= num 0) - (push (int-to-string num) str-list) - (push "." str-list)) - ((< num -4) - (error "Invalid version list `%s'" vlist)) - (t - ;; pre, or beta, or alpha - (cond ((equal "." (car str-list)) - (pop str-list)) - ((not (string-match "[0-9]+" (car str-list))) - (error "Invalid version list `%s'" vlist))) - (push (cond ((= num -1) "pre") - ((= num -2) "beta") - ((= num -3) "alpha") - ((= num -4) "snapshot")) - str-list)))) - (if (equal "." (car str-list)) - (pop str-list)) - (apply #'concat (nreverse str-list))))) - -(defun package-desc-full-name (pkg-desc) - "Return full name of package-desc object PKG-DESC. -This is the name of the package with its version appended." - (if (package-vc-p pkg-desc) - (symbol-name (package-desc-name pkg-desc)) - (format "%s-%s" - (package-desc-name pkg-desc) - (package-version-join (package-desc-version pkg-desc))))) - (defun package-desc-suffix (pkg-desc) "Return file-name extension of package-desc object PKG-DESC. Depending on the `package-desc-kind' of PKG-DESC, this is one of: @@ -645,54 +503,6 @@ package." ;;; Installed packages -;; The following variables store information about packages present in -;; the system. The most important of these is `package-alist'. The -;; command `package-activate-all' is also closely related to this -;; section. - -(defvar package--builtins nil - "Alist of built-in packages. -The actual value is initialized by loading the library -`finder-inf'; this is not done until it is needed, e.g. by the -function `package-built-in-p'. - -Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package -name (a symbol) and DESC is a `package--bi-desc' structure.") -(put 'package--builtins 'risky-local-variable t) - -(defvar package-alist nil - "Alist of all packages available for activation. -Each element has the form (PKG . DESCS), where PKG is a package -name (a symbol) and DESCS is a non-empty list of `package-desc' -structures, sorted by decreasing versions. - -This variable is set automatically by `package-load-descriptor', -called via `package-activate-all'. To change which packages are -loaded and/or activated, customize `package-load-list'.") -(put 'package-alist 'risky-local-variable t) - -;;;; Public interfaces for accessing built-in package info - -(defun package-versioned-builtin-packages () - "Return a list of all the versioned built-in packages. -The return value is a list of names of built-in packages represented as -symbols." - (mapcar #'car package--builtin-versions)) - -(defun package-builtin-package-version (package) - "Return the version of a built-in PACKAGE given by its symbol. -The return value is a list of integers representing the version of -PACKAGE, in the format returned by `version-to-list', or nil if the -package is built-in but has no version or is not a built-in package." - (alist-get package package--builtin-versions)) - -;;;###autoload -(defvar package-activated-list nil - ;; FIXME: This should implicitly include all builtin packages. - "List of the names of currently activated packages.") -(put 'package-activated-list 'risky-local-variable t) - -;;;; Populating `package-alist'. ;; The following functions are called on each installed package by ;; `package-load-all-descriptors', which ultimately populates the @@ -730,46 +540,6 @@ are sorted with the highest version first." (declare-function package-vc-commit "package-vc" (pkg)) -(defun package-load-descriptor (pkg-dir) - "Load the package description file in directory PKG-DIR. -Create a new `package-desc' object, add it to `package-alist' and -return it." - (let ((pkg-file (expand-file-name (package--description-file pkg-dir) - pkg-dir)) - (signed-file (concat pkg-dir ".signed"))) - (when (file-exists-p pkg-file) - (with-temp-buffer - (insert-file-contents pkg-file) - (goto-char (point-min)) - (let ((pkg-desc (or (package-process-define-package - (read (current-buffer))) - (error "Can't find define-package in %s" pkg-file)))) - (setf (package-desc-dir pkg-desc) pkg-dir) - (if (file-exists-p signed-file) - (setf (package-desc-signed pkg-desc) t)) - pkg-desc))))) - -(defun package-load-all-descriptors () - "Load descriptors for installed Emacs Lisp packages. -This looks for package subdirectories in `package-user-dir' and -`package-directory-list'. The variable `package-load-list' -controls which package subdirectories may be loaded. - -In each valid package subdirectory, this function loads the -description file containing a call to `define-package', which -updates `package-alist'." - (dolist (dir (cons package-user-dir package-directory-list)) - (when (file-directory-p dir) - (dolist (pkg-dir (directory-files dir t "\\`[^.]")) - (when (file-directory-p pkg-dir) - (package-load-descriptor pkg-dir)))))) - -(defun package--alist () - "Return `package-alist', after computing it if needed." - (or package-alist - (progn (package-load-all-descriptors) - package-alist))) - (defun define-package ( _name-string _version-string &optional _docstring _requirements &rest _extra-properties) @@ -785,39 +555,6 @@ EXTRA-PROPERTIES is currently unused." (declare (obsolete nil "29.1") (indent defun)) (error "Don't call me!")) - -;;; Package activation -;; Section for functions used by `package-activate', which see. - -(defun package-disabled-p (pkg-name version) - "Return whether PKG-NAME at VERSION can be activated. -The decision is made according to `package-load-list'. -Return nil if the package can be activated. -Return t if the package is completely disabled. -Return the max version (as a string) if the package is held at a lower version." - (let ((force (assq pkg-name package-load-list))) - (cond ((null force) (not (memq 'all package-load-list))) - ((null (setq force (cadr force))) t) ; disabled - ((eq force t) nil) - ((stringp force) ; held - (unless (version-list-= version (version-to-list force)) - force)) - (t (error "Invalid element in `package-load-list'"))))) - -(defun package-built-in-p (package &optional min-version) - "Return non-nil if PACKAGE is built-in to Emacs. -Optional arg MIN-VERSION, if non-nil, should be a version list -specifying the minimum acceptable version." - (if (package-desc-p package) ;; was built-in and then was converted - (eq 'builtin (package-desc-dir package)) - (let ((bi (assq package package--builtin-versions))) - (cond - (bi (version-list-<= min-version (cdr bi))) - ((remove 0 min-version) nil) - (t - (require 'finder-inf nil t) ; For `package--builtins'. - (assq package package--builtins)))))) - (defun package--active-built-in-p (package) "Return non-nil if the built-in version of PACKAGE is used. If the built-in version of PACKAGE is used and PACKAGE is @@ -833,19 +570,6 @@ version from the archive." (package--alist))) (package-built-in-p package))) -(defun package--autoloads-file-name (pkg-desc) - "Return the absolute name of the autoloads file, sans extension. -PKG-DESC is a `package-desc' object." - (expand-file-name - (format "%s-autoloads" (package-desc-name pkg-desc)) - (package-desc-dir pkg-desc))) - -(defvar Info-directory-list) -(declare-function info-initialize "info" ()) - -(defvar package--quickstart-pkgs t - "If set to a list, we're computing the set of pkgs to activate.") - (defsubst package--library-stem (file) (catch 'done (let (result) @@ -905,83 +629,6 @@ sexps)." (mapc (lambda (c) (load (car c) nil t)) (sort result (lambda (x y) (< (cdr x) (cdr y)))))))) -(defun package--add-info-node (pkg-dir) - "Add info node located in PKG-DIR." - (when (file-exists-p (expand-file-name "dir" pkg-dir)) - ;; FIXME: not the friendliest, but simple. - (require 'info) - (info-initialize) - (add-to-list 'Info-directory-list pkg-dir))) - -(defun package-activate-1 (pkg-desc &optional reload deps) - "Activate package given by PKG-DESC, even if it was already active. -If DEPS is non-nil, also activate its dependencies (unless they -are already activated). -If RELOAD is non-nil, also `load' any files inside the package which -correspond to previously loaded files." - (let* ((name (package-desc-name pkg-desc)) - (pkg-dir (package-desc-dir pkg-desc))) - (unless pkg-dir - (error "Internal error: unable to find directory for `%s'" - (package-desc-full-name pkg-desc))) - (catch 'exit - ;; Activate its dependencies recursively. - ;; FIXME: This doesn't check whether the activated version is the - ;; required version. - (when deps - (dolist (req (package-desc-reqs pkg-desc)) - (unless (package-activate (car req)) - (message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable" - name (car req) (package-version-join (cadr req))) - (throw 'exit nil)))) - (if (listp package--quickstart-pkgs) - ;; We're only collecting the set of packages to activate! - (push pkg-desc package--quickstart-pkgs) - (when (or reload (assq name package--builtin-versions)) - (package--reload-previously-loaded - pkg-desc (unless reload - "Package %S is activated too late. -The following files have already been loaded: %S"))) - (with-demoted-errors "Error loading autoloads: %s" - (load (package--autoloads-file-name pkg-desc) nil t))) - (package--add-info-node pkg-dir) - (push name package-activated-list) - ;; Don't return nil. - t))) - -;;;; `package-activate' - -(defun package--get-activatable-pkg (pkg-name) - ;; Is "activatable" a word? - (let ((pkg-descs (cdr (assq pkg-name package-alist)))) - ;; Check if PACKAGE is available in `package-alist'. - (while - (when pkg-descs - (let ((available-version (package-desc-version (car pkg-descs)))) - (or (package-disabled-p pkg-name available-version) - ;; Prefer a builtin package. - (package-built-in-p pkg-name available-version)))) - (setq pkg-descs (cdr pkg-descs))) - (car pkg-descs))) - -;; This function activates a newer version of a package if an older -;; one was already activated. It also loads a features of this -;; package which were already loaded. -(defun package-activate (package &optional force) - "Activate the package named PACKAGE. -If FORCE is true, (re-)activate it if it's already activated. -Newer versions are always activated, regardless of FORCE." - (let ((pkg-desc (package--get-activatable-pkg package))) - (cond - ;; If no such package is found, maybe it's built-in. - ((null pkg-desc) - (package-built-in-p package)) - ;; If the package is already activated, just return t. - ((and (memq package package-activated-list) (not force)) - t) - ;; Otherwise, proceed with activation. - (t (package-activate-1 pkg-desc nil 'deps))))) - ;;; Installation -- Local operations ;; This section contains a variety of features regarding installing a @@ -1684,10 +1331,6 @@ If successful, set or update `package-archive-contents'." (defvar package--initialized nil "Non-nil if `package-initialize' has been run.") -;;;###autoload -(defvar package--activated nil - "Non-nil if `package-activate-all' has been run.") - ;;;###autoload (defun package-initialize (&optional no-activate) "Load Emacs Lisp packages, and activate them. @@ -1718,45 +1361,6 @@ that code in the early init-file." ;; `package--initialized' is t. (package--build-compatibility-table)) -;;;###autoload -(progn ;; Make the function usable without loading `package.el'. -(defun package-activate-all () - "Activate all installed packages. -The variable `package-load-list' controls which packages to load." - (setq package--activated t) - (let* ((elc (concat package-quickstart-file "c")) - (qs (if (file-readable-p elc) elc - (if (file-readable-p package-quickstart-file) - package-quickstart-file)))) - ;; The quickstart file presumes that it has a blank slate, - ;; so don't use it if we already activated some packages. - (or (and qs (not (bound-and-true-p package-activated-list)) - ;; Skip `load-source-file-function' which would slow us down by - ;; a factor 2 when loading the .el file (this assumes we were - ;; careful to save this file so it doesn't need any decoding). - (with-demoted-errors "Error during quickstart: %S" - (let ((load-source-file-function nil)) - (unless (boundp 'package-activated-list) - (setq package-activated-list nil)) - (load qs nil 'nomessage) - t))) - (progn - (require 'package) - ;; Silence the "unknown function" warning when this is compiled - ;; inside `loaddefs.el'. - ;; FIXME: We use `with-no-warnings' because the effect of - ;; `declare-function' is currently not scoped, so if we use - ;; it here, we end up with a redefinition warning instead :-) - (with-no-warnings - (package--activate-all))))))) - -(defun package--activate-all () - (dolist (elt (package--alist)) - (condition-case err - (package-activate (car elt)) - ;; Don't let failure of activation of a package arbitrarily stop - ;; activation of further packages. - (error (message "%s" (error-message-string err)))))) ;;;; Populating `package-archive-contents' from archives ;; This subsection populates the variables listed above from the @@ -2196,36 +1800,6 @@ if all the in-between dependencies are also in PACKAGE-LIST." (looking-at-p "[[:space:]]*\\'")) (write-region nil nil readme))))))) -;;;###autoload -(defun package-installed-p (package &optional min-version) - "Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. -If PACKAGE is a symbol, it is the package name and MIN-VERSION -should be a version list. - -If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." - (cond - ((package-desc-p package) - (let ((dir (package-desc-dir package))) - (and (stringp dir) - (file-exists-p dir)))) - ((and (not package--initialized) - (null min-version) - package-activated-list) - ;; We used the quickstart: make it possible to use package-installed-p - ;; even before package is fully initialized. - (or - (memq package package-activated-list) - ;; Also check built-in packages. - (package-built-in-p package min-version))) - (t - (or - (let ((pkg-descs (cdr (assq package (package--alist))))) - (and pkg-descs - (version-list-<= min-version - (package-desc-version (car pkg-descs))))) - ;; Also check built-in packages. - (package-built-in-p package min-version))))) - (defun package-download-transaction (packages) "Download and install all the packages in PACKAGES. PACKAGES should be a list of `package-desc'. @@ -4740,37 +4314,6 @@ The list is displayed in a buffer named `*Packages*'." (interactive) (list-packages t)) -;;;###autoload -(defun package-get-version () - "Return the version number of the package in which this is used. -Assumes it is used from an Elisp file placed inside the top-level directory -of an installed ELPA package. -The return value is a string (or nil in case we can't find it). -It works in more cases if the call is in the file which contains -the `Version:' header." - ;; In a sense, this is a lie, but it does just what we want: precomputes - ;; the version at compile time and hardcodes it into the .elc file! - (declare (pure t)) - ;; Hack alert! - (let ((file (or (macroexp-file-name) buffer-file-name))) - (cond - ((null file) nil) - ;; Packages are normally installed into directories named "-", - ;; so get the version number from there. - ((string-match "/[^/]+-\\([0-9]\\(?:[0-9.]\\|pre\\|beta\\|alpha\\|snapshot\\)+\\)/[^/]+\\'" file) - (match-string 1 file)) - ;; For packages run straight from the an elpa.git clone, there's no - ;; "-" in the directory name, so we have to fetch the version - ;; the hard way. - (t - (let* ((pkgdir (file-name-directory file)) - (pkgname (file-name-nondirectory (directory-file-name pkgdir))) - (mainfile (expand-file-name (concat pkgname ".el") pkgdir))) - (unless (file-readable-p mainfile) (setq mainfile file)) - (when (file-readable-p mainfile) - (require 'lisp-mnt) - (lm-package-version mainfile))))))) - ;;;; Quickstart: precompute activation actions for faster start up. From 8575c31517564c3b6053354ee093099b5816415a Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 9 Jan 2026 19:48:27 +0100 Subject: [PATCH 062/325] Remove definitions not relevant to startup from package-activate (Bug#80079) --- lisp/emacs-lisp/package-activate.el | 4506 +-------------------------- 1 file changed, 16 insertions(+), 4490 deletions(-) diff --git a/lisp/emacs-lisp/package-activate.el b/lisp/emacs-lisp/package-activate.el index 9ba9cb1827f..48eccb2e50a 100644 --- a/lisp/emacs-lisp/package-activate.el +++ b/lisp/emacs-lisp/package-activate.el @@ -1,4 +1,4 @@ -;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*- +;;; package-activate.el --- Core of the Emacs Package Manager -*- lexical-binding:t -*- ;; Copyright (C) 2007-2026 Free Software Foundation, Inc. @@ -26,163 +26,13 @@ ;;; Commentary: -;; The idea behind package.el is to be able to download packages and -;; install them. Packages are versioned and have versioned -;; dependencies. Furthermore, this supports built-in packages which -;; may or may not be newer than user-specified packages. This makes -;; it possible to upgrade Emacs and automatically disable packages -;; which have moved from external to core. (Note though that we don't -;; currently register any of these, so this feature does not actually -;; work.) - -;; A package is described by its name and version. The distribution -;; format is either a tar file or a single .el file. - -;; A tar file should be named "NAME-VERSION.tar". The tar file must -;; unpack into a directory named after the package and version: -;; "NAME-VERSION". It must contain a file named "PACKAGE-pkg.el" -;; which consists of a call to define-package. It may also contain a -;; "dir" file and the info files it references. - -;; A .el file is named "NAME-VERSION.el" in the remote archive, but is -;; installed as simply "NAME.el" in a directory named "NAME-VERSION". - -;; The downloader downloads all dependent packages. By default, -;; packages come from the official GNU sources, but others may be -;; added by customizing the `package-archives' alist. Packages get -;; byte-compiled at install time. - -;; At activation time we will set up the load-path and the info path, -;; and we will load the package's autoloads. If a package's -;; dependencies are not available, we will not activate that package. - -;; Conceptually a package has multiple state transitions: -;; -;; * Download. Fetching the package from ELPA. -;; * Install. Untar the package, or write the .el file, into -;; ~/.emacs.d/elpa/ directory. -;; * Autoload generation. -;; * Byte compile. Currently this phase is done during install, -;; but we may change this. -;; * Activate. Evaluate the autoloads for the package to make it -;; available to the user. -;; * Load. Actually load the package and run some code from it. - -;; Other external functions you may want to use: -;; -;; M-x list-packages -;; Enters a mode similar to buffer-menu which lets you manage -;; packages. You can choose packages for install (mark with "i", -;; then "x" to execute) or deletion, and you can see what packages -;; are available. This will automatically fetch the latest list of -;; packages from ELPA. -;; -;; M-x package-install-from-buffer -;; Install a package consisting of a single .el file that appears -;; in the current buffer. This only works for packages which -;; define a Version header properly; package.el also supports the -;; extension headers Package-Version (in case Version is an RCS id -;; or similar), and Package-Requires (if the package requires other -;; packages). -;; -;; M-x package-install-file -;; Install a package from the indicated file. The package can be -;; either a tar file or a .el file. A tar file must contain an -;; appropriately-named "-pkg.el" file; a .el file must be properly -;; formatted as with `package-install-from-buffer'. - -;;; Thanks: -;;; (sorted by sort-lines): - -;; Jim Blandy -;; Karl Fogel -;; Kevin Ryde -;; Lawrence Mitchell -;; Michael Olson -;; Sebastian Tennant -;; Stefan Monnier -;; Vinicius Jose Latorre -;; Phil Hagelberg - -;;; ToDo: - -;; - putting info dirs at the start of the info path means -;; users see a weird ordering of categories. OTOH we want to -;; override later entries. maybe emacs needs to enforce -;; the standard layout? -;; - put bytecode in a separate directory tree -;; - perhaps give users a way to recompile their bytecode -;; or do it automatically when emacs changes -;; - give users a way to know whether a package is installed ok -;; - give users a way to view a package's documentation when it -;; only appears in the .el -;; - use/extend checkdoc so people can tell if their package will work -;; - "installed" instead of a blank in the status column -;; - tramp needs its files to be compiled in a certain order. -;; how to handle this? fix tramp? -;; - maybe we need separate .elc directories for various emacs -;; versions. That way conditional compilation can work. But would -;; this break anything? -;; - William Xu suggests being able to open a package file without -;; installing it -;; - Interface with desktop.el so that restarting after an install -;; works properly -;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info -;; ... except maybe lisp? -;; - It may be nice to have a macro that expands to the package's -;; private data dir, aka ".../etc". Or, maybe data-directory -;; needs to be a list (though this would be less nice) -;; a few packages want this, eg sokoban -;; - Allow multiple versions on the server, so that if a user doesn't -;; meet the requirements for the most recent version they can still -;; install an older one. -;; - Allow optional package dependencies -;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb -;; and just don't compile to add to load path ...? -;; - Our treatment of the info path is somewhat bogus +;; This file contains the core definitions of package.el used to +;; activate packages at startup, as well as other functions that are +;; useful without having to load the entirety of package.el. ;;; Code: -(require 'cl-lib) -(eval-when-compile (require 'subr-x)) -(eval-when-compile (require 'epg)) ;For setf accessors. -(eval-when-compile (require 'inline)) ;For `define-inline' -(require 'seq) - -(require 'tabulated-list) -(require 'macroexp) -(require 'url-handlers) -(require 'browse-url) - -(defgroup package nil - "Manager for Emacs Lisp packages." - :group 'applications - :version "24.1") - - -;;; Customization options - -;;;###autoload -(defcustom package-enable-at-startup t - "Whether to make installed packages available when Emacs starts. -If non-nil, packages are made available before reading the init -file (but after reading the early init file). This means that if -you wish to set this variable, you must do so in the early init -file. Regardless of the value of this variable, packages are not -made available if `user-init-file' is nil (e.g. Emacs was started -with \"-q\"). - -Even if the value is nil, you can type \\[package-initialize] to -make installed packages available at any time, or you can -call (package-activate-all) in your init-file. - -Note that this variable must be set to a non-default value in -your early-init file, as the variable's value is used before -loading the regular init file. Therefore, if you customize it -via Customize, you should save your customized setting into -your `early-init-file'." - :type 'boolean - :version "24.1") +(eval-when-compile (require 'cl-lib)) (defcustom package-load-list '(all) "List of packages for `package-activate-all' to make available. @@ -206,258 +56,8 @@ If VERSION is nil, the package is not made available (it is \"disabled\")." (const :tag "most recent" t) (string :tag "specific version"))))) :risky t - :version "24.1") - -(defcustom package-archives `(("gnu" . - ,(format "http%s://elpa.gnu.org/packages/" - (if (gnutls-available-p) "s" ""))) - ("nongnu" . - ,(format "http%s://elpa.nongnu.org/nongnu/" - (if (gnutls-available-p) "s" "")))) - "An alist of archives from which to fetch. -The default value points to the GNU Emacs package repository. - -Each element has the form (ID . LOCATION). - ID is an archive name, as a string. - LOCATION specifies the base location for the archive. - If it starts with \"http(s):\", it is treated as an HTTP(S) URL; - otherwise it should be an absolute directory name. - (Other types of URL are currently not supported.) - -Only add locations that you trust, since fetching and installing -a package can run arbitrary code. - -HTTPS URLs should be used where possible, as they offer superior -security." - :type '(alist :key-type (string :tag "Archive name") - :value-type (string :tag "URL or directory name")) - :risky t - :version "28.1") - -(defcustom package-menu-hide-low-priority 'archive - "If non-nil, hide low priority packages from the packages menu. -A package is considered low priority if there's another version -of it available such that: - (a) the archive of the other package is higher priority than - this one, as per `package-archive-priorities'; - or - (b) they both have the same archive priority but the other - package has a higher version number. - -This variable has three possible values: - nil: no packages are hidden; - `archive': only criterion (a) is used; - t: both criteria are used. - -This variable has no effect if `package-menu--hide-packages' is -nil, so it can be toggled with \\\\[package-menu-toggle-hiding]." - :type '(choice (const :tag "Don't hide anything" nil) - (const :tag "Hide per package-archive-priorities" - archive) - (const :tag "Hide per archive and version number" t)) - :version "25.1") - -(defcustom package-archive-priorities nil - "An alist of priorities for packages. - -Each element has the form (ARCHIVE-ID . PRIORITY). - -When installing packages, the package with the highest version -number from the archive with the highest priority is -selected. When higher versions are available from archives with -lower priorities, the user has to select those manually. - -Archives not in this list have the priority 0, as have packages -that are already installed. If you use negative priorities for -the archives, they will not be upgraded automatically. - -See also `package-menu-hide-low-priority'." - :type '(alist :key-type (string :tag "Archive name") - :value-type (integer :tag "Priority (default is 0)")) - :risky t - :version "25.1") - -(defcustom package-pinned-packages nil - "An alist of packages that are pinned to specific archives. -This can be useful if you have multiple package archives enabled, -and want to control which archive a given package gets installed from. - -Each element of the alist has the form (PACKAGE . ARCHIVE), where: - PACKAGE is a symbol representing a package - ARCHIVE is a string representing an archive (it should be the car of -an element in `package-archives', e.g. \"gnu\"). - -Adding an entry to this variable means that only ARCHIVE will be -considered as a source for PACKAGE. If other archives provide PACKAGE, -they are ignored (for this package). If ARCHIVE does not contain PACKAGE, -the package will be unavailable." - :type '(alist :key-type (symbol :tag "Package") - :value-type (string :tag "Archive name")) - ;; This could prevent you from receiving updates for a package, - ;; via an entry (PACKAGE . NON-EXISTING). Which could be an issue - ;; if PACKAGE has a known vulnerability that is fixed in newer versions. - :risky t - :version "24.4") - -;;;###autoload -(defcustom package-user-dir (locate-user-emacs-file "elpa") - "Directory containing the user's Emacs Lisp packages. -The directory name should be absolute. -Apart from this directory, Emacs also looks for system-wide -packages in `package-directory-list'." - :type 'directory - :initialize #'custom-initialize-delay - :risky t - :group 'applications - :version "24.1") - -;;;###autoload -(defcustom package-directory-list - ;; Defaults are subdirs named "elpa" in the site-lisp dirs. - (let (result) - (dolist (f load-path) - (and (stringp f) - (equal (file-name-nondirectory f) "site-lisp") - (push (expand-file-name "elpa" f) result))) - (nreverse result)) - "List of additional directories containing Emacs Lisp packages. -Each directory name should be absolute. - -These directories contain packages intended for system-wide; in -contrast, `package-user-dir' contains packages for personal use." - :type '(repeat directory) - :initialize #'custom-initialize-delay - :group 'applications - :risky t - :version "24.1") - -(declare-function epg-find-configuration "epg-config" - (protocol &optional no-cache program-alist)) - -(defcustom package-gnupghome-dir (expand-file-name "gnupg" package-user-dir) - "Directory containing GnuPG keyring or nil. -This variable specifies the GnuPG home directory used by package. -That directory is passed via the option \"--homedir\" to GnuPG. -If nil, do not use the option \"--homedir\", but stick with GnuPG's -default directory." - :type `(choice - (const - :tag "Default Emacs package management GnuPG home directory" - ,(expand-file-name "gnupg" package-user-dir)) - (const - :tag "Default GnuPG directory (GnuPG option --homedir not used)" - nil) - (directory :tag "A specific GnuPG --homedir")) - :risky t - :version "26.1") - -(defcustom package-check-signature 'allow-unsigned - "Non-nil means to check package signatures when installing. - -This also applies to the \"archive-contents\" file that lists the -contents of the archive. - -The value can be one of: - - t Accept a package only if it comes with at least - one verified signature. - - `all' Same as t, but verify all signatures if there - are more than one. - - `allow-unsigned' Install a package even if it is unsigned, - but verify the signature if possible (that - is, if it is signed, we have the key for it, - and GnuPG is installed). - - nil Package signatures are ignored." - :type '(choice (const :value nil :tag "Never") - (const :value allow-unsigned :tag "Allow unsigned") - (const :value t :tag "Check always") - (const :value all :tag "Check always (all signatures)")) - :risky t - :version "27.1") - -(defun package-check-signature () - "Check whether we have a usable OpenPGP configuration. -If so, and variable `package-check-signature' is -`allow-unsigned', return `allow-unsigned', otherwise return the -value of variable `package-check-signature'." - (if (eq package-check-signature 'allow-unsigned) - (and (epg-find-configuration 'OpenPGP) - 'allow-unsigned) - package-check-signature)) - -(defcustom package-unsigned-archives nil - "List of archives where we do not check for package signatures. -This should be a list of strings matching the names of package -archives in the variable `package-archives'." - :type '(repeat (string :tag "Archive name")) - :risky t - :version "24.4") - -(defcustom package-selected-packages nil - "Store here packages installed explicitly by user. -This variable is fed automatically by Emacs when installing a new package. -This variable is used by `package-autoremove' to decide -which packages are no longer needed. -You can use it to (re)install packages on other machines -by running `package-install-selected-packages'. - -To check if a package is contained in this list here, use -`package--user-selected-p', as it may populate the variable with -a sane initial value." - :version "25.1" - :type '(repeat symbol)) - -(defcustom package-native-compile nil - "Non-nil means to natively compile packages as part of their installation. -This controls ahead-of-time compilation of packages when they are -installed. If this option is nil, packages will be natively -compiled when they are loaded for the first time. - -This option does not have any effect if Emacs was not built with -native compilation support." - :type '(boolean) - :risky t - :version "28.1") - -(defcustom package-menu-async t - "If non-nil, package-menu will use async operations when possible. -Currently, only the refreshing of archive contents supports -asynchronous operations. Package transactions are still done -synchronously." - :type 'boolean - :version "25.1") - -(defcustom package-name-column-width 30 - "Column width for the Package name in the package menu." - :type 'natnum - :version "28.1") - -(defcustom package-version-column-width 14 - "Column width for the Package version in the package menu." - :type 'natnum - :version "28.1") - -(defcustom package-status-column-width 12 - "Column width for the Package status in the package menu." - :type 'natnum - :version "28.1") - -(defcustom package-archive-column-width 8 - "Column width for the Package archive in the package menu." - :type 'natnum - :version "28.1") - - -;;; `package-desc' object definition -;; This is the struct used internally to represent packages. -;; Functions that deal with packages should generally take this object -;; as an argument. In some situations (e.g. commands that query the -;; user) it makes sense to take the package name as a symbol instead, -;; but keep in mind there could be multiple `package-desc's with the -;; same name. + :version "24.1" + :group 'package) (defvar package--default-summary "No description available.") @@ -539,14 +139,6 @@ Slots: extras signed) -(defun package--from-builtin (bi-desc) - "Create a `package-desc' object from BI-DESC. -BI-DESC should be a `package--bi-desc' object." - (package-desc-create :name (pop bi-desc) - :version (package--bi-desc-version bi-desc) - :summary (package--bi-desc-summary bi-desc) - :dir 'builtin)) - ;; Pseudo fields. (defun package-version-join (vlist) "Return the version string corresponding to the list VLIST. @@ -587,62 +179,6 @@ This is the name of the package with its version appended." (package-desc-name pkg-desc) (package-version-join (package-desc-version pkg-desc))))) -(defun package-desc-suffix (pkg-desc) - "Return file-name extension of package-desc object PKG-DESC. -Depending on the `package-desc-kind' of PKG-DESC, this is one of: - - \\='single - \".el\" - \\='tar - \".tar\" - \\='dir - \"\" - -Signal an error if the kind is none of the above." - (pcase (package-desc-kind pkg-desc) - ('single ".el") - ('tar ".tar") - ('dir "") - (kind (error "Unknown package kind: %s" kind)))) - -(defun package-desc--keywords (pkg-desc) - "Return keywords of package-desc object PKG-DESC. -These keywords come from the foo-pkg.el file, and in general -corresponds to the keywords in the \"Keywords\" header of the -package." - (let ((keywords (cdr (assoc :keywords (package-desc-extras pkg-desc))))) - (if (eq (car-safe keywords) 'quote) - (nth 1 keywords) - keywords))) - -(defun package-desc-priority (pkg-desc) - "Return the priority of the archive of package-desc object PKG-DESC." - (package-archive-priority (package-desc-archive pkg-desc))) - -(defun package--parse-elpaignore (pkg-desc) - "Return a list of regular expressions to match files ignored by PKG-DESC." - (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc))) - (ignore (expand-file-name ".elpaignore" pkg-dir)) - files) - (when (file-exists-p ignore) - (with-temp-buffer - (insert-file-contents ignore) - (goto-char (point-min)) - (while (not (eobp)) - (push (wildcard-to-regexp - (let ((line (buffer-substring - (line-beginning-position) - (line-end-position)))) - (file-name-concat pkg-dir (string-trim-left line "/")))) - files) - (forward-line))) - files))) - -(cl-defstruct (package--bi-desc - (:constructor package-make-builtin (version summary)) - (:type vector)) - "Package descriptor format used in finder-inf.el and package--builtins." - version - reqs - summary) - ;;; Installed packages ;; The following variables store information about packages present in @@ -673,19 +209,6 @@ loaded and/or activated, customize `package-load-list'.") ;;;; Public interfaces for accessing built-in package info -(defun package-versioned-builtin-packages () - "Return a list of all the versioned built-in packages. -The return value is a list of names of built-in packages represented as -symbols." - (mapcar #'car package--builtin-versions)) - -(defun package-builtin-package-version (package) - "Return the version of a built-in PACKAGE given by its symbol. -The return value is a list of integers representing the version of -PACKAGE, in the format returned by `version-to-list', or nil if the -package is built-in but has no version or is not a built-in package." - (alist-get package package--builtin-versions)) - ;;;###autoload (defvar package-activated-list nil ;; FIXME: This should implicitly include all builtin packages. @@ -698,8 +221,6 @@ package is built-in but has no version or is not a built-in package." ;; `package-load-all-descriptors', which ultimately populates the ;; `package-alist' variable. -(declare-function package-vc-version "package-vc" (pkg)) - (defun package-process-define-package (exp) "Process define-package expression EXP and push it to `package-alist'. EXP should be a form read from a foo-pkg.el file. @@ -728,8 +249,6 @@ are sorted with the highest version first." nil))) new-pkg-desc))) -(declare-function package-vc-commit "package-vc" (pkg)) - (defun package-load-descriptor (pkg-dir) "Load the package description file in directory PKG-DIR. Create a new `package-desc' object, add it to `package-alist' and @@ -770,21 +289,6 @@ updates `package-alist'." (progn (package-load-all-descriptors) package-alist))) -(defun define-package ( _name-string _version-string - &optional _docstring _requirements - &rest _extra-properties) - "Define a new package. -NAME-STRING is the name of the package, as a string. -VERSION-STRING is the version of the package, as a string. -DOCSTRING is a short description of the package, a string. -REQUIREMENTS is a list of dependencies on other packages. - Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION), - where OTHER-VERSION is a string. - -EXTRA-PROPERTIES is currently unused." - (declare (obsolete nil "29.1") (indent defun)) - (error "Don't call me!")) - ;;; Package activation ;; Section for functions used by `package-activate', which see. @@ -818,21 +322,6 @@ specifying the minimum acceptable version." (require 'finder-inf nil t) ; For `package--builtins'. (assq package package--builtins)))))) -(defun package--active-built-in-p (package) - "Return non-nil if the built-in version of PACKAGE is used. -If the built-in version of PACKAGE is used and PACKAGE is -also available for installation from an archive, it is an -indication that PACKAGE was never upgraded to any newer -version from the archive." - (and (not (assq (cond - ((package-desc-p package) - (package-desc-name package)) - ((stringp package) (intern package)) - ((symbolp package) package) - ((error "Unknown package format: %S" package))) - (package--alist))) - (package-built-in-p package))) - (defun package--autoloads-file-name (pkg-desc) "Return the absolute name of the autoloads file, sans extension. PKG-DESC is a `package-desc' object." @@ -846,65 +335,6 @@ PKG-DESC is a `package-desc' object." (defvar package--quickstart-pkgs t "If set to a list, we're computing the set of pkgs to activate.") -(defsubst package--library-stem (file) - (catch 'done - (let (result) - (dolist (suffix (get-load-suffixes) file) - (setq result (string-trim file nil suffix)) - (unless (equal file result) - (throw 'done result)))))) - -(defun package--reload-previously-loaded (pkg-desc &optional warn) - "Force reimportation of files in PKG-DESC already present in `load-history'. -New editions of files contain macro definitions and -redefinitions, the overlooking of which would cause -byte-compilation of the new package to fail. -If WARN is a string, display a warning (using WARN as a format string) -before reloading the files. WARN must have two %-sequences -corresponding to package name (a symbol) and a list of files loaded (as -sexps)." - (with-demoted-errors "Error in package--load-files-for-activation: %s" - (let* (result - (dir (package-desc-dir pkg-desc)) - ;; A previous implementation would skip `dir' itself. - ;; However, in normal use reloading from the same directory - ;; never happens anyway, while in certain cases external to - ;; Emacs a package in the same directory not necessary - ;; stays byte-identical, e.g. during development. Just - ;; don't special-case `dir'. - (effective-path (or (bound-and-true-p find-library-source-path) - load-path)) - (files (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")) - (history (mapcar #'file-truename - (cl-remove-if-not #'stringp - (mapcar #'car load-history))))) - (dolist (file files) - (when-let* ((library (package--library-stem - (file-relative-name file dir))) - (canonical (locate-library library nil effective-path)) - (truename (file-truename canonical)) - ;; Normally, all files in a package are compiled by - ;; now, but don't assume that. E.g. different - ;; versions can add or remove `no-byte-compile'. - (altname (if (string-suffix-p ".el" truename) - (replace-regexp-in-string - "\\.el\\'" ".elc" truename t) - (replace-regexp-in-string - "\\.elc\\'" ".el" truename t))) - (found (or (member truename history) - (and (not (string= altname truename)) - (member altname history)))) - (recent-index (length found))) - (unless (equal (file-name-base library) - (format "%s-autoloads" (package-desc-name pkg-desc))) - (push (cons (expand-file-name library dir) recent-index) result)))) - (when (and result warn) - (display-warning 'package - (format warn (package-desc-name pkg-desc) - (mapcar #'car result)))) - (mapc (lambda (c) (load (car c) nil t)) - (sort result (lambda (x y) (< (cdr x) (cdr y)))))))) - (defun package--add-info-node (pkg-dir) "Add info node located in PKG-DIR." (when (file-exists-p (expand-file-name "dir" pkg-dir)) @@ -938,6 +368,10 @@ correspond to previously loaded files." ;; We're only collecting the set of packages to activate! (push pkg-desc package--quickstart-pkgs) (when (or reload (assq name package--builtin-versions)) + (require 'package) + (declare-function package--reload-previously-loaded + "package" (pkg-desc &optional warn)) + (package--reload-previously-loaded pkg-desc (unless reload "Package %S is activated too late. @@ -990,734 +424,11 @@ Newer versions are always activated, regardless of FORCE." ;; current buffer. ;;;; Unpacking -(defvar tar-parse-info) -(declare-function tar-untar-buffer "tar-mode" ()) -(declare-function tar-header-name "tar-mode" (tar-header) t) -(declare-function tar-header-link-type "tar-mode" (tar-header) t) - -(defun package-untar-buffer (dir) - "Untar the current buffer. -This uses `tar-untar-buffer' from Tar mode. All files should -untar into a directory named DIR; otherwise, signal an error." - (tar-mode) - (unwind-protect - (progn - ;; Make sure everything extracts into DIR. - (let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/")) - (case-fold-search (file-name-case-insensitive-p dir))) - (dolist (tar-data tar-parse-info) - (let ((name (expand-file-name (tar-header-name tar-data)))) - (or (string-match regexp name) - ;; Tarballs created by some utilities don't list - ;; directories with a trailing slash (Bug#13136). - (and (string-equal (expand-file-name dir) name) - (eq (tar-header-link-type tar-data) 5)) - (error "Package does not untar cleanly into directory %s/" - dir))))) - (tar-untar-buffer)) - (fundamental-mode))) ; free auxiliary tar-mode data - -(defun package--alist-to-plist-args (alist) - (mapcar #'macroexp-quote - (apply #'nconc - (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) - -(declare-function dired-get-marked-files "dired") - -(defun package-unpack (pkg-desc) - "Install the contents of the current buffer as a package." - (let* ((name (package-desc-name pkg-desc)) - (dirname (package-desc-full-name pkg-desc)) - (pkg-dir (expand-file-name dirname package-user-dir))) - (pcase (package-desc-kind pkg-desc) - ('dir - (make-directory pkg-dir t) - (let ((file-list - (or (and (derived-mode-p 'dired-mode) - (dired-get-marked-files nil 'marked)) - (directory-files-recursively default-directory "" nil)))) - (dolist (source-file file-list) - (let ((target (expand-file-name - (file-relative-name source-file default-directory) - pkg-dir))) - (make-directory (file-name-directory target) t) - (copy-file source-file target t))) - ;; Now that the files have been installed, this package is - ;; indistinguishable from a `tar' or a `single'. Let's make - ;; things simple by ensuring we're one of them. - (setf (package-desc-kind pkg-desc) - (if (length> file-list 1) 'tar 'single)))) - ('tar - (make-directory package-user-dir t) - (let* ((default-directory (file-name-as-directory package-user-dir))) - (package-untar-buffer dirname))) - ('single - (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir))) - (make-directory pkg-dir t) - (package--write-file-no-coding el-file))) - (kind (error "Unknown package kind: %S" kind))) - (package--make-autoloads-and-stuff pkg-desc pkg-dir) - ;; Update package-alist. - (let ((new-desc (package-load-descriptor pkg-dir))) - (unless (equal (package-desc-full-name new-desc) - (package-desc-full-name pkg-desc)) - (error "The retrieved package (`%s') doesn't match what the archive offered (`%s')" - (package-desc-full-name new-desc) (package-desc-full-name pkg-desc))) - ;; Activation has to be done before compilation, so that if we're - ;; upgrading and macros have changed we load the new definitions - ;; before compiling. - (when (package-activate-1 new-desc :reload :deps) - ;; FIXME: Compilation should be done as a separate, optional, step. - ;; E.g. for multi-package installs, we should first install all packages - ;; and then compile them. - (package--compile new-desc) - (when package-native-compile - (package--native-compile-async new-desc)) - ;; After compilation, load again any files loaded by - ;; `activate-1', so that we use the byte-compiled definitions. - (package--reload-previously-loaded new-desc))) - pkg-dir)) - -(defun package-generate-description-file (pkg-desc pkg-file) - "Create the foo-pkg.el file PKG-FILE for single-file package PKG-DESC." - (let* ((name (package-desc-name pkg-desc))) - (let ((print-level nil) - (print-quoted t) - (print-length nil)) - (write-region - (concat - ";;; Generated package description from " - (replace-regexp-in-string "-pkg\\.el\\'" ".el" - (file-name-nondirectory pkg-file)) - " -*- no-byte-compile: t -*-\n" - (prin1-to-string - (nconc - (list 'define-package - (symbol-name name) - (package-version-join (package-desc-version pkg-desc)) - (package-desc-summary pkg-desc) - (let ((requires (package-desc-reqs pkg-desc))) - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) - (package--alist-to-plist-args - (package-desc-extras pkg-desc)))) - "\n") - nil pkg-file nil 'silent)))) - - -;;;; Autoload -(declare-function autoload-rubric "autoload" (file &optional type feature)) - -(defun package-autoload-ensure-default-file (file) - "Make sure that the autoload file FILE exists and if not create it." - (declare (obsolete nil "29.1")) - (unless (file-exists-p file) - (require 'autoload) - (let ((coding-system-for-write 'utf-8-emacs-unix)) - (with-suppressed-warnings ((obsolete autoload-rubric)) - (write-region (autoload-rubric file "package" nil) - nil file nil 'silent)))) - file) - -(defvar autoload-timestamps) -(defvar version-control) - -(defun package-generate-autoloads (name pkg-dir) - "Generate autoloads in PKG-DIR for package named NAME." - (let* ((auto-name (format "%s-autoloads.el" name)) - ;;(ignore-name (concat name "-pkg.el")) - (output-file (expand-file-name auto-name pkg-dir)) - ;; We don't need 'em, and this makes the output reproducible. - (autoload-timestamps nil) - (backup-inhibited t) - (version-control 'never)) - (loaddefs-generate - pkg-dir output-file nil - (prin1-to-string - '(add-to-list - 'load-path - ;; Add the directory that will contain the autoload file to - ;; the load path. We don't hard-code `pkg-dir', to avoid - ;; issues if the package directory is moved around. - ;; `loaddefs-generate' has code to do this for us, but it's - ;; not currently exposed. (Bug#63625) - (or (and load-file-name - (directory-file-name - (file-name-directory load-file-name))) - (car load-path))))) - (let ((buf (find-buffer-visiting output-file))) - (when buf (kill-buffer buf))) - auto-name)) - -(defun package--make-autoloads-and-stuff (pkg-desc pkg-dir) - "Generate autoloads, description file, etc., for PKG-DESC installed at PKG-DIR." - (package-generate-autoloads (package-desc-name pkg-desc) pkg-dir) - (let ((desc-file (expand-file-name (package--description-file pkg-dir) - pkg-dir))) - (unless (file-exists-p desc-file) - (package-generate-description-file pkg-desc desc-file))) - ;; FIXME: Create foo.info and dir file from foo.texi? - ) - -;;;; Compilation -(defvar warning-minimum-level) -(defvar byte-compile-ignore-files) -(defun package--compile (pkg-desc) - "Byte-compile installed package PKG-DESC. -This assumes that `pkg-desc' has already been activated with -`package-activate-1'." - (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc)) - (warning-minimum-level :error) - (load-path load-path)) - (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) - -(defun package--native-compile-async (pkg-desc) - "Native compile installed package PKG-DESC asynchronously. -This assumes that `pkg-desc' has already been activated with -`package-activate-1'." - (when (native-comp-available-p) - (let ((warning-minimum-level :error)) - (native-compile-async (package-desc-dir pkg-desc) t)))) - -;;;; Inferring package from current buffer -(defun package-read-from-string (str) - "Read a Lisp expression from STR. -Signal an error if the entire string was not used." - (pcase-let ((`(,expr . ,offset) (read-from-string str))) - (condition-case () - ;; The call to `ignore' suppresses a compiler warning. - (progn (ignore (read-from-string str offset)) - (error "Can't read whole string")) - (end-of-file expr)))) - -(declare-function lm-header "lisp-mnt" (header)) -(declare-function lm-package-requires "lisp-mnt" (&optional file)) -(declare-function lm-package-version "lisp-mnt" (&optional file)) -(declare-function lm-website "lisp-mnt" (&optional file)) -(declare-function lm-keywords-list "lisp-mnt" (&optional file)) -(declare-function lm-maintainers "lisp-mnt" (&optional file)) -(declare-function lm-authors "lisp-mnt" (&optional file)) - -(defun package-buffer-info () - "Return a `package-desc' describing the package in the current buffer. - -If the buffer does not contain a conforming package, signal an -error. If there is a package, narrow the buffer to the file's -boundaries." - (goto-char (point-min)) - (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) - (error "Package lacks a file header")) - (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2))) - (require 'lisp-mnt) - (let* ((version-info (lm-package-version)) - (pkg-version (package-strip-rcs-id version-info)) - (keywords (lm-keywords-list)) - (website (lm-website))) - (unless pkg-version - (if version-info - (error "Unrecognized package version: %s" version-info) - (error "Package lacks a \"Version\" or \"Package-Version\" header"))) - (package-desc-from-define - file-name pkg-version desc - (lm-package-requires) - :kind 'single - :url website - :keywords keywords - :maintainer - ;; For backward compatibility, use a single cons-cell if - ;; there's only one maintainer (the most common case). - (let ((maints (lm-maintainers))) (if (cdr maints) maints (car maints))) - :authors (lm-authors))))) - -(defun package--read-pkg-desc (kind) - "Read a `define-package' form in current buffer. -Return the pkg-desc, with desc-kind set to KIND." - (goto-char (point-min)) - (let* ((pkg-def-parsed (read (current-buffer))) - (pkg-desc - (when (eq (car pkg-def-parsed) 'define-package) - (apply #'package-desc-from-define - (append (cdr pkg-def-parsed)))))) - (when pkg-desc - (setf (package-desc-kind pkg-desc) kind) - pkg-desc))) - -(declare-function tar-get-file-descriptor "tar-mode" (file)) -(declare-function tar--extract "tar-mode" (descriptor)) - -(defun package-tar-file-info () - "Find package information for a tar file. -The return result is a `package-desc'." - (cl-assert (derived-mode-p 'tar-mode)) - (let* ((dir-name (named-let loop - ((filename (tar-header-name (car tar-parse-info)))) - (let ((dirname (file-name-directory filename))) - ;; The first file can be in a subdir: look for the top. - (if dirname (loop (directory-file-name dirname)) - (file-name-as-directory filename))))) - (desc-file (package--description-file dir-name)) - (tar-desc (tar-get-file-descriptor (concat dir-name desc-file)))) - (unless tar-desc - (error "No package descriptor file found")) - (with-current-buffer (tar--extract tar-desc) - (unwind-protect - (or (package--read-pkg-desc 'tar) - (error "Can't find define-package in %s" - (tar-header-name tar-desc))) - (kill-buffer (current-buffer)))))) - -(defun package-dir-info () - "Find package information for a directory. -The return result is a `package-desc'." - (cl-assert (derived-mode-p 'dired-mode)) - (let* ((desc-file (package--description-file default-directory))) - (if (file-readable-p desc-file) - (with-temp-buffer - (insert-file-contents desc-file) - (package--read-pkg-desc 'dir)) - (catch 'found - (let ((files (or (and (derived-mode-p 'dired-mode) - (dired-get-marked-files nil 'marked)) - (directory-files default-directory t "\\.el\\'" t)))) - ;; We sort the file names by length, to ensure that we check - ;; shorter file names first, as these are more likely to - ;; contain the package metadata. - (dolist (file (sort files :key #'length)) - ;; The file may be a link to a nonexistent file; e.g., a - ;; lock file. - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - ;; When we find the file with the data, - (when-let* ((info (ignore-errors (package-buffer-info)))) - (setf (package-desc-kind info) 'dir) - (throw 'found info)))))) - (error "No .el files with package headers in `%s'" default-directory))))) - - -;;; Communicating with Archives -;; Set of low-level functions for communicating with archives and -;; signature checking. - -(defun package--write-file-no-coding (file-name) - "Write file FILE-NAME without encoding using coding system." - (let ((buffer-file-coding-system 'no-conversion)) - (write-region (point-min) (point-max) file-name nil 'silent))) - -(declare-function url-http-file-exists-p "url-http" (url)) - -(defun package--archive-file-exists-p (location file) - "Return t if FILE exists in remote LOCATION." - (let ((http (string-match "\\`https?:" location))) - (if http - (progn - (require 'url-http) - (url-http-file-exists-p (concat location file))) - (file-exists-p (expand-file-name file location))))) - -(declare-function epg-make-context "epg" - (&optional protocol armor textmode include-certs - cipher-algorithm - digest-algorithm - compress-algorithm)) -(declare-function epg-verify-string "epg" ( context signature - &optional signed-text)) -(declare-function epg-context-result-for "epg" (context name)) -(declare-function epg-signature-status "epg" (signature) t) -(declare-function epg-signature-to-string "epg" (signature)) - -(defun package--display-verify-error (context sig-file) - "Show error details with CONTEXT for failed verification of SIG-FILE. -The details are shown in a new buffer called \"*Error\"." - (unless (equal (epg-context-error-output context) "") - (with-output-to-temp-buffer "*Error*" - (with-current-buffer standard-output - (if (epg-context-result-for context 'verify) - (insert (format "Failed to verify signature %s:\n" sig-file) - (mapconcat #'epg-signature-to-string - (epg-context-result-for context 'verify) - "\n")) - (insert (format "Error while verifying signature %s:\n" sig-file))) - (insert "\nCommand output:\n" (epg-context-error-output context)))))) - -(defmacro package--with-work-buffer (location file &rest body) - "Run BODY in a buffer containing the contents of FILE at LOCATION. -LOCATION is the base location of a package archive, and should be -one of the URLs (or file names) specified in `package-archives'. -FILE is the name of a file relative to that base location. - -This macro retrieves FILE from LOCATION into a temporary buffer, -and evaluates BODY while that buffer is current. This work -buffer is killed afterwards. Return the last value in BODY." - (declare (indent 2) (debug t) - (obsolete package--with-response-buffer "25.1")) - `(with-temp-buffer - (if (string-match-p "\\`https?:" ,location) - (url-insert-file-contents (concat ,location ,file)) - (unless (file-name-absolute-p ,location) - (error "Archive location %s is not an absolute file name" - ,location)) - (insert-file-contents (expand-file-name ,file ,location))) - ,@body)) - -(cl-defmacro package--with-response-buffer (url &rest body &key async file error-form noerror &allow-other-keys) - "Access URL and run BODY in a buffer containing the response. -Point is after the headers when BODY runs. -FILE, if provided, is added to URL. -URL can be a local file name, which must be absolute. -ASYNC, if non-nil, runs the request asynchronously. -ERROR-FORM is run only if a connection error occurs. If NOERROR -is non-nil, don't propagate connection errors (does not apply to -errors signaled by ERROR-FORM or by BODY). - -\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" - (declare (indent defun) (debug (sexp body))) - (while (keywordp (car body)) - (setq body (cdr (cdr body)))) - `(package--with-response-buffer-1 ,url (lambda () ,@body) - :file ,file - :async ,async - :error-function (lambda () ,error-form) - :noerror ,noerror)) - -(defmacro package--unless-error (body &rest before-body) - (declare (debug t) (indent 1)) - (let ((err (make-symbol "err"))) - `(with-temp-buffer - (set-buffer-multibyte nil) - (when (condition-case ,err - (progn ,@before-body t) - (error (funcall error-function) - (unless noerror - (signal (car ,err) (cdr ,err))))) - (funcall ,body))))) - -(cl-defun package--with-response-buffer-1 (url body &key async file error-function noerror &allow-other-keys) - (if (string-match-p "\\`https?:" url) - (let ((url (url-expand-file-name file url))) - (if async - (package--unless-error #'ignore - (url-retrieve - url - (lambda (status) - (let ((b (current-buffer))) - (require 'url-handlers) - (package--unless-error body - (when-let* ((er (plist-get status :error))) - (error "Error retrieving: %s %S" url er)) - (with-current-buffer b - (goto-char (point-min)) - (unless (search-forward-regexp "^\r?\n\r?" nil t) - (error "Error retrieving: %s %S" - url "incomprehensible buffer"))) - (url-insert b) - (kill-buffer b) - (goto-char (point-min))))) - nil - 'silent)) - (package--unless-error body - ;; Copy&pasted from url-insert-file-contents, - ;; except it calls `url-insert' because we want the contents - ;; literally (but there's no url-insert-file-contents-literally). - (let ((buffer (url-retrieve-synchronously url))) - (unless buffer (signal 'file-error (list url "No Data"))) - (when (fboundp 'url-http--insert-file-helper) - ;; XXX: This is HTTP/S specific and should be moved - ;; to url-http instead. See bug#17549. - (url-http--insert-file-helper buffer url)) - (url-insert buffer) - (kill-buffer buffer) - (goto-char (point-min)))))) - (package--unless-error body - (unless (file-name-absolute-p url) - (error "Location %s is not a url nor an absolute file name" url)) - (insert-file-contents-literally (expand-file-name file url))))) - -(define-error 'bad-signature "Failed to verify signature") - -(defun package--check-signature-content (content string &optional sig-file) - "Check signature CONTENT against STRING. -SIG-FILE is the name of the signature file, used when signaling -errors." - (let ((context (epg-make-context 'OpenPGP))) - (when package-gnupghome-dir - (setf (epg-context-home-directory context) package-gnupghome-dir)) - (condition-case error - (epg-verify-string context content string) - (error (package--display-verify-error context sig-file) - (signal 'bad-signature error))) - (let (good-signatures had-fatal-error) - ;; The .sig file may contain multiple signatures. Success if one - ;; of the signatures is good. - (dolist (sig (epg-context-result-for context 'verify)) - (if (eq (epg-signature-status sig) 'good) - (push sig good-signatures) - ;; If `package-check-signature' is allow-unsigned, don't - ;; signal error when we can't verify signature because of - ;; missing public key. Other errors are still treated as - ;; fatal (bug#17625). - (unless (and (eq (package-check-signature) 'allow-unsigned) - (eq (epg-signature-status sig) 'no-pubkey)) - (setq had-fatal-error t)))) - (when (or (null good-signatures) - (and (eq (package-check-signature) 'all) - had-fatal-error)) - (package--display-verify-error context sig-file) - (signal 'bad-signature (list sig-file))) - good-signatures))) - -(defun package--check-signature (location file &optional string async callback unwind) - "Check signature of the current buffer. -Download the signature file from LOCATION by appending \".sig\" -to FILE. -GnuPG keyring location depends on `package-gnupghome-dir'. -STRING is the string to verify, it defaults to `buffer-string'. -If ASYNC is non-nil, the download of the signature file is -done asynchronously. - -If the signature does not verify, signal an error. -If the signature is verified and CALLBACK was provided, `funcall' -CALLBACK with the list of good signatures as argument (the list -can be empty). -If no signatures file is found, and `package-check-signature' is -`allow-unsigned', call CALLBACK with a nil argument. -Otherwise, an error is signaled. - -UNWIND, if provided, is a function to be called after everything -else, even if an error is signaled." - (let ((sig-file (concat file ".sig")) - (string (or string (buffer-string)))) - (package--with-response-buffer location :file sig-file - :async async :noerror t - ;; Connection error is assumed to mean "no sig-file". - :error-form (let ((allow-unsigned - (eq (package-check-signature) 'allow-unsigned))) - (when (and callback allow-unsigned) - (funcall callback nil)) - (when unwind (funcall unwind)) - (unless allow-unsigned - (error "Unsigned file `%s' at %s" file location))) - ;; OTOH, an error here means "bad signature", which we never - ;; suppress. (Bug#22089) - (unwind-protect - (let ((sig (package--check-signature-content - (buffer-substring (point) (point-max)) - string sig-file))) - (when callback (funcall callback sig)) - sig) - (when unwind (funcall unwind)))))) - -;;; Packages on Archives -;; The following variables store information about packages available -;; from archives. The most important of these is -;; `package-archive-contents' which is initially populated by the -;; function `package-read-all-archive-contents' from a cache on disk. -;; The `package-initialize' command is also closely related to this -;; section, but it has its own section. - -(defconst package-archive-version 1 - "Version number of the package archive understood by package.el. -Lower version numbers than this will probably be understood as well.") - -;; We don't prime the cache since it tends to get out of date. -(defvar package-archive-contents nil - "Cache of the contents of all archives in `package-archives'. -This is an alist mapping package names (symbols) to -non-empty lists of `package-desc' structures.") -(put 'package-archive-contents 'risky-local-variable t) - -(defvar package--compatibility-table nil - "Hash table connecting package names to their compatibility. -Each key is a symbol, the name of a package. - -The value is either nil, representing an incompatible package, or -a version list, representing the highest compatible version of -that package which is available. - -A package is considered incompatible if it requires an Emacs -version higher than the one being used. To check for package -\(in)compatibility, don't read this table directly, use -`package--incompatible-p' which also checks dependencies.") - -(defun package--build-compatibility-table () - "Build `package--compatibility-table' with `package--mapc'." - ;; Initialize the list of built-ins. - (require 'finder-inf nil t) - ;; Build compat table. - (setq package--compatibility-table (make-hash-table :test 'eq)) - (package--mapc #'package--add-to-compatibility-table)) - -(defun package--add-to-compatibility-table (pkg) - "If PKG is compatible (without dependencies), add to the compatibility table. -PKG is a package-desc object. -Only adds if its version is higher than what's already stored in -the table." - (unless (package--incompatible-p pkg 'shallow) - (let* ((name (package-desc-name pkg)) - (version (or (package-desc-version pkg) '(0))) - (table-version (gethash name package--compatibility-table))) - (when (or (not table-version) - (version-list-< table-version version)) - (puthash name version package--compatibility-table))))) - -;; Package descriptor objects used inside the "archive-contents" file. -;; Changing this defstruct implies changing the format of the -;; "archive-contents" files. -(cl-defstruct (package--ac-desc - (:constructor package-make-ac-desc (version reqs summary kind extras)) - (:copier nil) - (:type vector)) - version reqs summary kind extras) - -(defun package--append-to-alist (pkg-desc alist) - "Append an entry for PKG-DESC to the start of ALIST and return it. -This entry takes the form (`package-desc-name' PKG-DESC). - -If ALIST already has an entry with this name, destructively add -PKG-DESC to the cdr of this entry instead, sorted by version -number." - (let* ((name (package-desc-name pkg-desc)) - (priority-version (package-desc-priority-version pkg-desc)) - (existing-packages (assq name alist))) - (if (not existing-packages) - (cons (list name pkg-desc) - alist) - (while (if (and (cdr existing-packages) - (version-list-< priority-version - (package-desc-priority-version - (cadr existing-packages)))) - (setq existing-packages (cdr existing-packages)) - (push pkg-desc (cdr existing-packages)) - nil)) - alist))) - -(defun package--add-to-archive-contents (package archive) - "Add the PACKAGE from the given ARCHIVE if necessary. -PACKAGE should have the form (NAME . PACKAGE--AC-DESC). -Also, add the originating archive to the `package-desc' structure." - (let* ((name (car package)) - (version (package--ac-desc-version (cdr package))) - (pkg-desc - (package-desc-create - :name name - :version version - :reqs (package--ac-desc-reqs (cdr package)) - :summary (package--ac-desc-summary (cdr package)) - :kind (package--ac-desc-kind (cdr package)) - :archive archive - :extras (and (> (length (cdr package)) 4) - ;; Older archive-contents files have only 4 - ;; elements here. - (package--ac-desc-extras (cdr package))))) - (pinned-to-archive (assoc name package-pinned-packages))) - ;; Skip entirely if pinned to another archive. - (when (not (and pinned-to-archive - (not (equal (cdr pinned-to-archive) archive)))) - (setq package-archive-contents - (package--append-to-alist pkg-desc package-archive-contents))))) - -(defun package--read-archive-file (file) - "Read cached archive FILE data, if it exists. -Return the data from the file, or nil if the file does not exist. -If the archive version is too new, signal an error." - (let ((filename (expand-file-name file package-user-dir))) - (when (file-exists-p filename) - (with-temp-buffer - (let ((coding-system-for-read 'utf-8)) - (insert-file-contents filename)) - (let ((contents (read (current-buffer)))) - (if (> (car contents) package-archive-version) - (error "Package archive version %d is higher than %d" - (car contents) package-archive-version)) - (cdr contents)))))) - -(defun package-read-archive-contents (archive) - "Read cached archive file for ARCHIVE. -If successful, set or update the variable `package-archive-contents'. -ARCHIVE should be a string matching the name of a package archive -in the variable `package-archives'. -If the archive version is too new, signal an error." - ;; Version 1 of 'archive-contents' is identical to our internal - ;; representation. - (let* ((contents-file (format "archives/%s/archive-contents" archive)) - (contents (package--read-archive-file contents-file))) - (when contents - (dolist (package contents) - (if package - (package--add-to-archive-contents package archive) - (lwarn '(package refresh) :warning - "Ignoring nil package on `%s' package archive" archive)))))) - -(defvar package--old-archive-priorities nil - "Store currently used `package-archive-priorities'. -This is the value of `package-archive-priorities' last time -`package-read-all-archive-contents' was called. It can be used -by arbitrary functions to decide whether it is necessary to call -it again.") - -(defvar package-read-archive-hook (list #'package-read-archive-contents) - "List of functions to call to read the archive contents. -Each function must take an optional argument, a symbol indicating -what archive to read in. The symbol ought to be a key in -`package-archives'.") - -(defun package-read-all-archive-contents () - "Read cached archive file for all archives in `package-archives'. -If successful, set or update `package-archive-contents'." - (setq package-archive-contents nil) - (setq package--old-archive-priorities package-archive-priorities) - (dolist (archive package-archives) - (run-hook-with-args 'package-read-archive-hook (car archive)))) - - -;;;; Package Initialize -;; A bit of a milestone. This brings together some of the above -;; sections and populates all relevant lists of packages from contents -;; available on disk. - -(defvar package--initialized nil - "Non-nil if `package-initialize' has been run.") ;;;###autoload (defvar package--activated nil "Non-nil if `package-activate-all' has been run.") -;;;###autoload -(defun package-initialize (&optional no-activate) - "Load Emacs Lisp packages, and activate them. -The variable `package-load-list' controls which packages to load. -If optional arg NO-ACTIVATE is non-nil, don't activate packages. - -It is not necessary to adjust `load-path' or `require' the -individual packages after calling `package-initialize' -- this is -taken care of by `package-initialize'. - -If `package-initialize' is called twice during Emacs startup, -signal a warning, since this is a bad idea except in highly -advanced use cases. To suppress the warning, remove the -superfluous call to `package-initialize' from your init-file. If -you have code which must run before `package-initialize', put -that code in the early init-file." - (interactive) - (when (and package--initialized (not after-init-time)) - (lwarn '(package reinitialization) :warning - "Unnecessary call to `package-initialize' in init file")) - (setq package-alist nil) - (package-load-all-descriptors) - (package-read-all-archive-contents) - (setq package--initialized t) - (unless no-activate - (package-activate-all)) - ;; This uses `package--mapc' so it must be called after - ;; `package--initialized' is t. - (package--build-compatibility-table)) - ;;;###autoload (progn ;; Make the function usable without loading `package.el'. (defun package-activate-all () @@ -1757,444 +468,10 @@ The variable `package-load-list' controls which packages to load." ;; Don't let failure of activation of a package arbitrarily stop ;; activation of further packages. (error (message "%s" (error-message-string err)))))) - -;;;; Populating `package-archive-contents' from archives -;; This subsection populates the variables listed above from the -;; actual archives, instead of from a local cache. -(defvar package--downloads-in-progress nil - "List of in-progress asynchronous downloads.") +;;;; Inferring package from current buffer -(declare-function epg-import-keys-from-file "epg" (context keys)) - -;;;###autoload -(defun package-import-keyring (&optional file) - "Import keys from FILE." - (interactive "fFile: ") - (setq file (expand-file-name file)) - (let ((context (epg-make-context 'OpenPGP))) - (when package-gnupghome-dir - (with-file-modes #o700 - (make-directory package-gnupghome-dir t)) - (setf (epg-context-home-directory context) package-gnupghome-dir)) - (message "Importing %s..." (file-name-nondirectory file)) - (epg-import-keys-from-file context file) - (message "Importing %s...done" (file-name-nondirectory file)))) - -(defvar package--post-download-archives-hook nil - "Hook run after the archive contents are downloaded. -Don't run this hook directly. It is meant to be run as part of -`package--update-downloads-in-progress'.") -(put 'package--post-download-archives-hook 'risky-local-variable t) - -(defun package--update-downloads-in-progress (entry) - "Remove ENTRY from `package--downloads-in-progress'. -Once it's empty, run `package--post-download-archives-hook'." - ;; Keep track of the downloading progress. - (setq package--downloads-in-progress - (remove entry package--downloads-in-progress)) - ;; If this was the last download, run the hook. - (unless package--downloads-in-progress - (package-read-all-archive-contents) - (package--build-compatibility-table) - ;; We message before running the hook, so the hook can give - ;; messages as well. - (message "Package refresh done") - (run-hooks 'package--post-download-archives-hook))) - -(defun package--download-one-archive (archive file &optional async) - "Retrieve an archive file FILE from ARCHIVE, and cache it. -ARCHIVE should be a cons cell of the form (NAME . LOCATION), -similar to an entry in `package-alist'. Save the cached copy to -\"archives/NAME/FILE\" in `package-user-dir'." - ;; The downloaded archive contents will be read as part of - ;; `package--update-downloads-in-progress'. - (when async - (cl-pushnew (cons archive file) package--downloads-in-progress - :test #'equal)) - (package--with-response-buffer (cdr archive) :file file - :async async - :error-form (package--update-downloads-in-progress (cons archive file)) - (let* ((location (cdr archive)) - (name (car archive)) - (content (buffer-string)) - (dir (expand-file-name (concat "archives/" name) package-user-dir)) - (local-file (expand-file-name file dir))) - (when (listp (read content)) - (make-directory dir t) - (if (or (not (package-check-signature)) - (member name package-unsigned-archives)) - ;; If we don't care about the signature, save the file and - ;; we're done. - (progn - (cl-assert (not enable-multibyte-characters)) - (let ((coding-system-for-write 'binary)) - (write-region content nil local-file nil 'silent)) - (package--update-downloads-in-progress (cons archive file))) - ;; If we care, check it (perhaps async) and *then* write the file. - (package--check-signature - location file content async - ;; This function will be called after signature checking. - (lambda (&optional good-sigs) - (cl-assert (not enable-multibyte-characters)) - (let ((coding-system-for-write 'binary)) - (write-region content nil local-file nil 'silent)) - ;; Write out good signatures into archive-contents.signed file. - (when good-sigs - (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") - nil (concat local-file ".signed") nil 'silent))) - (lambda () (package--update-downloads-in-progress (cons archive file))))))))) - -(defun package--download-and-read-archives (&optional async) - "Download descriptions of all `package-archives' and read them. -Populate `package-archive-contents' with the result. - -If optional argument ASYNC is non-nil, perform the downloads -asynchronously." - (dolist (archive package-archives) - (condition-case-unless-debug err - (package--download-one-archive archive "archive-contents" async) - (error (message "Failed to download `%s' archive: %s" - (car archive) - (error-message-string err)))))) - -(defvar package-refresh-contents-hook (list #'package--download-and-read-archives) - "List of functions to call to refresh the package archive. -Each function may take an optional argument indicating that the -operation ought to be executed asynchronously.") - -;;;###autoload -(defun package-refresh-contents (&optional async) - "Download descriptions of all configured ELPA packages. -For each archive configured in the variable `package-archives', -inform Emacs about the latest versions of all packages it offers, -and make them available for download. -Optional argument ASYNC specifies whether to perform the -downloads in the background. This is always the case when the command -is invoked interactively." - (interactive (list t)) - (when async - (message "Refreshing package contents...")) - (unless (file-exists-p package-user-dir) - (make-directory package-user-dir t)) - (let ((default-keyring (expand-file-name "package-keyring.gpg" - data-directory)) - (inhibit-message (or inhibit-message async))) - (when (and (package-check-signature) (file-exists-p default-keyring)) - (condition-case-unless-debug error - (package-import-keyring default-keyring) - (error (message "Cannot import default keyring: %s" - (error-message-string error)))))) - (run-hook-with-args 'package-refresh-contents-hook async)) - - -;;; Dependency Management -;; Calculating the full transaction necessary for an installation, -;; keeping track of which packages were installed strictly as -;; dependencies, and determining which packages cannot be removed -;; because they are dependencies. - -(defun package-compute-transaction (packages requirements &optional seen) - "Return a list of packages to be installed, including PACKAGES. -PACKAGES should be a list of `package-desc'. - -REQUIREMENTS should be a list of additional requirements; each -element in this list should have the form (PACKAGE VERSION-LIST), -where PACKAGE is a package name and VERSION-LIST is the required -version of that package. - -This function recursively computes the requirements of the -packages in REQUIREMENTS, and returns a list of all the packages -that must be installed. Packages that are already installed are -not included in this list. - -SEEN is used internally to detect infinite recursion." - ;; FIXME: We really should use backtracking to explore the whole - ;; search space (e.g. if foo require bar-1.3, and bar-1.4 requires toto-1.1 - ;; whereas bar-1.3 requires toto-1.0 and the user has put a hold on toto-1.0: - ;; the current code might fail to see that it could install foo by using the - ;; older bar-1.3). - (dolist (elt requirements) - (let* ((next-pkg (car elt)) - (next-version (cadr elt)) - (already ())) - (dolist (pkg packages) - (if (eq next-pkg (package-desc-name pkg)) - (setq already pkg))) - (when already - (if (version-list-<= next-version (package-desc-version already)) - ;; `next-pkg' is already in `packages', but its position there - ;; means it might be installed too late: remove it from there, so - ;; we re-add it (along with its dependencies) at an earlier place - ;; below (bug#16994). - (if (memq already seen) ;Avoid inf-loop on dependency cycles. - (message "Dependency cycle going through %S" - (package-desc-full-name already)) - (setq packages (delq already packages)) - (setq already nil)) - (error "Need package `%s-%s', but only %s is being installed" - next-pkg (package-version-join next-version) - (package-version-join (package-desc-version already))))) - (cond - (already nil) - ((package-installed-p next-pkg next-version) nil) - - (t - ;; A package is required, but not installed. It might also be - ;; blocked via `package-load-list'. - (let ((pkg-descs (cdr (assq next-pkg package-archive-contents))) - (found nil) - (found-something nil) - (problem nil)) - (while (and pkg-descs (not found)) - (let* ((pkg-desc (pop pkg-descs)) - (version (package-desc-version pkg-desc)) - (disabled (package-disabled-p next-pkg version))) - (cond - ((version-list-< version next-version) - ;; pkg-descs is sorted by priority, not version, so - ;; don't error just yet. - (unless found-something - (setq found-something (package-version-join version)))) - (disabled - (unless problem - (setq problem - (if (stringp disabled) - (format-message - "Package `%s' held at version %s, but version %s required" - next-pkg disabled - (package-version-join next-version)) - (format-message "Required package `%s' is disabled" - next-pkg))))) - (t (setq found pkg-desc))))) - (unless found - (cond - (problem (error "%s" problem)) - (found-something - (error "Need package `%s-%s', but only %s is available" - next-pkg (package-version-join next-version) - found-something)) - (t - (if (eq next-pkg 'emacs) - (error "This package requires Emacs version %s" - (package-version-join next-version)) - (error (if (not next-version) - (format "Package `%s' is unavailable" next-pkg) - (format "Package `%s' (version %s) is unavailable" - next-pkg (package-version-join next-version)))))))) - (setq packages - (package-compute-transaction (cons found packages) - (package-desc-reqs found) - (cons found seen)))))))) - packages) - -(defun package--find-non-dependencies () - "Return a list of installed packages which are not dependencies. -Finds all packages in `package-alist' which are not dependencies -of any other packages. -Used to populate `package-selected-packages'." - (let ((dep-list - (delete-dups - (apply #'append - (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr p)))) - package-alist))))) - (cl-loop for p in package-alist - for name = (car p) - unless (memq name dep-list) - collect name))) - -(defun package--save-selected-packages (&optional value) - "Set and save `package-selected-packages' to VALUE." - (when (or value after-init-time) - ;; It is valid to set it to nil, for example when the last package - ;; is uninstalled. But it shouldn't be done at init time, to - ;; avoid overwriting configurations that haven't yet been loaded. - (setq package-selected-packages (sort value #'string<))) - (if after-init-time - (customize-save-variable 'package-selected-packages package-selected-packages) - (add-hook 'after-init-hook #'package--save-selected-packages))) - -(defun package--user-selected-p (pkg) - "Return non-nil if PKG is a package was installed by the user. -PKG is a package name. -This looks into `package-selected-packages', populating it first -if it is still empty." - (unless (consp package-selected-packages) - (package--save-selected-packages (package--find-non-dependencies))) - (memq pkg package-selected-packages)) - -(defun package--get-deps (pkgs) - (let ((seen '())) - (while pkgs - (let ((pkg (pop pkgs))) - (if (memq pkg seen) - nil ;; Done already! - (let ((pkg-desc (cadr (assq pkg package-alist)))) - (when pkg-desc - (push pkg seen) - (setq pkgs (append (mapcar #'car (package-desc-reqs pkg-desc)) - pkgs))))))) - seen)) - -(defun package--user-installed-p (package) - "Return non-nil if PACKAGE is a user-installed package. -PACKAGE is the package name, a symbol. Check whether the package -was installed into `package-user-dir' where we assume to have -control over." - (let* ((pkg-desc (cadr (assq package package-alist))) - (dir (package-desc-dir pkg-desc))) - (file-in-directory-p dir package-user-dir))) - -(defun package--removable-packages () - "Return a list of names of packages no longer needed. -These are packages which are neither contained in -`package-selected-packages' nor a dependency of one that is." - (let ((needed (package--get-deps package-selected-packages))) - (cl-loop for p in (mapcar #'car package-alist) - unless (or (memq p needed) - ;; Do not auto-remove external packages. - (not (package--user-installed-p p))) - collect p))) - -(defun package--used-elsewhere-p (pkg-desc &optional pkg-list all) - "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST. -Return the first package found in PKG-LIST of which PKG is a -dependency. If ALL is non-nil, return all such packages instead. - -When not specified, PKG-LIST defaults to `package-alist' -with PKG-DESC entry removed." - (unless (string= (package-desc-status pkg-desc) "obsolete") - (let* ((pkg (package-desc-name pkg-desc)) - (alist (or pkg-list - (remove (assq pkg package-alist) - package-alist)))) - (if all - (cl-loop for p in alist - if (assq pkg (package-desc-reqs (cadr p))) - collect (cadr p)) - (cl-loop for p in alist thereis - (and (assq pkg (package-desc-reqs (cadr p))) - (cadr p))))))) - -(defun package--sort-deps-in-alist (package only) - "Return a list of dependencies for PACKAGE sorted by dependency. -PACKAGE is included as the first element of the returned list. -ONLY is an alist associating package names to package objects. -Only these packages will be in the return value and their cdrs are -destructively set to nil in ONLY." - (let ((out)) - (dolist (dep (package-desc-reqs package)) - (when-let* ((cell (assq (car dep) only)) - (dep-package (cdr-safe cell))) - (setcdr cell nil) - (setq out (append (package--sort-deps-in-alist dep-package only) - out)))) - (cons package out))) - -(defun package--sort-by-dependence (package-list) - "Return PACKAGE-LIST sorted by dependence. -That is, any element of the returned list is guaranteed to not -directly depend on any elements that come before it. - -PACKAGE-LIST is a list of `package-desc' objects. -Indirect dependencies are guaranteed to be returned in order only -if all the in-between dependencies are also in PACKAGE-LIST." - (let ((alist (mapcar (lambda (p) (cons (package-desc-name p) p)) package-list)) - out-list) - (dolist (cell alist out-list) - ;; `package--sort-deps-in-alist' destructively changes alist, so - ;; some cells might already be empty. We check this here. - (when-let* ((pkg-desc (cdr cell))) - (setcdr cell nil) - (setq out-list - (append (package--sort-deps-in-alist pkg-desc alist) - out-list)))))) - - -;;; Installation Functions -;; As opposed to the previous section (which listed some underlying -;; functions necessary for installation), this one contains the actual -;; functions that install packages. The package itself can be -;; installed in a variety of ways (archives, buffer, file), but -;; requirements (dependencies) are always satisfied by looking in -;; `package-archive-contents'. -;; -;; If Emacs installs a package from a package archive, it might create -;; some files in addition to the package's contents. For example: -;; -;; - If the package archive provides a non-trivial long description for -;; some package in "PACKAGE-readme.txt", Emacs stores it in a file -;; named "README-elpa" in the package's content directory, unless the -;; package itself provides such a file. -;; -;; - If a package archive provides package signatures, Emacs stores -;; information on the signatures in files named "NAME-VERSION.signed" -;; below directory `package-user-dir'. - -(defun package-archive-base (desc) - "Return the package described by DESC." - (cdr (assoc (package-desc-archive desc) package-archives))) - -(defun package-install-from-archive (pkg-desc) - "Download and install a package defined by PKG-DESC." - ;; This won't happen, unless the archive is doing something wrong. - (when (eq (package-desc-kind pkg-desc) 'dir) - (error "Can't install directory package from archive")) - (let* ((location (package-archive-base pkg-desc)) - (file (concat (package-desc-full-name pkg-desc) - (package-desc-suffix pkg-desc)))) - (package--with-response-buffer location :file file - (if (or (not (package-check-signature)) - (member (package-desc-archive pkg-desc) - package-unsigned-archives)) - ;; If we don't care about the signature, unpack and we're - ;; done. - (let ((save-silently t)) - (package-unpack pkg-desc)) - ;; If we care, check it and *then* write the file. - (let ((content (buffer-string))) - (package--check-signature - location file content nil - ;; This function will be called after signature checking. - (lambda (&optional good-sigs) - ;; Signature checked, unpack now. - (with-temp-buffer ;FIXME: Just use the previous current-buffer. - (set-buffer-multibyte nil) - (cl-assert (not (multibyte-string-p content))) - (insert content) - (let ((save-silently t)) - (package-unpack pkg-desc))) - ;; Here the package has been installed successfully, mark it as - ;; signed if appropriate. - (when good-sigs - ;; Write out good signatures into NAME-VERSION.signed file. - (write-region (mapconcat #'epg-signature-to-string good-sigs "\n") - nil - (expand-file-name - (concat (package-desc-full-name pkg-desc) ".signed") - package-user-dir) - nil 'silent) - ;; Update the old pkg-desc which will be shown on the description buffer. - (setf (package-desc-signed pkg-desc) t) - ;; Update the new (activated) pkg-desc as well. - (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) - package-alist)))) - (setf (package-desc-signed (car pkg-descs)) t)))))))) - ;; fetch a backup of the readme file from the server. Slot `dir' is - ;; not yet available in PKG-DESC, so cobble that up. - (let* ((dirname (package-desc-full-name pkg-desc)) - (pkg-dir (expand-file-name dirname package-user-dir)) - (readme (expand-file-name "README-elpa" pkg-dir))) - (unless (file-readable-p readme) - (package--with-response-buffer (package-archive-base pkg-desc) - :file (format "%s-readme.txt" (package-desc-name pkg-desc)) - :noerror t - ;; do not write empty or whitespace-only readmes to give - ;; `package--get-description' a chance to find another readme - (unless (save-excursion - (goto-char (point-min)) - (looking-at-p "[[:space:]]*\\'")) - (write-region nil nil readme))))))) +(declare-function lm-package-version "lisp-mnt" (&optional file)) ;;;###autoload (defun package-installed-p (package &optional min-version) @@ -2208,7 +485,7 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." (let ((dir (package-desc-dir package))) (and (stringp dir) (file-exists-p dir)))) - ((and (not package--initialized) + ((and (not (bound-and-true-p package--initialized)) (null min-version) package-activated-list) ;; We used the quickstart: make it possible to use package-installed-p @@ -2226,2520 +503,6 @@ If PACKAGE is a `package-desc' object, MIN-VERSION is ignored." ;; Also check built-in packages. (package-built-in-p package min-version))))) -(defun package-download-transaction (packages) - "Download and install all the packages in PACKAGES. -PACKAGES should be a list of `package-desc'. -This function assumes that all package requirements in -PACKAGES are satisfied, i.e. that PACKAGES is computed -using `package-compute-transaction'." - (mapc #'package-install-from-archive packages)) - -(defun package--archives-initialize () - "Make sure the list of installed and remote packages are initialized." - (unless package--initialized - (package-initialize t)) - (unless package-archive-contents - (package-refresh-contents))) - -(defcustom package-install-upgrade-built-in nil - "Non-nil means that built-in packages can be upgraded via a package archive. -If disabled, then `package-install' will raise an error when trying to -replace a built-in package with a (possibly newer) version from a -package archive." - :type 'boolean - :version "29.1") - -;;;###autoload -(defun package-install (pkg &optional dont-select interactive) - "Install the package PKG. - -PKG can be a `package-desc', or a symbol naming one of the available -packages in an archive in `package-archives'. - -Mark the installed package as selected by adding it to -`package-selected-packages'. - -When called from Lisp and optional argument DONT-SELECT is -non-nil, install the package but do not add it to -`package-selected-packages'. - -If PKG is a `package-desc' and it is already installed, don't try -to install it but still mark it as selected. - -If the command is invoked with a prefix argument, it will allow -upgrading of built-in packages, as if `package-install-upgrade-built-in' -had been enabled." - (interactive - (progn - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (package--archives-initialize) - (list (intern (completing-read - "Install package: " - package-archive-contents - nil t)) - nil - 'interactive))) - (cl-check-type pkg (or symbol package-desc)) - (package--archives-initialize) - (add-hook 'post-command-hook #'package-menu--post-refresh) - (let ((name (if (package-desc-p pkg) - (package-desc-name pkg) - pkg))) - (if (or (and package-install-upgrade-built-in - (package--active-built-in-p pkg)) - (package-installed-p pkg)) - (funcall (if interactive #'user-error #'message) - "`%s' is already installed" name) - (unless (or dont-select (package--user-selected-p name)) - (package--save-selected-packages - (cons name package-selected-packages))) - (when (and (or current-prefix-arg package-install-upgrade-built-in) - (package--active-built-in-p pkg)) - (setq pkg (or (cadr (assq name package-archive-contents)) pkg))) - (if-let* ((transaction - (if (package-desc-p pkg) - (unless (package-installed-p pkg) - (package-compute-transaction (list pkg) - (package-desc-reqs pkg))) - (package-compute-transaction () (list (list pkg)))))) - (progn - (package-download-transaction transaction) - (package--quickstart-maybe-refresh) - (message "Package `%s' installed." name)))))) - - -(declare-function package-vc-upgrade "package-vc" (pkg)) - -;;;###autoload -(defun package-upgrade (name) - "Upgrade package NAME if a newer version exists. - -NAME should be a symbol." - (interactive - (list (intern (completing-read - "Upgrade package: " - (package--upgradeable-packages t) nil t)))) - (cl-check-type name symbol) - (let* ((pkg-desc (cadr (assq name package-alist))) - (package-install-upgrade-built-in (not pkg-desc))) - ;; `pkg-desc' will be nil when the package is an "active built-in". - (if (and pkg-desc (package-vc-p pkg-desc)) - (package-vc-upgrade pkg-desc) - (when pkg-desc - (package-delete pkg-desc 'force 'dont-unselect)) - (package-install name - ;; An active built-in has never been "selected" - ;; before. Mark it as installed explicitly. - (and pkg-desc 'dont-select))))) - -(defun package--upgradeable-packages (&optional include-builtins) - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (package--archives-initialize) - (mapcar - #'car - (seq-filter - (lambda (elt) - (or (let ((available - (assq (car elt) package-archive-contents))) - (and available - (or (and - include-builtins - (not (package-desc-version (cadr elt)))) - (version-list-< - (package-desc-version (cadr elt)) - (package-desc-version (cadr available)))))) - (package-vc-p (cadr elt)))) - (if include-builtins - (append package-alist - (mapcan - (lambda (elt) - (when (not (assq (car elt) package-alist)) - (list (list (car elt) (package--from-builtin elt))))) - package--builtins)) - package-alist)))) - -;;;###autoload -(defun package-upgrade-all (&optional query) - "Refresh package list and upgrade all packages. -If QUERY, ask the user before upgrading packages. When called -interactively, QUERY is always true. - -Currently, packages which are part of the Emacs distribution are -not upgraded by this command. To enable upgrading such a package -using this command, first upgrade the package to a newer version -from ELPA by either using `\\[package-upgrade]' or -`\\\\[package-menu-mark-install]' after `\\[list-packages]'." - (interactive (list (not noninteractive))) - (package-refresh-contents) - (let ((upgradeable (package--upgradeable-packages package-install-upgrade-built-in))) - (if (not upgradeable) - (message "No packages to upgrade") - (when (and query - (not (yes-or-no-p - (if (length= upgradeable 1) - "One package to upgrade. Do it? " - (format "%s packages to upgrade. Do it?" - (length upgradeable)))))) - (user-error "Upgrade aborted")) - (mapc #'package-upgrade upgradeable)))) - -(defun package--dependencies (pkg) - "Return a list of all transitive dependencies of PKG. -If PKG is a package descriptor, the return value is a list of -package descriptors. If PKG is a symbol designating a package, -the return value is a list of symbols designating packages." - (when-let* ((desc (if (package-desc-p pkg) pkg - (cadr (assq pkg package-archive-contents))))) - ;; Can we have circular dependencies? Assume "nope". - (let ((all (named-let more ((pkg-desc desc)) - (let (deps) - (dolist (req (package-desc-reqs pkg-desc)) - (setq deps (nconc - (catch 'found - (dolist (p (apply #'append (mapcar #'cdr (package--alist)))) - (when (and (string= (car req) (package-desc-name p)) - (version-list-<= (cadr req) (package-desc-version p))) - (throw 'found (more p))))) - deps))) - (delete-dups (cons pkg-desc deps)))))) - (remq pkg (mapcar (if (package-desc-p pkg) #'identity #'package-desc-name) all))))) - -(defun package-strip-rcs-id (str) - "Strip RCS version ID from the version string STR. -If the result looks like a dotted numeric version, return it. -Otherwise return nil." - (when str - (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str) - (setq str (substring str (match-end 0)))) - (let ((l (version-to-list str))) - ;; Don't return `str' but (package-version-join (version-to-list str)) - ;; to make sure we use a "canonical name"! - (if l (package-version-join l))))) - -(declare-function lm-website "lisp-mnt" (&optional file)) - -;;;###autoload -(defun package-install-from-buffer () - "Install a package from the current buffer. -The current buffer is assumed to be a single .el or .tar file or -a directory. These must follow the packaging guidelines (see -info node `(elisp)Packaging'). - -Specially, if current buffer is a directory, the -pkg.el -description file is not mandatory, in which case the information -is derived from the main .el file in the directory. Using Dired, -you can restrict what files to install by marking specific files. - -Downloads and installs required packages as needed." - (interactive) - (let* ((pkg-desc - (cond - ((derived-mode-p 'dired-mode) - ;; This is the only way a package-desc object with a `dir' - ;; desc-kind can be created. Such packages can't be - ;; uploaded or installed from archives, they can only be - ;; installed from local buffers or directories. - (package-dir-info)) - ((derived-mode-p 'tar-mode) - (package-tar-file-info)) - (t - ;; Package headers should be parsed from decoded text - ;; (see Bug#48137) where possible. - (if (and (eq buffer-file-coding-system 'no-conversion) - buffer-file-name) - (let* ((package-buffer (current-buffer)) - (decoding-system - (car (find-operation-coding-system - 'insert-file-contents - (cons buffer-file-name - package-buffer))))) - (with-temp-buffer - (insert-buffer-substring package-buffer) - (decode-coding-region (point-min) (point-max) - decoding-system) - (package-buffer-info))) - - (save-excursion - (package-buffer-info)))))) - (name (package-desc-name pkg-desc))) - ;; Download and install the dependencies. - (let* ((requires (package-desc-reqs pkg-desc)) - (transaction (package-compute-transaction nil requires))) - (package-download-transaction transaction)) - ;; Install the package itself. - (package-unpack pkg-desc) - (unless (package--user-selected-p name) - (package--save-selected-packages - (cons name package-selected-packages))) - (package--quickstart-maybe-refresh) - pkg-desc)) - -;;;###autoload -(defun package-install-file (file) - "Install a package from FILE. -The file can either be a tar file, an Emacs Lisp file, or a -directory." - (interactive "fPackage file name: ") - (with-temp-buffer - (if (file-directory-p file) - (progn - (setq default-directory file) - (dired-mode)) - (insert-file-contents-literally file) - (set-visited-file-name file) - (set-buffer-modified-p nil) - (when (string-match "\\.tar\\'" file) (tar-mode))) - (unwind-protect - (package-install-from-buffer) - (fundamental-mode)))) ; free auxiliary data - -;;;###autoload -(defun package-install-selected-packages (&optional noconfirm) - "Ensure packages in `package-selected-packages' are installed. -If some packages are not installed, propose to install them. - -If optional argument NOCONFIRM is non-nil, or when invoked with a prefix -argument, don't ask for confirmation to install packages." - (interactive "P") - (package--archives-initialize) - ;; We don't need to populate `package-selected-packages' before - ;; using here, because the outcome is the same either way (nothing - ;; gets installed). - (if (not package-selected-packages) - (message "`package-selected-packages' is empty, nothing to install") - (let* ((not-installed (seq-remove #'package-installed-p package-selected-packages)) - (available (seq-filter (lambda (p) (assq p package-archive-contents)) not-installed)) - (difference (- (length not-installed) (length available)))) - (cond - (available - (when (or noconfirm - (y-or-n-p - (format "Packages to install: %d (%s), proceed? " - (length available) - (mapconcat #'symbol-name available " ")))) - (mapc (lambda (p) (package-install p 'dont-select)) available))) - ((> difference 0) - (message (substitute-command-keys - "Packages that are not available: %d (the rest is already \ -installed), maybe you need to \\[package-refresh-contents]") - difference)) - (t - (message "All your packages are already installed")))))) - - -;;; Package Deletion - -(defun package--newest-p (pkg) - "Return non-nil if PKG is the newest package with its name." - (equal (cadr (assq (package-desc-name pkg) package-alist)) - pkg)) - -(declare-function comp-el-to-eln-filename "comp.c") -(defvar package-vc-repository-store) -(defun package--delete-directory (dir) - "Delete PKG-DESC directory DIR recursively. -Clean-up the corresponding .eln files if Emacs is native -compiled, and remove the DIR from `load-path'." - (setq load-path (cl-remove-if (lambda (s) (file-in-directory-p s dir)) - load-path)) - (when (featurep 'native-compile) - (cl-loop - for file in (directory-files-recursively dir - ;; Exclude lockfiles - (rx bos (or (and "." (not "#")) (not ".")) (* nonl) ".el" eos)) - do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) - (if (file-symlink-p (directory-file-name dir)) - (delete-file (directory-file-name dir)) - (delete-directory dir t))) - - -(defun package-delete (pkg-desc &optional force nosave) - "Delete package PKG-DESC. - -Argument PKG-DESC is the full description of the package, for example as -obtained by `package-get-descriptor'. Interactively, prompt the user -for the package name and version. - -When package is used elsewhere as dependency of another package, -refuse deleting it and return an error. -If prefix argument FORCE is non-nil, package will be deleted even -if it is used elsewhere. -If NOSAVE is non-nil, the package is not removed from -`package-selected-packages'." - (interactive - (progn - (let* ((package-table - (mapcar - (lambda (p) (cons (package-desc-full-name p) p)) - (delq nil - (mapcar (lambda (p) (unless (package-built-in-p p) p)) - (apply #'append (mapcar #'cdr (package--alist))))))) - (package-name (completing-read "Delete package: " - (mapcar #'car package-table) - nil t))) - (list (cdr (assoc package-name package-table)) - current-prefix-arg nil)))) - (let* ((dir (package-desc-dir pkg-desc)) - (name (package-desc-name pkg-desc)) - (new-package-alist (let ((pkgs (assq name package-alist))) - (if (null (remove pkg-desc (cdr pkgs))) - (remq pkgs package-alist) - package-alist))) - pkg-used-elsewhere-by) - ;; If the user is trying to delete this package, they definitely - ;; don't want it marked as selected, so we remove it from - ;; `package-selected-packages' even if it can't be deleted. - (when (and (null nosave) - (package--user-selected-p name) - ;; Don't deselect if this is an older version of an - ;; upgraded package. - (package--newest-p pkg-desc)) - (package--save-selected-packages (remove name package-selected-packages))) - (cond ((not (string-prefix-p (file-name-as-directory - (expand-file-name package-user-dir)) - (expand-file-name dir))) - ;; Don't delete "system" packages. - (error "Package `%s' is a system package, not deleting" - (package-desc-full-name pkg-desc))) - ((and (null force) - (setq pkg-used-elsewhere-by - (let ((package-alist new-package-alist)) - (package--used-elsewhere-p pkg-desc)))) ;See bug#65475 - ;; Don't delete packages used as dependency elsewhere. - (error "Package `%s' is used by `%s' as dependency, not deleting" - (package-desc-full-name pkg-desc) - (package-desc-name pkg-used-elsewhere-by))) - (t - (add-hook 'post-command-hook #'package-menu--post-refresh) - (package--delete-directory dir) - ;; Remove NAME-VERSION.signed and NAME-readme.txt files. - ;; - ;; NAME-readme.txt files are no longer created, but they - ;; may be left around from an earlier install. - (dolist (suffix '(".signed" "readme.txt")) - (let* ((version (package-version-join (package-desc-version pkg-desc))) - (file (concat (if (string= suffix ".signed") - dir - (substring dir 0 (- (length version)))) - suffix))) - (when (file-exists-p file) - (delete-file file)))) - ;; Update package-alist. - (setq package-alist new-package-alist) - (package--quickstart-maybe-refresh) - (message "Package `%s' deleted." - (package-desc-full-name pkg-desc)))))) - -;;;###autoload -(defun package-reinstall (pkg) - "Reinstall package PKG. -PKG should be either a symbol, the package name, or a `package-desc' -object." - (interactive - (progn - (package--archives-initialize) - (list (intern (completing-read - "Reinstall package: " - (mapcar #'symbol-name - (mapcar #'car package-alist))))))) - (package--archives-initialize) - (package-delete - (if (package-desc-p pkg) pkg (cadr (assq pkg package-alist))) - 'force 'nosave) - (package-install pkg 'dont-select)) - -;;;###autoload -(defun package-recompile (pkg) - "Byte-compile package PKG again. -PKG should be either a symbol, the package name, or a `package-desc' -object." - (interactive (list (intern (completing-read - "Recompile package: " - (mapcar #'symbol-name - (mapcar #'car package-alist)))))) - (let ((pkg-desc (if (package-desc-p pkg) - pkg - (cadr (assq pkg package-alist))))) - ;; Delete the old .elc files to ensure that we don't inadvertently - ;; load them (in case they contain byte code/macros that are now - ;; invalid). - (dolist (elc (directory-files-recursively - (package-desc-dir pkg-desc) "\\.elc\\'")) - (delete-file elc)) - (package--compile pkg-desc))) - -;;;###autoload -(defun package-recompile-all () - "Byte-compile all installed packages. -This is meant to be used only in the case the byte-compiled files -are invalid due to changed byte-code, macros or the like." - (interactive) - (pcase-dolist (`(_ ,pkg-desc) package-alist) - (with-demoted-errors "Error while recompiling: %S" - (package-recompile pkg-desc)))) - -;;;###autoload -(defun package-autoremove (&optional noconfirm) - "Remove packages that are no longer needed. - -Packages that are no more needed by other packages in -`package-selected-packages' and their dependencies -will be deleted. - -If optional argument NOCONFIRM is non-nil, or when invoked with a prefix -argument, don't ask for confirmation to install packages." - (interactive "P") - ;; If `package-selected-packages' is nil, it would make no sense to - ;; try to populate it here, because then `package-autoremove' will - ;; do absolutely nothing. - (when (or noconfirm - package-selected-packages - (yes-or-no-p - (format-message - "`package-selected-packages' is empty! Really remove ALL packages? "))) - (let ((removable (package--removable-packages))) - (if removable - (when (or noconfirm - (y-or-n-p - (format "Packages to delete: %d (%s), proceed? " - (length removable) - (mapconcat #'symbol-name removable " ")))) - (mapc (lambda (p) - (package-delete (cadr (assq p package-alist)) t)) - removable)) - (message "Nothing to autoremove"))))) - -(defun package-isolate (packages &optional temp-init) - "Start an uncustomized Emacs and only load a set of PACKAGES. -Interactively, prompt for PACKAGES to load, which should be specified -separated by commas. -If called from Lisp, PACKAGES should be a list of packages to load. -If TEMP-INIT is non-nil, or when invoked with a prefix argument, -the Emacs user directory is set to a temporary directory. -This command is intended for testing Emacs and/or the packages -in a clean environment." - (interactive - (cl-loop for p in (cl-loop for p in (package--alist) append (cdr p)) - unless (package-built-in-p p) - collect (cons (package-desc-full-name p) p) into table - finally return - (list - (cl-loop for c in - (completing-read-multiple - "Packages to isolate: " table - nil t) - collect (alist-get c table nil nil #'string=)) - current-prefix-arg))) - (let* ((name (concat "package-isolate-" - (mapconcat #'package-desc-full-name packages ","))) - (all-packages (delete-consecutive-dups - (sort (append packages (mapcan #'package--dependencies packages)) - (lambda (p0 p1) - (string< (package-desc-name p0) (package-desc-name p1)))))) - initial-scratch-message package-load-list) - (with-temp-buffer - (insert ";; This is an isolated testing environment, with these packages enabled:\n\n") - (dolist (package all-packages) - (push (list (package-desc-name package) - (package-version-join (package-desc-version package))) - package-load-list) - (insert ";; - " (package-desc-full-name package)) - (unless (memq package packages) - (insert " (dependency)")) - (insert "\n")) - (insert "\n") - (setq initial-scratch-message (buffer-string))) - (apply #'start-process (concat "*" name "*") nil - (list (expand-file-name invocation-name invocation-directory) - "--quick" "--debug-init" - "--init-directory" (if temp-init - (make-temp-file name t) - user-emacs-directory) - (format "--eval=%S" - `(progn - (setq initial-scratch-message ,initial-scratch-message) - - (require 'package) - ,@(mapcar - (lambda (dir) - `(add-to-list 'package-directory-list ,dir)) - (cons package-user-dir package-directory-list)) - (setq package-load-list ',package-load-list) - (package-activate-all))))))) - - -;;;; Package description buffer. - -;;;###autoload -(defun describe-package (package) - "Display the full documentation of PACKAGE (a symbol)." - (interactive - (let* ((guess (or (function-called-at-point) - (symbol-at-point)))) - (require 'finder-inf nil t) - ;; Load the package list if necessary (but don't activate them). - (unless package--initialized - (package-initialize t)) - (let ((packages (append (mapcar #'car package-alist) - (mapcar #'car package-archive-contents) - (mapcar #'car package--builtins)))) - (unless (memq guess packages) - (setq guess nil)) - (setq packages (mapcar #'symbol-name packages)) - (let ((val - (completing-read (format-prompt "Describe package" guess) - packages nil t nil nil (when guess - (symbol-name guess))))) - (list (and (> (length val) 0) (intern val))))))) - (if (not (or (package-desc-p package) (and package (symbolp package)))) - (message "No package specified") - (help-setup-xref (list #'describe-package package) - (called-interactively-p 'interactive)) - (with-help-window (help-buffer) - (with-current-buffer standard-output - (describe-package-1 package))))) - -(defface package-help-section-name - '((t :inherit (bold font-lock-function-name-face))) - "Face used on section names in package description buffers." - :version "25.1") - -(defun package--print-help-section (name &rest strings) - "Print \"NAME: \", right aligned to the 13th column. -If more STRINGS are provided, insert them followed by a newline. -Otherwise no newline is inserted." - (declare (indent 1)) - (insert (make-string (max 0 (- 11 (string-width name))) ?\s) - (propertize (concat name ": ") 'font-lock-face 'package-help-section-name)) - (when strings - (apply #'insert strings) - (insert "\n"))) - -(declare-function lm-commentary "lisp-mnt" (&optional file)) - -(defun package--get-description (desc) - "Return a string containing the long description of the package DESC. -The description is read from the installed package files." - ;; Installed packages have nil for kind, so we look for README - ;; first, then fall back to the Commentary header. - - ;; We don’t include README.md here, because that is often the home - ;; page on a site like github, and not suitable as the package long - ;; description. - (let ((files '("README-elpa" "README-elpa.md" "README" "README.rst" "README.org")) - file - (srcdir (package-desc-dir desc)) - result) - (while (and files - (not result)) - (setq file (pop files)) - (when (file-readable-p (expand-file-name file srcdir)) - ;; Found a README. - (with-temp-buffer - (insert-file-contents (expand-file-name file srcdir)) - (setq result (buffer-string))))) - - (or - result - - ;; Look for Commentary header. - (lm-commentary (expand-file-name - (format "%s.el" (package-desc-name desc)) srcdir)) - ""))) - -(defun package--describe-add-library-links () - "Add links to library names in package description." - (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) - (if (locate-library (match-string 1)) - (make-text-button (match-beginning 1) (match-end 1) - 'xref (match-string-no-properties 1) - 'help-echo "Read this file's commentary" - :type 'package--finder-xref)))) - -(defun describe-package-1 (pkg) - "Insert the package description for PKG. -Helper function for `describe-package'." - (require 'lisp-mnt) - (let* ((desc (or - (if (package-desc-p pkg) pkg) - (cadr (assq pkg package-alist)) - (let ((built-in (assq pkg package--builtins))) - (if built-in - (package--from-builtin built-in) - (cadr (assq pkg package-archive-contents)))))) - (name (if desc (package-desc-name desc) pkg)) - (pkg-dir (if desc (package-desc-dir desc))) - (reqs (if desc (package-desc-reqs desc))) - (required-by (if desc (package--used-elsewhere-p desc nil 'all))) - (version (if desc (package-desc-version desc))) - (archive (if desc (package-desc-archive desc))) - (extras (and desc (package-desc-extras desc))) - (website (cdr (assoc :url extras))) - (commit (cdr (assoc :commit extras))) - (keywords (if desc (package-desc--keywords desc))) - (built-in (eq pkg-dir 'builtin)) - (installable (and archive (not built-in))) - (status (if desc (package-desc-status desc) "orphan")) - (incompatible-reason (package--incompatible-p desc)) - (signed (if desc (package-desc-signed desc))) - (maintainers (or (cdr (assoc :maintainer extras)) - (cdr (assoc :maintainers extras)))) - (authors (cdr (assoc :authors extras))) - (news (and-let* (pkg-dir - ((not built-in)) - (file (expand-file-name "news" pkg-dir)) - ((file-regular-p file)) - ((file-readable-p file))) - file))) - (when (string= status "avail-obso") - (setq status "available obsolete")) - (when incompatible-reason - (setq status "incompatible")) - (princ (format "Package %S is %s.\n\n" name status)) - - ;; TODO: Remove the string decorations and reformat the strings - ;; for future l10n. - (package--print-help-section "Status") - (cond (built-in - (insert (propertize (capitalize status) - 'font-lock-face 'package-status-built-in) - ".")) - (pkg-dir - (insert (propertize (if (member status '("unsigned" "dependency")) - "Installed" - (capitalize status)) - 'font-lock-face 'package-status-built-in)) - (insert (substitute-command-keys " in `")) - (let ((dir (abbreviate-file-name - (file-name-as-directory - (if (file-in-directory-p pkg-dir package-user-dir) - (file-relative-name pkg-dir package-user-dir) - pkg-dir))))) - (help-insert-xref-button dir 'help-package-def pkg-dir)) - (if (and (package-built-in-p name) - (not (package-built-in-p name version))) - (insert (substitute-command-keys - "',\n shadowing a ") - (propertize "built-in package" - 'font-lock-face 'package-status-built-in)) - (insert (substitute-quotes "'"))) - (if signed - (insert ".") - (insert " (unsigned).")) - (when (and (package-desc-p desc) - (not required-by) - (member status '("unsigned" "installed"))) - (insert " ") - (package-make-button "Delete" - 'action #'package-delete-button-action - 'package-desc desc))) - (incompatible-reason - (insert (propertize "Incompatible" 'font-lock-face 'font-lock-warning-face) - " because it depends on ") - (if (stringp incompatible-reason) - (insert "Emacs " incompatible-reason ".") - (insert "uninstallable packages."))) - (installable - (insert (capitalize status)) - (insert " from " (format "%s" archive)) - (insert " -- ") - (package-make-button - "Install" - 'action 'package-install-button-action - 'package-desc desc)) - (t (insert (capitalize status) "."))) - (insert "\n") - (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive. - (package--print-help-section "Archive" - (or archive "n/a"))) - (and version - (package--print-help-section "Version" - (package-version-join version))) - (when commit - (package--print-help-section "Commit" commit)) - (when desc - (package--print-help-section "Summary" - (package-desc-summary desc))) - - (setq reqs (if desc (package-desc-reqs desc))) - (when reqs - (package--print-help-section "Requires") - (let ((first t)) - (dolist (req reqs) - (let* ((name (car req)) - (vers (cadr req)) - (text (format "%s-%s" (symbol-name name) - (package-version-join vers))) - (reason (if (and (listp incompatible-reason) - (assq name incompatible-reason)) - " (not available)" ""))) - (cond (first (setq first nil)) - ((>= (+ 2 (current-column) (length text) (length reason)) - (window-width)) - (insert ",\n ")) - (t (insert ", "))) - (help-insert-xref-button text 'help-package name) - (insert reason))) - (insert "\n"))) - (when required-by - (package--print-help-section "Required by") - (let ((first t)) - (dolist (pkg required-by) - (let ((text (package-desc-full-name pkg))) - (cond (first (setq first nil)) - ((>= (+ 2 (current-column) (length text)) - (window-width)) - (insert ",\n ")) - (t (insert ", "))) - (help-insert-xref-button text 'help-package - (package-desc-name pkg)))) - (insert "\n"))) - (when website - ;; Prefer https for the website of packages on common domains. - (when (string-match-p (rx bol "http://" (or "elpa." "www." "git." "") - (or "nongnu.org" "gnu.org" "sr.ht" - "emacswiki.org" "gitlab.com" "github.com") - "/") - website) - ;; But only if the user has "https" in `package-archives'. - (let ((gnu (cdr (assoc "gnu" package-archives)))) - (and gnu (string-match-p "^https" gnu) - (setq website - (replace-regexp-in-string "^http" "https" website))))) - (package--print-help-section "Website") - (help-insert-xref-button website 'help-url website) - (insert "\n")) - (when keywords - (package--print-help-section "Keywords") - (dolist (k keywords) - (package-make-button - k - 'package-keyword k - 'action 'package-keyword-button-action) - (insert " ")) - (insert "\n")) - (when maintainers - (unless (and (listp (car maintainers)) (listp (cdr maintainers))) - (setq maintainers (list maintainers))) - (package--print-help-section - (if (cdr maintainers) "Maintainers" "Maintainer")) - (dolist (maintainer maintainers) - (when (bolp) - (insert (make-string 13 ?\s))) - (package--print-email-button maintainer))) - (when authors - (package--print-help-section (if (cdr authors) "Authors" "Author")) - (dolist (author authors) - (when (bolp) - (insert (make-string 13 ?\s))) - (package--print-email-button author))) - (let* ((all-pkgs (append (cdr (assq name package-alist)) - (cdr (assq name package-archive-contents)) - (let ((bi (assq name package--builtins))) - (if bi (list (package--from-builtin bi)))))) - (other-pkgs (delete desc all-pkgs))) - (when other-pkgs - (package--print-help-section "Other versions" - (mapconcat (lambda (opkg) - (let* ((ov (package-desc-version opkg)) - (dir (package-desc-dir opkg)) - (from (or (package-desc-archive opkg) - (if (stringp dir) "installed" dir)))) - (if (not ov) (format "%s" from) - (format "%s (%s)" - (make-text-button (package-version-join ov) nil - 'font-lock-face 'link - 'follow-link t - 'action - (lambda (_button) - (describe-package opkg))) - from)))) - other-pkgs ", ") - "."))) - - (insert "\n") - - (let ((start-of-description (point))) - (if built-in - ;; For built-in packages, get the description from the - ;; Commentary header. - (insert (or (lm-commentary (locate-file (format "%s.el" name) - load-path - load-file-rep-suffixes)) - "")) - - (if (package-installed-p desc) - ;; For installed packages, get the description from the - ;; installed files. - (insert (package--get-description desc)) - - ;; For non-built-in, non-installed packages, get description from - ;; the archive. - (let* ((basename (format "%s-readme.txt" name)) - readme-string) - - (package--with-response-buffer (package-archive-base desc) - :file basename :noerror t - (save-excursion - (goto-char (point-max)) - (unless (bolp) - (insert ?\n))) - (cl-assert (not enable-multibyte-characters)) - (setq readme-string - ;; The readme.txt files are defined to contain utf-8 text. - (decode-coding-region (point-min) (point-max) 'utf-8 t)) - t) - (insert (or readme-string - "This package does not provide a description."))))) - - ;; Insert news if available. - (when news - (insert "\n" (make-separator-line) "\n" - (propertize "* News" 'face 'package-help-section-name) - "\n\n") - (insert-file-contents news)) - - ;; Make library descriptions into links. - (goto-char start-of-description) - (package--describe-add-library-links) - ;; Make URLs in the description into links. - (goto-char start-of-description) - (browse-url-add-buttons)))) - -(defun package-install-button-action (button) - "Run `package-install' on the package BUTTON points to. -Used for the `action' property of buttons in the buffer created by -`describe-package'." - (let ((pkg-desc (button-get button 'package-desc))) - (when (y-or-n-p (format-message "Install package `%s'? " - (package-desc-full-name pkg-desc))) - (package-install pkg-desc nil) - (describe-package (package-desc-name pkg-desc))))) - -(defun package-delete-button-action (button) - "Run `package-delete' on the package BUTTON points to. -Used for the `action' property of buttons in the buffer created by -`describe-package'." - (let ((pkg-desc (button-get button 'package-desc))) - (when (y-or-n-p (format-message "Delete package `%s'? " - (package-desc-full-name pkg-desc))) - (package-delete pkg-desc) - (describe-package (package-desc-name pkg-desc))))) - -(defun package-keyword-button-action (button) - "Show filtered \"*Packages*\" buffer for BUTTON. -The buffer is filtered by the `package-keyword' property of BUTTON. -Used for the `action' property of buttons in the buffer created by -`describe-package'." - (let ((pkg-keyword (button-get button 'package-keyword))) - (package-show-package-list t (list pkg-keyword)))) - -(defun package-make-button (text &rest properties) - "Insert button labeled TEXT with button PROPERTIES at point. -PROPERTIES are passed to `insert-text-button', for which this -function is a convenience wrapper used by `describe-package-1'." - (let ((button-text (if (display-graphic-p) text (concat "[" text "]"))) - (button-face (if (display-graphic-p) - (progn - (require 'cus-edit) ; for the custom-button face - 'custom-button) - 'link))) - (apply #'insert-text-button button-text 'face button-face 'follow-link t - properties))) - -(defun package--finder-goto-xref (button) - "Jump to a Lisp file for the BUTTON at point." - (let* ((file (button-get button 'xref)) - (lib (locate-library file))) - (if lib (finder-commentary lib) - (message "Unable to locate `%s'" file)))) - -(define-button-type 'package--finder-xref 'action #'package--finder-goto-xref) - -(defun package--print-email-button (recipient) - "Insert a button whose action will send an email to RECIPIENT. -NAME should have the form (FULLNAME . EMAIL) where FULLNAME is -either a full name or nil, and EMAIL is a valid email address." - (when (car recipient) - (insert (car recipient))) - (when (and (car recipient) (cdr recipient)) - (insert " ")) - (when (cdr recipient) - (insert "<") - (insert-text-button (cdr recipient) - 'follow-link t - 'action (lambda (_) - (compose-mail - (format "%s <%s>" (car recipient) (cdr recipient))))) - (insert ">")) - (insert "\n")) - - -;;;; Package menu mode. - -(defvar-keymap package-menu-mode-map - :doc "Local keymap for `package-menu-mode' buffers." - :parent tabulated-list-mode-map - "C-m" #'package-menu-describe-package - "u" #'package-menu-mark-unmark - "DEL" #'package-menu-backup-unmark - "d" #'package-menu-mark-delete - "i" #'package-menu-mark-install - "U" #'package-menu-mark-upgrades - "r" #'revert-buffer - "~" #'package-menu-mark-obsolete-for-deletion - "w" #'package-browse-url - "b" #'package-report-bug - "x" #'package-menu-execute - "h" #'package-menu-quick-help - "H" #'package-menu-hide-package - "?" #'package-menu-describe-package - "(" #'package-menu-toggle-hiding - "/ /" #'package-menu-clear-filter - "/ a" #'package-menu-filter-by-archive - "/ d" #'package-menu-filter-by-description - "/ k" #'package-menu-filter-by-keyword - "/ N" #'package-menu-filter-by-name-or-description - "/ n" #'package-menu-filter-by-name - "/ s" #'package-menu-filter-by-status - "/ v" #'package-menu-filter-by-version - "/ m" #'package-menu-filter-marked - "/ u" #'package-menu-filter-upgradable) - -(easy-menu-define package-menu-mode-menu package-menu-mode-map - "Menu for `package-menu-mode'." - '("Package" - ["Describe Package" package-menu-describe-package :help "Display information about this package"] - ["Open Package Website" package-browse-url - :help "Open the website of this package"] - ["Help" package-menu-quick-help :help "Show short key binding help for package-menu-mode"] - "--" - ["Refresh Package List" revert-buffer - :help "Redownload the package archive(s)" - :active (not package--downloads-in-progress)] - ["Execute Marked Actions" package-menu-execute :help "Perform all the marked actions"] - - "--" - ["Mark All Available Upgrades" package-menu-mark-upgrades - :help "Mark packages that have a newer version for upgrading" - :active (not package--downloads-in-progress)] - ["Mark All Obsolete for Deletion" package-menu-mark-obsolete-for-deletion :help "Mark all obsolete packages for deletion"] - ["Mark for Install" package-menu-mark-install :help "Mark a package for installation and move to the next line"] - ["Mark for Deletion" package-menu-mark-delete :help "Mark a package for deletion and move to the next line"] - ["Unmark" package-menu-mark-unmark :help "Clear any marks on a package and move to the next line"] - - "--" - ("Filter Packages" - ["Filter by Archive" package-menu-filter-by-archive - :help - "Prompt for archive(s), display only packages from those archives"] - ["Filter by Description" package-menu-filter-by-description - :help - "Prompt for regexp, display only packages with matching description"] - ["Filter by Keyword" package-menu-filter-by-keyword - :help - "Prompt for keyword(s), display only packages with matching keywords"] - ["Filter by Name" package-menu-filter-by-name - :help - "Prompt for regexp, display only packages whose names match the regexp"] - ["Filter by Name or Description" package-menu-filter-by-name-or-description - :help - "Prompt for regexp, display only packages whose name or description matches"] - ["Filter by Status" package-menu-filter-by-status - :help - "Prompt for status(es), display only packages with those statuses"] - ["Filter by Upgrades available" package-menu-filter-upgradable - :help "Display only installed packages for which upgrades are available"] - ["Filter by Version" package-menu-filter-by-version - :help - "Prompt for version and comparison operator, display only packages of matching versions"] - ["Filter Marked" package-menu-filter-marked - :help "Display only packages marked for installation or deletion"] - ["Clear Filter" package-menu-clear-filter - :help "Clear package list filtering, display the entire list again"]) - - ["Hide by Regexp" package-menu-hide-package - :help "Toggle visibility of obsolete and unwanted packages"] - ["Display Older Versions" package-menu-toggle-hiding - :style toggle :selected (not package-menu--hide-packages) - :help "Display package even if a newer version is already installed"] - - "--" - ["Quit" quit-window :help "Quit package selection"] - ["Customize" (customize-group 'package)])) - -(defvar package-menu--new-package-list nil - "List of newly-available packages since `list-packages' was last called.") - -(defvar package-menu--transaction-status nil - "Mode-line status of ongoing package transaction.") - -(defconst package-menu-mode-line-format - '((package-menu-mode-line-info - (:eval (symbol-value 'package-menu-mode-line-info))))) - -(defvar-local package-menu-mode-line-info nil - "Variable which stores package-menu mode-line format.") - -(defun package-menu--set-mode-line-format () - "Display package-menu mode-line." - (when-let* ((buf (get-buffer "*Packages*")) - ((buffer-live-p buf))) - (with-current-buffer buf - (setq package-menu-mode-line-info - (let ((installed 0) - (new 0) - (total (length package-archive-contents)) - (to-upgrade (length (package-menu--find-upgrades))) - (total-help "Total number of packages of all package archives") - (installed-help "Total number of packages installed") - (upgrade-help "Total number of packages to upgrade") - (new-help "Total number of packages added recently")) - - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((status (package-menu-get-status))) - (cond - ((member status - '("installed" "dependency" "unsigned")) - (setq installed (1+ installed))) - ((equal status "new") - (setq new (1+ new))))) - (forward-line))) - - (setq installed (number-to-string installed)) - (setq total (number-to-string total)) - (setq to-upgrade (number-to-string to-upgrade)) - - (list - " [" - (propertize "Total: " 'help-echo total-help) - (propertize total - 'help-echo total-help - 'face 'package-mode-line-total) - " / " - (propertize "Installed: " 'help-echo installed-help) - (propertize installed - 'help-echo installed-help - 'face 'package-mode-line-installed) - " / " - (propertize "To Upgrade: " 'help-echo upgrade-help) - (propertize to-upgrade - 'help-echo upgrade-help - 'face 'package-mode-line-to-upgrade) - (when (> new 0) - (concat - " / " - (propertize "New: " 'help-echo new-help) - (propertize (number-to-string new) - 'help-echo new-help - 'face 'package-mode-line-new))) - "] ")))))) -(defvar package-menu--tool-bar-map - (let ((map (make-sparse-keymap))) - (tool-bar-local-item-from-menu - #'package-menu-execute "package-menu/execute" - map package-menu-mode-map) - (define-key-after map [separator-1] menu-bar-separator) - (tool-bar-local-item-from-menu - #'package-menu-mark-unmark "package-menu/unmark" - map package-menu-mode-map) - (tool-bar-local-item-from-menu - #'package-menu-mark-install "package-menu/install" - map package-menu-mode-map) - (tool-bar-local-item-from-menu - #'package-menu-mark-delete "package-menu/delete" - map package-menu-mode-map) - (tool-bar-local-item-from-menu - #'package-menu-describe-package "package-menu/info" - map package-menu-mode-map) - (tool-bar-local-item-from-menu - #'package-browse-url "package-menu/url" - map package-menu-mode-map) - (tool-bar-local-item - "package-menu/upgrade" 'package-upgrade-all - 'package-upgrade-all - map :help "Upgrade all the packages") - (define-key-after map [separator-2] menu-bar-separator) - (tool-bar-local-item - "search" 'isearch-forward 'search map - :help "Search" :vert-only t) - (tool-bar-local-item-from-menu - #'revert-buffer "refresh" - map package-menu-mode-map) - (tool-bar-local-item-from-menu - #'quit-window "close" - map package-menu-mode-map) - map)) - -(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu" - "Major mode for browsing a list of packages. -The most useful commands here are: - - `x': Install the package under point if it isn't already installed, - and delete it if it's already installed, - `i': mark a package for installation, and - `d': mark a package for deletion. Use the `x' command to perform the - actions on the marked files. -\\ -\\{package-menu-mode-map}" - :interactive nil - (setq mode-line-process '((package--downloads-in-progress ":Loading") - (package-menu--transaction-status - package-menu--transaction-status))) - (setq-local mode-line-misc-info - (append - mode-line-misc-info - package-menu-mode-line-format)) - (setq-local tool-bar-map package-menu--tool-bar-map) - (setq tabulated-list-format - `[("Package" ,package-name-column-width package-menu--name-predicate) - ("Version" ,package-version-column-width package-menu--version-predicate) - ("Status" ,package-status-column-width package-menu--status-predicate) - ("Archive" ,package-archive-column-width package-menu--archive-predicate) - ("Description" 0 package-menu--description-predicate)]) - (setq tabulated-list-padding 2) - (setq tabulated-list-sort-key (cons "Status" nil)) - (add-hook 'tabulated-list-revert-hook #'package-menu--refresh nil t) - (tabulated-list-init-header) - (setq revert-buffer-function 'package-menu--refresh-contents) - (setf imenu-prev-index-position-function - #'package--imenu-prev-index-position-function) - (setf imenu-extract-index-name-function - #'package--imenu-extract-index-name-function)) - -(defmacro package--push (pkg-desc status listname) - "Convenience macro for `package-menu--generate'. -If the alist stored in the symbol LISTNAME lacks an entry for a -package PKG-DESC, add one. The alist is keyed with PKG-DESC." - (declare (obsolete nil "27.1")) - `(unless (assoc ,pkg-desc ,listname) - ;; FIXME: Should we move status into pkg-desc? - (push (cons ,pkg-desc ,status) ,listname))) - -(defvar package-list-unversioned nil - "If non-nil, include packages that don't have a version in `list-packages'.") - -(defvar package-list-unsigned nil - "If non-nil, mention in the list which packages were installed without signature.") - -(defvar package--emacs-version-list (version-to-list emacs-version) - "The value of variable `emacs-version' as a list.") - -(defun package--ensure-package-menu-mode () - "Signal a user-error if major mode is not `package-menu-mode'." - (unless (derived-mode-p 'package-menu-mode) - (user-error "The current buffer is not a Package Menu"))) - -(defun package--incompatible-p (pkg &optional shallow) - "Return non-nil if PKG has no chance of being installable. -PKG is a `package-desc' object. - -If SHALLOW is non-nil, this only checks if PKG depends on a -higher `emacs-version' than the one being used. Otherwise, also -checks the viability of dependencies, according to -`package--compatibility-table'. - -If PKG requires an incompatible Emacs version, the return value -is this version (as a string). -If PKG requires incompatible packages, the return value is a list -of these dependencies, similar to the list returned by -`package-desc-reqs'." - (let* ((reqs (package-desc-reqs pkg)) - (version (cadr (assq 'emacs reqs)))) - (if (and version (version-list-< package--emacs-version-list version)) - (package-version-join version) - (unless shallow - (let (out) - (dolist (dep (package-desc-reqs pkg) out) - (let ((dep-name (car dep))) - (unless (eq 'emacs dep-name) - (let ((cv (gethash dep-name package--compatibility-table))) - (when (version-list-< (or cv '(0)) (or (cadr dep) '(0))) - (push dep out))))))))))) - -(defun package-desc-status (pkg-desc) - "Return the status of `package-desc' object PKG-DESC." - (let* ((name (package-desc-name pkg-desc)) - (dir (package-desc-dir pkg-desc)) - (lle (assq name package-load-list)) - (held (cadr lle)) - (version (package-desc-version pkg-desc)) - (signed (or (not package-list-unsigned) - (package-desc-signed pkg-desc)))) - (cond - ((package-vc-p pkg-desc) "source") - ((eq dir 'builtin) "built-in") - ((and lle (null held)) "disabled") - ((stringp held) - (let ((hv (if (stringp held) (version-to-list held)))) - (cond - ((version-list-= version hv) "held") - ((version-list-< version hv) "obsolete") - (t "disabled")))) - (dir ;One of the installed packages. - (cond - ((not (file-exists-p dir)) "deleted") - ;; Not inside `package-user-dir'. - ((not (file-in-directory-p dir package-user-dir)) "external") - ((eq pkg-desc (cadr (assq name package-alist))) - (if (not signed) "unsigned" - (if (package--user-selected-p name) - "installed" "dependency"))) - (t "obsolete"))) - ((package--incompatible-p pkg-desc) "incompat") - (t - (let* ((ins (cadr (assq name package-alist))) - (ins-v (if ins (package-desc-version ins)))) - (cond - ;; Installed obsolete packages are handled in the `dir' - ;; clause above. Here we handle available obsolete, which - ;; are displayed depending on `package-menu--hide-packages'. - ((and ins (version-list-<= version ins-v)) "avail-obso") - (t - (if (memq name package-menu--new-package-list) - "new" "available")))))))) - -(defvar package-menu--hide-packages t - "Whether available obsolete packages should be hidden. -Can be toggled with \\ \\[package-menu-toggle-hiding]. -Installed obsolete packages are always displayed.") - -(defun package-menu-toggle-hiding () - "In Package Menu, toggle visibility of obsolete available packages. - -Also hide packages whose name matches a regexp in user option -`package-hidden-regexps' (a list). To add regexps to this list, -use `package-menu-hide-package'." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (setq package-menu--hide-packages - (not package-menu--hide-packages)) - (if package-menu--hide-packages - (message "Hiding obsolete or unwanted packages") - (message "Displaying all packages")) - (revert-buffer nil 'no-confirm)) - -(defun package--remove-hidden (pkg-list) - "Filter PKG-LIST according to `package-archive-priorities'. -PKG-LIST must be a list of `package-desc' objects, all with the -same name, sorted by decreasing `package-desc-priority-version'. -Return a list of packages tied for the highest priority according -to their archives." - (when pkg-list - ;; Variable toggled with `package-menu-toggle-hiding'. - (if (not package-menu--hide-packages) - pkg-list - (let ((installed (cadr (assq (package-desc-name (car pkg-list)) - package-alist)))) - (when installed - (setq pkg-list - (let ((ins-version (package-desc-version installed))) - (cl-remove-if (lambda (p) (version-list-< (package-desc-version p) - ins-version)) - pkg-list)))) - (let ((filtered-by-priority - (cond - ((not package-menu-hide-low-priority) - pkg-list) - ((eq package-menu-hide-low-priority 'archive) - (let (max-priority out) - (while pkg-list - (let ((p (pop pkg-list))) - (let ((priority (package-desc-priority p))) - (if (and max-priority (< priority max-priority)) - (setq pkg-list nil) - (push p out) - (setq max-priority priority))))) - (nreverse out))) - (pkg-list - (list (car pkg-list)))))) - (if (not installed) - filtered-by-priority - (let ((ins-version (package-desc-version installed))) - (cl-remove-if (lambda (p) (or (version-list-= (package-desc-version p) - ins-version) - (package-vc-p installed))) - filtered-by-priority)))))))) - -(defcustom package-hidden-regexps nil - "List of regexps matching the name of packages to hide. -If the name of a package matches any of these regexps it is -omitted from the package menu. To toggle this, type \\[package-menu-toggle-hiding]. - -Values can be interactively added to this list by typing -\\[package-menu-hide-package] on a package." - :version "25.1" - :type '(repeat (regexp :tag "Hide packages with name matching"))) - -(defcustom package-menu-use-current-if-no-marks t - "Whether \\\\[package-menu-execute] in package menu operates on current package if none are marked. - -If non-nil, and no packages are marked for installation or -deletion, \\\\[package-menu-execute] will operate on the current package at point, -see `package-menu-execute' for details. -The default is t. Set to nil to get back the original behavior -of having `package-menu-execute' signal an error when no packages -are marked for installation or deletion." - :version "29.1" - :type 'boolean) - -(defun package-menu--refresh (&optional packages keywords) - "Re-populate the `tabulated-list-entries'. -PACKAGES should be nil or t, which means to display all known packages. -KEYWORDS should be nil or a list of keywords." - ;; Construct list of (PKG-DESC . STATUS). - (unless packages (setq packages t)) - (let ((hidden-names (mapconcat #'identity package-hidden-regexps "\\|")) - info-list) - ;; Installed packages: - (dolist (elt package-alist) - (let ((name (car elt))) - (when (or (eq packages t) (memq name packages)) - (dolist (pkg (cdr elt)) - (when (package--has-keyword-p pkg keywords) - (push pkg info-list)))))) - - ;; Built-in packages: - (dolist (elt package--builtins) - (let ((pkg (package--from-builtin elt)) - (name (car elt))) - (when (not (eq name 'emacs)) ; Hide the `emacs' package. - (when (and (package--has-keyword-p pkg keywords) - (or package-list-unversioned - (package--bi-desc-version (cdr elt))) - (or (eq packages t) (memq name packages))) - (push pkg info-list))))) - - ;; Available and disabled packages: - (unless (equal package--old-archive-priorities package-archive-priorities) - (package-read-all-archive-contents)) - (dolist (elt package-archive-contents) - (let ((name (car elt))) - ;; To be displayed it must be in PACKAGES; - (when (and (or (eq packages t) (memq name packages)) - ;; and we must either not be hiding anything, - (or (not package-menu--hide-packages) - (not package-hidden-regexps) - ;; or just not hiding this specific package. - (not (string-match hidden-names (symbol-name name))))) - ;; Hide available-obsolete or low-priority packages. - (dolist (pkg (package--remove-hidden (cdr elt))) - (when (package--has-keyword-p pkg keywords) - (push pkg info-list)))))) - - ;; Print the result. - (tabulated-list-init-header) - (setq tabulated-list-entries - (mapcar #'package-menu--print-info-simple info-list)))) - -(defun package-all-keywords () - "Collect all package keywords." - (let ((key-list)) - (package--mapc (lambda (desc) - (setq key-list (append (package-desc--keywords desc) - key-list)))) - key-list)) - -(defun package--mapc (function &optional packages) - "Call FUNCTION for all known PACKAGES. -PACKAGES can be nil or t, which means to display all known -packages, or a list of packages. - -Built-in packages are converted with `package--from-builtin'." - (unless packages (setq packages t)) - (let (name) - ;; Installed packages: - (dolist (elt package-alist) - (setq name (car elt)) - (when (or (eq packages t) (memq name packages)) - (mapc function (cdr elt)))) - - ;; Built-in packages: - (dolist (elt package--builtins) - (setq name (car elt)) - (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. - (or package-list-unversioned - (package--bi-desc-version (cdr elt))) - (or (eq packages t) (memq name packages))) - (funcall function (package--from-builtin elt)))) - - ;; Available and disabled packages: - (dolist (elt package-archive-contents) - (setq name (car elt)) - (when (or (eq packages t) (memq name packages)) - (dolist (pkg (cdr elt)) - ;; Hide obsolete packages. - (unless (package-installed-p (package-desc-name pkg) - (package-desc-version pkg)) - (funcall function pkg))))))) - -(defun package--has-keyword-p (desc &optional keywords) - "Test if package DESC has any of the given KEYWORDS. -When none are given, the package matches." - (if keywords - (let ((desc-keywords (and desc (package-desc--keywords desc))) - found) - (while (and (not found) keywords) - (let ((k (pop keywords))) - (setq found - (or (string= k (concat "arc:" (package-desc-archive desc))) - (string= k (concat "status:" (package-desc-status desc))) - (member k desc-keywords))))) - found) - t)) - -(defun package-menu--display (remember-pos suffix) - "Display the Package Menu. -If REMEMBER-POS is non-nil, keep point on the same entry. - -If SUFFIX is non-nil, append that to \"Package\" for the first -column in the header line." - (setf (car (aref tabulated-list-format 0)) - (if suffix - (concat "Package[" suffix "]") - "Package")) - (tabulated-list-init-header) - (tabulated-list-print remember-pos)) - -(defun package-menu--generate (remember-pos &optional packages keywords) - "Populate and display the Package Menu. -If REMEMBER-POS is non-nil, keep point on the same entry. -PACKAGES should be t, which means to display all known packages, -or a list of package names (symbols) to display. - -With KEYWORDS given, only packages with those keywords are -shown." - (package-menu--refresh packages keywords) - (package-menu--display remember-pos - (when keywords - (let ((filters (mapconcat #'identity keywords ","))) - (concat "Package[" filters "]"))))) - -(defun package-menu--print-info (pkg) - "Return a package entry suitable for `tabulated-list-entries'. -PKG has the form (PKG-DESC . STATUS). -Return (PKG-DESC [NAME VERSION STATUS DOC])." - (package-menu--print-info-simple (car pkg))) -(make-obsolete 'package-menu--print-info - 'package-menu--print-info-simple "25.1") - - -;;; Package menu faces - -(defface package-name - '((t :inherit link)) - "Face used on package names in the package menu." - :version "25.1") - -(defface package-description - '((t :inherit default)) - "Face used on package description summaries in the package menu." - :version "25.1") - -;; Shame this hyphenates "built-in", when "font-lock-builtin-face" doesn't. -(defface package-status-built-in - '((t :inherit font-lock-builtin-face)) - "Face used on the status and version of built-in packages." - :version "25.1") - -(defface package-status-external - '((t :inherit package-status-built-in)) - "Face used on the status and version of external packages." - :version "25.1") - -(defface package-status-available - '((t :inherit default)) - "Face used on the status and version of available packages." - :version "25.1") - -(defface package-status-new - '((t :inherit (bold package-status-available))) - "Face used on the status and version of new packages." - :version "25.1") - -(defface package-status-held - '((t :inherit font-lock-constant-face)) - "Face used on the status and version of held packages." - :version "25.1") - -(defface package-status-disabled - '((t :inherit font-lock-warning-face)) - "Face used on the status and version of disabled packages." - :version "25.1") - -(defface package-status-installed - '((t :inherit font-lock-comment-face)) - "Face used on the status and version of installed packages." - :version "25.1") - -(defface package-status-from-source - '((t :inherit font-lock-negation-char-face)) - "Face used on the status and version of installed packages." - :version "29.1") - -(defface package-status-dependency - '((t :inherit package-status-installed)) - "Face used on the status and version of dependency packages." - :version "25.1") - -(defface package-status-unsigned - '((t :inherit font-lock-warning-face)) - "Face used on the status and version of unsigned packages." - :version "25.1") - -(defface package-status-incompat - '((t :inherit error)) - "Face used on the status and version of incompat packages." - :version "25.1") - -(defface package-status-avail-obso - '((t :inherit package-status-incompat)) - "Face used on the status and version of avail-obso packages." - :version "25.1") - -(defface package-mark-install-line - '((((class color) (background light)) - :background "darkolivegreen1" :extend t) - (((class color) (background dark)) - :background "seagreen" :extend t) - (t :inherit (highlight) :extend t)) - "Face used for highlighting in package-menu packages marked to be installed." - :version "31.1") - -(defface package-mark-delete-line - '((((class color) (background light)) - :background "rosybrown1" :extend t) - (((class color) (background dark)) - :background "indianred4" :extend t) - (t :inherit (highlight) :extend t)) - "Face used for highlighting in package-menu packages marked to be deleted." - :version "31.1") - -(defface package-mode-line-total nil - "Face for the total number of packages displayed on the mode line." - :version "31.1") - -(defface package-mode-line-installed '((t :inherit package-status-installed)) - "Face for the number of installed packages displayed on the mode line." - :version "31.1") - -(defface package-mode-line-to-upgrade '((t :inherit bold)) - "Face for the number of packages to upgrade displayed on the mode line." - :version "31.1") - -(defface package-mode-line-new '((t :inherit package-status-new)) - "Face for the number of new packages displayed on the mode line." - :version "31.1") - - -;;; Package menu printing - -(defun package-menu--print-info-simple (pkg) - "Return a package entry suitable for `tabulated-list-entries'. -PKG is a `package-desc' object. -Return (PKG-DESC [NAME VERSION STATUS DOC])." - (let* ((status (package-desc-status pkg)) - (face (pcase status - ("built-in" 'package-status-built-in) - ("external" 'package-status-external) - ("available" 'package-status-available) - ("avail-obso" 'package-status-avail-obso) - ("new" 'package-status-new) - ("held" 'package-status-held) - ("disabled" 'package-status-disabled) - ("installed" 'package-status-installed) - ("source" 'package-status-from-source) - ("dependency" 'package-status-dependency) - ("unsigned" 'package-status-unsigned) - ("incompat" 'package-status-incompat) - (_ 'font-lock-warning-face)))) ; obsolete. - (list pkg - `[(,(symbol-name (package-desc-name pkg)) - face package-name - font-lock-face package-name - follow-link t - package-desc ,pkg - action package-menu-describe-package) - ,(propertize - (if (package-vc-p pkg) - (progn - (require 'package-vc) - (package-vc-commit pkg)) - (package-version-join - (package-desc-version pkg))) - 'font-lock-face face) - ,(propertize status 'font-lock-face face) - ,(propertize (or (package-desc-archive pkg) "") - 'font-lock-face face) - ,(propertize (package-desc-summary pkg) - 'font-lock-face 'package-description)]))) - -(defvar package-menu--old-archive-contents nil - "`package-archive-contents' before the latest refresh.") - -(defun package-menu--refresh-contents (&optional _arg _noconfirm) - "In Package Menu, download the Emacs Lisp package archive. -Fetch the contents of each archive specified in -`package-archives', and then refresh the package menu. - -`package-menu-mode' sets `revert-buffer-function' to this -function. The args ARG and NOCONFIRM, passed from -`revert-buffer', are ignored." - (package--ensure-package-menu-mode) - (setq package-menu--old-archive-contents package-archive-contents) - (setq package-menu--new-package-list nil) - (package-refresh-contents package-menu-async)) -(define-obsolete-function-alias 'package-menu-refresh 'revert-buffer "27.1") - -(defun package-menu--overlay-line (face) - "Highlight whole line with face FACE." - (let ((ov (make-overlay (line-beginning-position) - (1+ (line-end-position))))) - (overlay-put ov 'pkg-menu-ov t) - (overlay-put ov 'evaporate t) - (overlay-put ov 'face face))) - -(defun package-menu--remove-overlay () - "Remove all overlays done by `package-menu--overlay-line' in current line." - (remove-overlays (line-beginning-position) - (1+ (line-end-position)) - 'pkg-menu-ov t)) - -(defun package-menu-hide-package () - "Hide in Package Menu packages that match a regexp. -Prompt for the regexp to match against package names. -The default regexp will hide only the package whose name is at point. - -The regexp is added to the list in the user option -`package-hidden-regexps' and saved for future sessions. - -To unhide a package, type -`\\[customize-variable] RET package-hidden-regexps', and then modify -the regexp such that it no longer matches the package's name. - -Type \\[package-menu-toggle-hiding] to toggle package hiding." - (declare (interactive-only "change `package-hidden-regexps' instead.")) - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (let* ((name (when (derived-mode-p 'package-menu-mode) - (concat "\\`" (regexp-quote (symbol-name (package-desc-name - (tabulated-list-get-id)))) - "\\'"))) - (re (read-string "Hide packages matching regexp: " name))) - ;; Test if it is valid. - (string-match re "") - (push re package-hidden-regexps) - (customize-save-variable 'package-hidden-regexps package-hidden-regexps) - (package-menu--post-refresh) - (let ((hidden - (cl-remove-if-not (lambda (e) (string-match re (symbol-name (car e)))) - package-archive-contents))) - (message "Packages to hide: %d. Type `%s' to toggle or `%s' to customize" - (length hidden) - (substitute-command-keys "\\[package-menu-toggle-hiding]") - (substitute-command-keys "\\[customize-variable] RET package-hidden-regexps"))))) - - -(defun package-menu-describe-package (&optional button) - "Describe the current package. -The current package is the package at point. -If optional arg BUTTON is non-nil, describe its associated -package(s); this is always nil in interactive invocations." - (interactive nil package-menu-mode) - (let ((pkg-desc (if button (button-get button 'package-desc) - (tabulated-list-get-id)))) - (if pkg-desc - (describe-package pkg-desc) - (user-error "No package here")))) - -;; fixme numeric argument -(defun package-menu-mark-delete (&optional _num) - "Mark the current package for deletion and move to the next line. -The current package is the package at point." - (interactive "p" package-menu-mode) - (package--ensure-package-menu-mode) - (if (member (package-menu-get-status) - '("installed" "source" "dependency" "obsolete" "unsigned")) - (progn (package-menu--overlay-line 'package-mark-delete-line) - (tabulated-list-put-tag "D" t)) - (forward-line))) - -(defun package-menu-mark-install (&optional _num) - "Mark the current package for installation and move to the next line. -The current package is the package at point." - (interactive "p" package-menu-mode) - (package--ensure-package-menu-mode) - (if (member (package-menu-get-status) '("available" "avail-obso" "new" "dependency")) - (progn (package-menu--overlay-line 'package-mark-install-line) - (tabulated-list-put-tag "I" t)) - (forward-line))) - -(defun package-menu-mark-unmark (&optional _num) - "Clear any marks on the current package and move to the next line. -The current package is the package at point." - (interactive "p" package-menu-mode) - (package--ensure-package-menu-mode) - (package-menu--remove-overlay) - (tabulated-list-put-tag " " t)) - -(defun package-menu-backup-unmark () - "Back up one line and clear any marks on that line's package." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (forward-line -1) - (package-menu--remove-overlay) - (tabulated-list-put-tag " ")) - -(defun package-menu-mark-obsolete-for-deletion () - "Mark all obsolete packages for deletion." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (equal (package-menu-get-status) "obsolete") - (progn (package-menu--overlay-line 'package-mark-delete-line) - (tabulated-list-put-tag "D" t)) - (forward-line 1))))) - -(defvar package--quick-help-keys - '((("mark for installation," . 9) - ("mark for deletion," . 9) "unmark," ("execute marked actions" . 1)) - ("next," "previous") - ("Hide-package," "(-toggle-hidden") - ("g-refresh-contents," "/-filter," "help"))) - -(defun package--prettify-quick-help-key (desc) - "Prettify DESC to be displayed as a help menu." - (if (listp desc) - (if (listp (cdr desc)) - (mapconcat #'package--prettify-quick-help-key desc " ") - (let ((place (cdr desc)) - (out (copy-sequence (car desc)))) - (add-text-properties place (1+ place) - '(face help-key-binding) - out) - out)) - (package--prettify-quick-help-key (cons desc 0)))) - -(defun package-menu-quick-help () - "Show short help for key bindings in `package-menu-mode'. -You can view the full list of keys with \\[describe-mode]." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (message (mapconcat #'package--prettify-quick-help-key - package--quick-help-keys "\n"))) - -(defun package-menu-get-status () - "Return status description of package at point in Package Menu." - (package--ensure-package-menu-mode) - (let* ((id (tabulated-list-get-id)) - (entry (and id (assoc id tabulated-list-entries)))) - (if entry - (aref (cadr entry) 2) - ""))) - -(defun package-archive-priority (archive) - "Return the priority of ARCHIVE. - -The archive priorities are specified in -`package-archive-priorities'. If not given there, the priority -defaults to 0." - (or (cdr (assoc archive package-archive-priorities)) - 0)) - -(defun package-desc-priority-version (pkg-desc) - "Return the version PKG-DESC with the archive priority prepended. - -This allows for easy comparison of package versions from -different archives if archive priorities are meant to be taken in -consideration." - (cons (package-desc-priority pkg-desc) - (package-desc-version pkg-desc))) - -(defun package-menu--find-upgrades () - "In Package Menu, return an alist of packages that can be upgraded. -The alist has the same form as `package-alist', namely a list -of elements of the form (PKG . DESCS), but where DESCS is the `package-desc' -object corresponding to the newer version." - (let (installed available upgrades) - ;; Build list of installed/available packages in this buffer. - (dolist (entry tabulated-list-entries) - ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) - (let ((pkg-desc (car entry)) - (status (aref (cadr entry) 2))) - (cond ((member status '("installed" "dependency" "unsigned" "external" "built-in")) - (push pkg-desc installed)) - ((member status '("available" "new")) - (setq available (package--append-to-alist pkg-desc available)))))) - ;; Loop through list of installed packages, finding upgrades. - (dolist (pkg-desc installed) - (let* ((name (package-desc-name pkg-desc)) - (avail-pkg (cadr (assq name available)))) - (and avail-pkg - (version-list-< (package-desc-priority-version pkg-desc) - (package-desc-priority-version avail-pkg)) - (or (not (package--active-built-in-p pkg-desc)) - package-install-upgrade-built-in) - (push (cons name avail-pkg) upgrades)))) - upgrades)) - -(defvar package-menu--mark-upgrades-pending nil - "Whether mark-upgrades is waiting for a refresh to finish.") - -(defun package-menu--mark-upgrades-1 () - "Mark all upgradable packages in the Package Menu. -Implementation of `package-menu-mark-upgrades'." - (setq package-menu--mark-upgrades-pending nil) - (let ((upgrades (package-menu--find-upgrades))) - (if (null upgrades) - (message "No packages to upgrade") - (widen) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let* ((pkg-desc (tabulated-list-get-id)) - (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades)))) - (cond ((null upgrade) - (forward-line 1)) - ((equal pkg-desc upgrade) - (package-menu-mark-install)) - (t - (package-menu-mark-delete)))))) - (message "Packages marked for upgrading: %d" - (length upgrades))))) - - -(defun package-menu-mark-upgrades () - "Mark all upgradable packages in the Package Menu. -For each installed package for which a newer version is available, -place an (I)nstall flag on the available version and a (D)elete flag -on the installed version. A subsequent \\[package-menu-execute] command will upgrade -the marked packages. - -If there's an async refresh operation in progress, the flags will -be placed as part of `package-menu--post-refresh' instead of -immediately." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (if (not package--downloads-in-progress) - (package-menu--mark-upgrades-1) - (setq package-menu--mark-upgrades-pending t) - (message "Waiting for refresh to finish..."))) - -(defun package-menu--list-to-prompt (packages &optional include-dependencies) - "Return a string listing PACKAGES that's usable in a prompt. -PACKAGES is a list of `package-desc' objects. -Formats the returned string to be usable in a minibuffer -prompt (see `package-menu--prompt-transaction-p'). - -If INCLUDE-DEPENDENCIES, also include the number of uninstalled -dependencies." - ;; The case where `package' is empty is handled in - ;; `package-menu--prompt-transaction-p' below. - (format "%d (%s)%s" - (length packages) - (mapconcat #'package-desc-full-name packages " ") - (let ((deps - (seq-remove - #'package-installed-p - (delete-dups - (apply - #'nconc - (mapcar (lambda (package) - (package--dependencies - (package-desc-name package))) - packages)))))) - (if (and include-dependencies deps) - (if (length= deps 1) - (format " plus 1 dependency") - (format " plus %d dependencies" (length deps))) - "")))) - -(defun package-menu--prompt-transaction-p (delete install upgrade) - "Prompt the user about DELETE, INSTALL, and UPGRADE. -DELETE, INSTALL, and UPGRADE are lists of `package-desc' objects. -Either may be nil, but not all." - (y-or-n-p - (concat - (when delete - (format "Packages to delete: %s. " - (package-menu--list-to-prompt delete))) - (when install - (format "Packages to install: %s. " - (package-menu--list-to-prompt install t))) - (when upgrade - (format "Packages to upgrade: %s. " - (package-menu--list-to-prompt upgrade))) - "Proceed? "))) - - -(defun package-menu--partition-transaction (install delete) - "Return an alist describing an INSTALL DELETE transaction. -Alist contains three entries, upgrade, delete, and install, each -with a list of package names. - -The upgrade entry contains any `package-desc' objects in INSTALL -whose name coincides with an object in DELETE. The delete and -the install entries are the same as DELETE and INSTALL with such -objects removed." - (let* ((upg (cl-intersection install delete :key #'package-desc-name)) - (ins (cl-set-difference install upg :key #'package-desc-name)) - (del (cl-set-difference delete upg :key #'package-desc-name))) - `((delete . ,del) (install . ,ins) (upgrade . ,upg)))) - -(defun package-menu--perform-transaction (install-list delete-list) - "Install packages in INSTALL-LIST and delete DELETE-LIST. -Return nil if there were no errors; non-nil otherwise." - (let ((errors nil)) - (if install-list - (let ((status-format (format ":Installing %%d/%d" - (length install-list))) - (i 0) - (package-menu--transaction-status)) - (dolist (pkg install-list) - (setq package-menu--transaction-status - (format status-format (incf i))) - (force-mode-line-update) - (redisplay 'force) - ;; Don't mark as selected, `package-menu-execute' already - ;; does that. - (package-install pkg 'dont-select)))) - (let ((package-menu--transaction-status ":Deleting")) - (force-mode-line-update) - (redisplay 'force) - (dolist (elt (package--sort-by-dependence delete-list)) - (condition-case-unless-debug err - (let ((inhibit-message (or inhibit-message package-menu-async))) - (package-delete elt nil 'nosave)) - (error - (push (package-desc-full-name elt) errors) - (message "Error trying to delete `%s': %s" - (package-desc-full-name elt) - (error-message-string err)))))) - errors)) - -(defun package--update-selected-packages (add remove) - "Update the `package-selected-packages' list according to ADD and REMOVE. -ADD and REMOVE must be disjoint lists of package names (or -`package-desc' objects) to be added and removed to the selected -packages list, respectively." - (dolist (p add) - (cl-pushnew (if (package-desc-p p) (package-desc-name p) p) - package-selected-packages)) - (dolist (p remove) - (setq package-selected-packages - (remove (if (package-desc-p p) (package-desc-name p) p) - package-selected-packages))) - (when (or add remove) - (package--save-selected-packages package-selected-packages))) - -(defun package-menu-execute (&optional noquery) - "Perform Package Menu actions on marked packages. -Packages marked for installation are downloaded and installed, -packages marked for deletion are removed, and packages marked for -upgrading are downloaded and upgraded. - -If no packages are marked, the action taken depends on the state -of the current package, the one at point. If it's not already -installed, this command will install the package; if it's installed, -the command will delete the package. - -Optional argument NOQUERY non-nil means do not ask the user to -confirm the installations/deletions; this is always nil in interactive -invocations." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (let (install-list delete-list cmd pkg-desc) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (setq cmd (char-after)) - (unless (eq cmd ?\s) - ;; This is the key PKG-DESC. - (setq pkg-desc (tabulated-list-get-id)) - (cond ((eq cmd ?D) - (push pkg-desc delete-list)) - ((eq cmd ?I) - (push pkg-desc install-list)))) - (forward-line))) - ;; Nothing marked. - (unless (or delete-list install-list) - ;; Not on a package line. - (unless (and (tabulated-list-get-id) - package-menu-use-current-if-no-marks) - (user-error "No operations specified")) - (let* ((id (tabulated-list-get-id)) - (status (package-menu-get-status))) - (cond - ((member status '("installed")) - (push id delete-list)) - ((member status '("available" "avail-obso" "new" "dependency")) - (push id install-list)) - (t (user-error "No default action available for status: %s" - status))))) - (let-alist (package-menu--partition-transaction install-list delete-list) - (when (or noquery - (package-menu--prompt-transaction-p .delete .install .upgrade)) - (let ((message-template - (concat "[ " - (when .delete - (format "Delete %d " (length .delete))) - (when .install - (format "Install %d " (length .install))) - (when .upgrade - (format "Upgrade %d " (length .upgrade))) - "]"))) - (message "Operation %s started" message-template) - ;; Packages being upgraded are not marked as selected. - (package--update-selected-packages .install .delete) - (unless (package-menu--perform-transaction install-list delete-list) - ;; If there weren't errors, output data. - (if-let* ((removable (package--removable-packages))) - (message "Operation finished. Packages that are no longer needed: %d. Type `%s' to remove them" - (length removable) - (substitute-command-keys "\\[package-autoremove]")) - (message "Operation %s finished" message-template)))))))) - -(defun package-menu--version-predicate (A B) - "Predicate to sort \"*Packages*\" buffer by the version column. -This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((vA (or (ignore-error error (version-to-list (aref (cadr A) 1))) '(0))) - (vB (or (ignore-error error (version-to-list (aref (cadr B) 1))) '(0)))) - (if (version-list-= vA vB) - (package-menu--name-predicate A B) - (version-list-< vA vB)))) - -(defun package-menu--status-predicate (A B) - "Predicate to sort \"*Packages*\" buffer by the status column. -This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((sA (aref (cadr A) 2)) - (sB (aref (cadr B) 2))) - (cond ((string= sA sB) - (package-menu--name-predicate A B)) - ((string= sA "new") t) - ((string= sB "new") nil) - ((string-prefix-p "avail" sA) - (if (string-prefix-p "avail" sB) - (package-menu--name-predicate A B) - t)) - ((string-prefix-p "avail" sB) nil) - ((string= sA "installed") t) - ((string= sB "installed") nil) - ((string= sA "dependency") t) - ((string= sB "dependency") nil) - ((string= sA "source") t) - ((string= sB "source") nil) - ((string= sA "unsigned") t) - ((string= sB "unsigned") nil) - ((string= sA "held") t) - ((string= sB "held") nil) - ((string= sA "external") t) - ((string= sB "external") nil) - ((string= sA "built-in") t) - ((string= sB "built-in") nil) - ((string= sA "obsolete") t) - ((string= sB "obsolete") nil) - ((string= sA "incompat") t) - ((string= sB "incompat") nil) - (t (string< sA sB))))) - -(defun package-menu--description-predicate (A B) - "Predicate to sort \"*Packages*\" buffer by the description column. -This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((dA (aref (cadr A) (if (cdr package-archives) 4 3))) - (dB (aref (cadr B) (if (cdr package-archives) 4 3)))) - (if (string= dA dB) - (package-menu--name-predicate A B) - (string< dA dB)))) - -(defun package-menu--name-predicate (A B) - "Predicate to sort \"*Packages*\" buffer by the name column. -This is used for `tabulated-list-format' in `package-menu-mode'." - (string< (symbol-name (package-desc-name (car A))) - (symbol-name (package-desc-name (car B))))) - -(defun package-menu--archive-predicate (A B) - "Predicate to sort \"*Packages*\" buffer by the archive column. -This is used for `tabulated-list-format' in `package-menu-mode'." - (let ((a (or (package-desc-archive (car A)) "")) - (b (or (package-desc-archive (car B)) ""))) - (if (string= a b) - (package-menu--name-predicate A B) - (string< a b)))) - -(defun package-menu--populate-new-package-list () - "Decide which packages are new in `package-archive-contents'. -Store this list in `package-menu--new-package-list'." - ;; Find which packages are new. - (when package-menu--old-archive-contents - (dolist (elt package-archive-contents) - (unless (assq (car elt) package-menu--old-archive-contents) - (push (car elt) package-menu--new-package-list))) - (setq package-menu--old-archive-contents nil))) - -(defun package-menu--find-and-notify-upgrades () - "Notify the user of upgradable packages." - (when-let* ((upgrades (package-menu--find-upgrades))) - (message "Packages that can be upgraded: %d; type `%s' to mark for upgrading." - (length upgrades) - (substitute-command-keys "\\[package-menu-mark-upgrades]")))) - - -(defun package-menu--post-refresh () - "Revert \"*Packages*\" buffer and check for new packages and upgrades. -Do nothing if there's no *Packages* buffer. - -This function is called after `package-refresh-contents' and it -is added to `post-command-hook' by any function which alters the -package database (`package-install' and `package-delete'). When -run, it removes itself from `post-command-hook'." - (remove-hook 'post-command-hook #'package-menu--post-refresh) - (let ((buf (get-buffer "*Packages*"))) - (when (buffer-live-p buf) - (with-current-buffer buf - (package-menu--populate-new-package-list) - (run-hooks 'tabulated-list-revert-hook) - (tabulated-list-print 'remember 'update))))) - -(defun package-menu--mark-or-notify-upgrades () - "If there's a *Packages* buffer, check for upgrades and possibly mark them. -Do nothing if there's no *Packages* buffer. If there are -upgrades, mark them if `package-menu--mark-upgrades-pending' is -non-nil, otherwise just notify the user that there are upgrades. -This function is called after `package-refresh-contents'." - (let ((buf (get-buffer "*Packages*"))) - (when (buffer-live-p buf) - (with-current-buffer buf - (if package-menu--mark-upgrades-pending - (package-menu--mark-upgrades-1) - (package-menu--find-and-notify-upgrades)))))) - -;;;###autoload -(defun list-packages (&optional no-fetch) - "Display a list of packages. -This first fetches the updated list of packages before -displaying, unless a prefix argument NO-FETCH is specified. -The list is displayed in a buffer named `*Packages*', and -includes the package's version, availability status, and a -short description." - (interactive "P") - (require 'finder-inf nil t) - ;; Initialize the package system if necessary. - (unless package--initialized - (package-initialize t)) - ;; Integrate the package-menu with updating the archives. - (add-hook 'package--post-download-archives-hook - #'package-menu--post-refresh) - (add-hook 'package--post-download-archives-hook - #'package-menu--mark-or-notify-upgrades 'append) - (add-hook 'package--post-download-archives-hook - #'package-menu--set-mode-line-format 'append) - - ;; Generate the Package Menu. - (let ((buf (get-buffer-create "*Packages*"))) - (with-current-buffer buf - ;; Since some packages have their descriptions include non-ASCII - ;; characters... - (setq buffer-file-coding-system 'utf-8) - (package-menu-mode) - - ;; Fetch the remote list of packages. - (unless no-fetch (package-menu--refresh-contents)) - - ;; If we're not async, this would be redundant. - (when package-menu-async - (package-menu--generate nil t))) - ;; The package menu buffer has keybindings. If the user types - ;; `M-x list-packages', that suggests it should become current. - (pop-to-buffer-same-window buf))) - -;;;###autoload -(defalias 'package-list-packages 'list-packages) - -;; Used in finder.el -(defun package-show-package-list (&optional packages keywords) - "Display PACKAGES in a *Packages* buffer. -This is similar to `list-packages', but it does not fetch the -updated list of packages, and it only displays packages with -names in PACKAGES (which should be a list of symbols). - -When KEYWORDS are given, only packages with those KEYWORDS are -shown." - (interactive) - (require 'finder-inf nil t) - (let* ((buf (get-buffer-create "*Packages*")) - (win (get-buffer-window buf))) - (with-current-buffer buf - (package-menu-mode) - (package-menu--generate nil packages keywords)) - (if win - (select-window win) - (switch-to-buffer buf)))) - -(defun package-menu--filter-by (predicate suffix) - "Filter \"*Packages*\" buffer by PREDICATE and add SUFFIX to header. -PREDICATE is a function which will be called with one argument, a -`package-desc' object, and returns t if that object should be -listed in the Package Menu. - -SUFFIX is passed on to `package-menu--display' and is added to -the header line of the first column." - ;; Update `tabulated-list-entries' so that it contains all - ;; packages before searching. - (package-menu--refresh t nil) - (let (found-entries) - (dolist (entry tabulated-list-entries) - (when (funcall predicate (car entry)) - (push entry found-entries))) - (if found-entries - (progn - (setq tabulated-list-entries found-entries) - (package-menu--display t suffix)) - (user-error "No packages found")))) - -(defun package-menu-filter-by-archive (archive) - "Filter the \"*Packages*\" buffer by ARCHIVE. -Display only packages from package archive ARCHIVE. -ARCHIVE can be the name of a single archive (a string), or -a list of archive names. If ARCHIVE is nil or an empty -string, show all packages. - -When called interactively, prompt for ARCHIVE. To specify -several archives, type their names separated by commas." - (interactive (list (completing-read-multiple - "Filter by archive: " - (mapcar #'car package-archives))) - package-menu-mode) - (package--ensure-package-menu-mode) - (let ((archives (ensure-list archive))) - (package-menu--filter-by - (lambda (pkg-desc) - (let ((pkg-archive (package-desc-archive pkg-desc))) - (or (null archives) - (and pkg-archive - (member pkg-archive archives))))) - (concat "archive:" (string-join archives ","))))) - -(defun package-menu-filter-by-description (description) - "Filter the \"*Packages*\" buffer by the regexp DESCRIPTION. -Display only packages whose description matches the regexp -given as DESCRIPTION. - -When called interactively, prompt for DESCRIPTION. - -If DESCRIPTION is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by description (regexp)")) - package-menu-mode) - (package--ensure-package-menu-mode) - (if (or (not description) (string-empty-p description)) - (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (string-match description - (package-desc-summary pkg-desc))) - (format "desc:%s" description)))) - -(defun package-menu-filter-by-keyword (keyword) - "Filter the \"*Packages*\" buffer by KEYWORD. -Display only packages whose keywords match the specified KEYWORD. -KEYWORD can be a string or a list of strings. If KEYWORD is nil -or the empty string, show all packages. - -In addition to package keywords, KEYWORD can include the name(s) -of archive(s) and the package status, such as \"available\" -or \"built-in\" or \"obsolete\". - -When called interactively, prompt for KEYWORD. To specify several -keywords, type them separated by commas." - (interactive (list (completing-read-multiple - "Keywords: " - (package-all-keywords))) - package-menu-mode) - (package--ensure-package-menu-mode) - (when (stringp keyword) - (setq keyword (list keyword))) - (if (not keyword) - (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (package--has-keyword-p pkg-desc keyword)) - (concat "keyword:" (string-join keyword ","))))) - -(define-obsolete-function-alias - 'package-menu-filter #'package-menu-filter-by-keyword "27.1") - -(defun package-menu-filter-by-name-or-description (name-or-description) - "Filter the \"*Packages*\" buffer by the regexp NAME-OR-DESCRIPTION. -Display only packages whose name or description matches the regexp -NAME-OR-DESCRIPTION. - -When called interactively, prompt for NAME-OR-DESCRIPTION. - -If NAME-OR-DESCRIPTION is nil or the empty string, show all -packages." - (interactive (list (read-regexp "Filter by name or description (regexp)")) - package-menu-mode) - (package--ensure-package-menu-mode) - (if (or (not name-or-description) (string-empty-p name-or-description)) - (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (or (string-match name-or-description - (package-desc-summary pkg-desc)) - (string-match name-or-description - (symbol-name - (package-desc-name pkg-desc))))) - (format "name-or-desc:%s" name-or-description)))) - -(defun package-menu-filter-by-name (name) - "Filter the \"*Packages*\" buffer by the regexp NAME. -Display only packages whose name matches the regexp NAME. - -When called interactively, prompt for NAME. - -If NAME is nil or the empty string, show all packages." - (interactive (list (read-regexp "Filter by name (regexp)")) - package-menu-mode) - (package--ensure-package-menu-mode) - (if (or (not name) (string-empty-p name)) - (package-menu--generate t t) - (package-menu--filter-by (lambda (pkg-desc) - (string-match-p name (symbol-name - (package-desc-name pkg-desc)))) - (format "name:%s" name)))) - -(defun package-menu-filter-by-status (status) - "Filter the \"*Packages*\" buffer by STATUS. -Display only packages with specified STATUS. -STATUS can be a single status, a string, or a list of strings. -If STATUS is nil or the empty string, show all packages. - -When called interactively, prompt for STATUS. To specify -several possible status values, type them separated by commas." - (interactive (list (completing-read "Filter by status: " - '("avail-obso" - "available" - "built-in" - "dependency" - "disabled" - "external" - "held" - "incompat" - "installed" - "source" - "new" - "unsigned"))) - package-menu-mode) - (package--ensure-package-menu-mode) - (if (or (not status) (string-empty-p status)) - (package-menu--generate t t) - (let ((status-list - (if (listp status) - status - (split-string status ",")))) - (package-menu--filter-by - (lambda (pkg-desc) - (member (package-desc-status pkg-desc) status-list)) - (format "status:%s" (string-join status-list ",")))))) - -(defun package-menu-filter-by-version (version predicate) - "Filter the \"*Packages*\" buffer by VERSION and PREDICATE. -Display only packages whose version satisfies the condition -defined by VERSION and PREDICATE. - -When called interactively, prompt for one of the comparison operators -`<', `>' or `=', and for a version. Show only packages whose version -is lower (`<'), equal (`=') or higher (`>') than the specified VERSION. - -When called from Lisp, VERSION should be a version string and -PREDICATE should be the symbol `=', `<' or `>'. - -If VERSION is nil or the empty string, show all packages." - (interactive (let ((choice (intern - (char-to-string - (read-char-choice - "Filter by version? [Type =, <, > or q] " - '(?< ?> ?= ?q)))))) - (if (eq choice 'q) - '(quit nil) - (list (read-from-minibuffer - (concat "Filter by version (" - (pcase choice - ('= "= equal to") - ('< "< less than") - ('> "> greater than")) - "): ")) - choice))) - package-menu-mode) - (package--ensure-package-menu-mode) - (unless (equal predicate 'quit) - (if (or (not version) (string-empty-p version)) - (package-menu--generate t t) - (package-menu--filter-by - (let ((fun (pcase predicate - ('= #'version-list-=) - ('< #'version-list-<) - ('> (lambda (a b) (not (version-list-<= a b)))) - (_ (error "Unknown predicate: %s" predicate)))) - (ver (version-to-list version))) - (lambda (pkg-desc) - (funcall fun (package-desc-version pkg-desc) ver))) - (format "versions:%s%s" predicate version))))) - -(defun package-menu-filter-marked () - "Filter \"*Packages*\" buffer by non-empty mark. -Show only the packages that have been marked for installation or deletion. -Unlike other filters, this leaves the marks intact." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (widen) - (let (found-entries mark pkg-id entry marks) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (setq mark (char-after)) - (unless (eq mark ?\s) - (setq pkg-id (tabulated-list-get-id)) - (setq entry (package-menu--print-info-simple pkg-id)) - (push entry found-entries) - ;; remember the mark - (push (cons pkg-id mark) marks)) - (forward-line)) - (if found-entries - (progn - (setq tabulated-list-entries found-entries) - (package-menu--display t nil) - ;; redo the marks, but we must remember the marks!! - (goto-char (point-min)) - (while (not (eobp)) - (setq mark (cdr (assq (tabulated-list-get-id) marks))) - (tabulated-list-put-tag (char-to-string mark) t))) - (user-error "No packages found"))))) - -(defun package-menu-filter-upgradable () - "Filter \"*Packages*\" buffer to show only upgradable packages." - (interactive nil package-menu-mode) - (let ((pkgs (mapcar #'car (package-menu--find-upgrades)))) - (package-menu--filter-by - (lambda (pkg) - (memql (package-desc-name pkg) pkgs)) - "upgradable"))) - -(defun package-menu-clear-filter () - "Clear any filter currently applied to the \"*Packages*\" buffer." - (interactive nil package-menu-mode) - (package--ensure-package-menu-mode) - (package-menu--generate t t)) - -(defun package-list-packages-no-fetch () - "Display a list of packages. -Does not fetch the updated list of packages before displaying. -The list is displayed in a buffer named `*Packages*'." - (interactive) - (list-packages t)) - ;;;###autoload (defun package-get-version () "Return the version number of the package in which this is used. @@ -4771,242 +534,5 @@ the `Version:' header." (require 'lisp-mnt) (lm-package-version mainfile))))))) - -;;;; Quickstart: precompute activation actions for faster start up. - -;; Activating packages via `package-initialize' is costly: for N installed -;; packages, it needs to read all N -pkg.el files first to decide -;; which packages to activate, and then again N -autoloads.el files. -;; To speed this up, we precompute a mega-autoloads file which is the -;; concatenation of all those -autoloads.el, so we can activate -;; all packages by loading this one file (and hence without initializing -;; package.el). - -;; Other than speeding things up, this also offers a bootstrap feature: -;; it lets us activate packages according to `package-load-list' and -;; `package-user-dir' even before those vars are set. - -(defcustom package-quickstart nil - "Precompute activation actions to speed up startup. -This requires the use of `package-quickstart-refresh' every time the -activations need to be changed, such as when `package-load-list' is modified." - :type 'boolean - :version "27.1") - -;;;###autoload -(defcustom package-quickstart-file - (locate-user-emacs-file "package-quickstart.el") - "Location of the file used to speed up activation of packages at startup." - :type 'file - :group 'applications - :initialize #'custom-initialize-delay - :version "27.1") - -(defun package--quickstart-maybe-refresh () - (if package-quickstart - ;; FIXME: Delay refresh in case we're installing/deleting - ;; several packages! - (package-quickstart-refresh) - (delete-file (concat package-quickstart-file "c")) - (delete-file package-quickstart-file))) - -(defvar package--quickstart-dir nil - "Set by `package-quickstart-file' to the directory containing it.") - -(defun package--quickstart-rel (file) - "Return an expr depending on `package--quickstart-dir' which evaluates to FILE. - -If FILE is in `package--quickstart-dir', returns an expression that is -relative to that directory, so if that directory is moved we can still -find FILE." - (if (file-in-directory-p file package--quickstart-dir) - `(file-name-concat package--quickstart-dir ,(file-relative-name file package--quickstart-dir)) - file)) - -(defun package-quickstart-refresh () - "(Re)Generate the `package-quickstart-file'." - (interactive) - (package-initialize 'no-activate) - (require 'info) - (let ((package--quickstart-pkgs ()) - ;; Pretend we haven't activated anything yet! - (package-activated-list ()) - ;; Make sure we can load this file without load-source-file-function. - (coding-system-for-write 'emacs-internal) - ;; Ensure that `pp' and `prin1-to-string' calls further down - ;; aren't truncated. - (print-length nil) - (print-level nil) - (Info-directory-list '("")) - (package--quickstart-dir nil)) - (dolist (elt package-alist) - (condition-case err - (package-activate (car elt)) - ;; Don't let failure of activation of a package arbitrarily stop - ;; activation of further packages. - (error (message "%s" (error-message-string err))))) - (setq package--quickstart-pkgs (nreverse package--quickstart-pkgs)) - (with-temp-file package-quickstart-file - (emacs-lisp-mode) ;For `syntax-ppss'. - (insert ";;; Quickstart file to activate all packages at startup -*- lexical-binding:t -*-\n") - (insert ";; ¡¡ This file is autogenerated by `package-quickstart-refresh', DO NOT EDIT !!\n\n") - (setq package--quickstart-dir - (file-name-directory (expand-file-name package-quickstart-file))) - (pp '(setq package--quickstart-dir - (file-name-directory (expand-file-name load-file-name))) - (current-buffer)) - (dolist (pkg package--quickstart-pkgs) - (let* ((file - ;; Prefer uncompiled files (and don't accept .so files). - (let ((load-suffixes '(".el" ".elc"))) - (locate-library (package--autoloads-file-name pkg)))) - (pfile (prin1-to-string (package--quickstart-rel file)))) - (insert "(let* ((load-file-name " pfile ")\ -\(load-true-file-name load-file-name))\n") - (insert-file-contents file) - ;; Fixup the special #$ reader form and throw away comments. - (while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move) - (unless (ppss-string-terminator (save-match-data (syntax-ppss))) - (replace-match (if (match-end 1) "" pfile) t t))) - (unless (bolp) (insert "\n")) - (insert ")\n"))) - (pp `(defvar package-activated-list) (current-buffer)) - (pp `(setq package-activated-list - (delete-dups - (append ',(mapcar #'package-desc-name package--quickstart-pkgs) - package-activated-list))) - (current-buffer)) - (let ((info-dirs - (mapcar #'package--quickstart-rel (butlast Info-directory-list)))) - (when info-dirs - (pp `(progn (require 'info) - (info-initialize) - (setq Info-directory-list - (append (list . ,info-dirs) Info-directory-list))) - (current-buffer)))) - ;; Use `\s' instead of a space character, so this code chunk is not - ;; mistaken for an actual file-local section of package.el. - (insert " -;; Local\sVariables: -;; version-control: never -;; no-update-autoloads: t -;; byte-compile-warnings: (not make-local) -;; End: -")) - ;; FIXME: Do it asynchronously in an Emacs subprocess, and - ;; don't show the byte-compiler warnings. - (byte-compile-file package-quickstart-file))) - -(defun package--imenu-prev-index-position-function () - "Move point to previous line in package-menu buffer. -This function is used as a value for -`imenu-prev-index-position-function'." - (unless (bobp) - (forward-line -1))) - -(defun package--imenu-extract-index-name-function () - "Return imenu name for line at point. -This function is used as a value for -`imenu-extract-index-name-function'. Point should be at the -beginning of the line." - (let ((package-desc (tabulated-list-get-id))) - (format "%s (%s): %s" - (package-desc-name package-desc) - (package-version-join (package-desc-version package-desc)) - (package-desc-summary package-desc)))) - -(defun package--query-desc (&optional alist) - "Query the user for a package or return the package at point. -The optional argument ALIST must consist of elements with the -form (PKG-NAME PKG-DESC). If not specified, it will default to -`package-alist'." - (or (tabulated-list-get-id) - (let ((alist (or alist package-alist))) - (cadr (assoc (completing-read "Package: " alist nil t) - alist #'string=))))) - -(defun package-browse-url (desc &optional secondary) - "Open the website of the package under point in a browser. -`browse-url' is used to determine the browser to be used. If -SECONDARY (interactively, the prefix), use the secondary browser. -DESC must be a `package-desc' object." - (interactive (list (package--query-desc) - current-prefix-arg) - package-menu-mode) - (unless desc - (user-error "No package here")) - (let ((url (cdr (assoc :url (package-desc-extras desc))))) - (unless url - (user-error "No website for %s" (package-desc-name desc))) - (if secondary - (funcall browse-url-secondary-browser-function url) - (browse-url url)))) - -(declare-function ietf-drums-parse-address "ietf-drums" - (string &optional decode)) - -(defun package-maintainers (pkg-desc &optional no-error) - "Return an email address for the maintainers of PKG-DESC. -The email address may contain commas, if there are multiple -maintainers. If no maintainers are found, an error will be -signaled. If the optional argument NO-ERROR is non-nil no error -will be signaled in that case." - (unless (package-desc-p pkg-desc) - (error "Invalid package description: %S" pkg-desc)) - (let* ((name (package-desc-name pkg-desc)) - (extras (package-desc-extras pkg-desc)) - (maint (alist-get :maintainer extras))) - (unless (listp (cdr maint)) - (setq maint (list maint))) - (cond - ((and (null maint) (null no-error)) - (user-error "Package `%s' has no explicit maintainer" name)) - ((and (not (progn - (require 'ietf-drums) - (ietf-drums-parse-address (cdar maint)))) - (null no-error)) - (user-error "Package `%s' has no maintainer address" name)) - (t - (with-temp-buffer - (mapc #'package--print-email-button maint) - (replace-regexp-in-string - "\n" ", " (string-trim - (buffer-substring-no-properties - (point-min) (point-max))))))))) - -;;;###autoload -(defun package-report-bug (desc) - "Prepare a message to send to the maintainers of a package. -DESC must be a `package-desc' object." - (interactive (list (package--query-desc package-alist)) - package-menu-mode) - (let ((maint (package-maintainers desc)) - (name (symbol-name (package-desc-name desc))) - (pkgdir (package-desc-dir desc)) - vars) - (when pkgdir - (dolist-with-progress-reporter (group custom-current-group-alist) - "Scanning for modified user options..." - (when (and (car group) - (file-in-directory-p (car group) pkgdir)) - (dolist (ent (get (cdr group) 'custom-group)) - (when (and (custom-variable-p (car ent)) - (boundp (car ent)) - (not (eq (custom--standard-value (car ent)) - (default-toplevel-value (car ent))))) - (push (car ent) vars)))))) - (dlet ((reporter-prompt-for-summary-p t)) - (reporter-submit-bug-report maint name vars)))) - -;;;; Introspection - -(defun package-get-descriptor (pkg-name) - "Return the `package-desc' of PKG-NAME." - (unless package--initialized (package-initialize 'no-activate)) - (or (package--get-activatable-pkg pkg-name) - (cadr (assq pkg-name package-alist)) - (cadr (assq pkg-name package-archive-contents)))) - -(provide 'package) - -;;; package.el ends here +(provide 'package-activate) +;;; package-activate.el ends here From 6c818936e00bf24201dbfa8916cd91aca24f84c9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Jan 2026 14:17:09 -0500 Subject: [PATCH 063/325] (cl--generic-build-combined-method): Fix lingering error (bug#80154) The cycle detection could occasionally leave some lingering cycle marker leading to bogus errors. While we're here, streamline the code, to eliminate an unneeded signal+condition-case. * lisp/emacs-lisp/cl-generic.el (cl--generic-build-combined-method): Delete error. (cl--generic-build-combined-method): Rewrite. --- lisp/emacs-lisp/cl-generic.el | 57 ++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 27 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 405500c0987..ea73ce766f5 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -855,33 +855,32 @@ This is particularly useful when many different tags select the same set of methods, since this table then allows us to share a single combined-method for all those different tags in the method-cache.") -(define-error 'cl--generic-cyclic-definition "Cyclic definition") - (defun cl--generic-build-combined-method (generic methods) - (if (null methods) - ;; Special case needed to fix a circularity during bootstrap. - (cl--generic-standard-method-combination generic methods) - (let ((f - (with-memoization - ;; FIXME: Since the fields of `generic' are modified, this - ;; hash-table won't work right, because the hashes will change! - ;; It's not terribly serious, but reduces the effectiveness of - ;; the table. - (gethash (cons generic methods) - cl--generic-combined-method-memoization) - (puthash (cons generic methods) :cl--generic--under-construction - cl--generic-combined-method-memoization) - (condition-case nil - (cl-generic-combine-methods generic methods) - ;; Special case needed to fix a circularity during bootstrap. - (cl--generic-cyclic-definition - (cl--generic-standard-method-combination generic methods)))))) - (if (eq f :cl--generic--under-construction) - (signal 'cl--generic-cyclic-definition - (list (cl--generic-name generic))) - f)))) + ;; Since `cl-generic-combine-methods' is itself a generic function, + ;; there is a chicken and egg problem when computing a combined + ;; method for `cl-generic-combine-methods'. + ;; We break such infinite recursion by detecting it and falling + ;; back to `cl--generic-standard-method-combination' when it happens. + ;; FIXME: Since the fields of `generic' are modified, the + ;; `cl--generic-combined-method-memoization' hash-table won't work + ;; right, because the hashes will change! It's not terribly serious, + ;; but reduces the effectiveness of the table. + (let ((key (cons generic methods))) + (pcase (gethash key cl--generic-combined-method-memoization) + (:cl--generic--under-construction + ;; Fallback to the standard method combination. + (setf (gethash key cl--generic-combined-method-memoization) + (cl--generic-standard-method-combination generic methods))) + ('nil + (setf (gethash key cl--generic-combined-method-memoization) + :cl--generic--under-construction) + (let ((f nil)) + (unwind-protect + (setq f (cl-generic-combine-methods generic methods)) + (setf (gethash key cl--generic-combined-method-memoization) f)))) + (f f)))) -(oclosure-define (cl--generic-nnm) +(oclosure-define cl--generic-nnm "Special type for `call-next-method's that just call `no-next-method'.") (defun cl-generic-call-method (generic method &optional fun) @@ -986,6 +985,10 @@ FUN is the function that should be called when METHOD calls (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car)))) (cl--generic-make-next-function generic dispatches-left methods))) +(unless (ignore-errors (cl-generic-generalizers t)) + ;; Temporary definition to let the next defgenerics succeed. + (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) + (cl-defgeneric cl-generic-generalizers (specializer) "Return a list of generalizers for a given SPECIALIZER. To each kind of `specializer', corresponds a `generalizer' which describes @@ -1002,11 +1005,11 @@ The code which extracts the tag should be as fast as possible. The tags should be chosen according to the following rules: - The tags should not be too specific: similar objects which match the same list of specializers should ideally use the same (`eql') tag. - This insures that the cached computation of the applicable + This ensures that the cached computation of the applicable methods for one object can be reused for other objects. - Corollary: objects which don't match any of the relevant specializers should ideally all use the same tag (typically nil). - This insures that this cache does not grow unnecessarily large. + This ensures that this cache does not grow unnecessarily large. - Two different generalizers G1 and G2 should not use the same tag unless they use it for the same set of objects. IOW, if G1.tag(X1) = G2.tag(X2) then G1.tag(X1) = G2.tag(X1) = G1.tag(X2) = G2.tag(X2). From 058bac45b2f64dee35e26e22b00bafde41aa5aec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 9 Jan 2026 22:34:32 -0500 Subject: [PATCH 064/325] cl-generic.el: Avoid an O(N^2) behavior When N methods are defined, don't (re)build the dispatch function each time since it takes O(N) time to build it. * lisp/emacs-lisp/cl-generic.el (cl--generic-method): Add docstring. (cl--generic): New `lazy-function` slot. (cl--generic-make-function): Use it and delay building the dispatch function until the next call. [toplevel]: Simplify the bootstrap hacks a bit. --- lisp/emacs-lisp/cl-generic.el | 58 ++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 21 deletions(-) diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index ea73ce766f5..d501a421ea2 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -154,17 +154,22 @@ also passed as second argument to SPECIALIZERS-FUNCTION." (:constructor cl--generic-make-method (specializers qualifiers call-con function)) (:predicate nil)) + "Type of `cl-generic' method objects. +FUNCTION holds a function containing the actual code of the method. +SPECIALIZERS holds the list of specializers (as long as the number of +mandatory arguments of the method). +QUALIFIERS holds the list of qualifiers. +CALL-CON indicates the calling convention expected by FUNCTION: +- nil: FUNCTION is just a normal function with no extra arguments for + `call-next-method' or `next-method-p' (which it hence can't use). +- `curried': FUNCTION is a curried function that first takes the + \"next combined method\" and returns the resulting combined method. + It can distinguish `next-method-p' by checking if that next method + is `cl--generic-isnot-nnm-p'. +- t: FUNCTION takes the `call-next-method' function as an extra first + argument." (specializers nil :read-only t :type list) (qualifiers nil :read-only t :type (list-of atom)) - ;; CALL-CON indicates the calling convention expected by FUNCTION: - ;; - nil: FUNCTION is just a normal function with no extra arguments for - ;; `call-next-method' or `next-method-p' (which it hence can't use). - ;; - `curried': FUNCTION is a curried function that first takes the - ;; "next combined method" and return the resulting combined method. - ;; It can distinguish `next-method-p' by checking if that next method - ;; is `cl--generic-isnot-nnm-p'. - ;; - t: FUNCTION takes the `call-next-method' function as its first (extra) - ;; argument. (call-con nil :read-only t :type symbol) (function nil :read-only t :type function)) @@ -181,7 +186,10 @@ also passed as second argument to SPECIALIZERS-FUNCTION." ;; The most important dispatch is last in the list (and the least is first). (dispatches nil :type (list-of (cons natnum (list-of generalizers)))) (method-table nil :type (list-of cl--generic-method)) - (options nil :type list)) + (options nil :type list) + ;; This slot holds the function we put into `symbol-function' before + ;; the actual dispatch function has been computed. + (lazy-function nil)) (defun cl-generic-function-options (generic) "Return the options of the generic function GENERIC." @@ -658,8 +666,6 @@ The set of acceptable TYPEs (also called \"specializers\") is defined ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) (let ((sym (cl--generic-name generic)) ; Actual name (for aliases). - ;; FIXME: Try to avoid re-constructing a new function if the old one - ;; is still valid (e.g. still empty method cache)? (gfun (cl--generic-make-function generic))) (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format (cl--generic-name generic) @@ -827,9 +833,24 @@ You might need to add: %S" ,@fixedargs args))))))))) (defun cl--generic-make-function (generic) - (cl--generic-make-next-function generic - (cl--generic-dispatches generic) - (cl--generic-method-table generic))) + "Return the function to put into the `symbol-function' of GENERIC." + ;; The function we want is the one that performs the dispatch, + ;; but that function depends on the set of methods and needs to be + ;; flushed/recomputed when the set of methods changes. + ;; To avoid reconstructing such a method N times for N `cl-defmethod', + ;; we construct the dispatch function lazily: + ;; we first return a "lazy" function, which waits until the + ;; first call to the method to really compute the dispatch function, + ;; at which point we replace the dummy with the real one. + (with-memoization (cl--generic-lazy-function generic) + (lambda (&rest args) + (let ((real + (cl--generic-make-next-function generic + (cl--generic-dispatches generic) + (cl--generic-method-table generic)))) + (let ((current-load-list nil)) + (defalias (cl--generic-name generic) real)) + (apply real args))))) (defun cl--generic-make-next-function (generic dispatches methods) (let* ((dispatch @@ -985,10 +1006,6 @@ FUN is the function that should be called when METHOD calls (setq methods (nreverse (mapcar #'cdr (sort methods #'car-less-than-car)))) (cl--generic-make-next-function generic dispatches-left methods))) -(unless (ignore-errors (cl-generic-generalizers t)) - ;; Temporary definition to let the next defgenerics succeed. - (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) - (cl-defgeneric cl-generic-generalizers (specializer) "Return a list of generalizers for a given SPECIALIZER. To each kind of `specializer', corresponds a `generalizer' which describes @@ -1031,8 +1048,7 @@ those methods.") (unless (ignore-errors (cl-generic-generalizers t)) ;; Temporary definition to let the next defmethod succeed. (fset 'cl-generic-generalizers - (lambda (specializer) - (if (eq t specializer) (list cl--generic-t-generalizer)))) + (lambda (_specializer) (list cl--generic-t-generalizer))) (fset 'cl-generic-combine-methods #'cl--generic-standard-method-combination)) (cl-defmethod cl-generic-generalizers (specializer) From 037130373ba778da0d252adbbca5252c4ae964b7 Mon Sep 17 00:00:00 2001 From: Arash Esbati Date: Sat, 10 Jan 2026 00:03:28 +0100 Subject: [PATCH 065/325] ; * doc/lispref/streams.texi (Output Functions): Fix markup (bug#80167). --- doc/lispref/streams.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index f3cd8db051f..288fa2b0b71 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -713,11 +713,11 @@ would have printed for the same argument. (prin1-to-string (mark-marker)) @result{} "#" @end group +@end example If @var{overrides} is non-@code{nil}, it should either be @code{t} (which tells @code{prin1} to use the defaults for all printer related variables), or a list of settings. @xref{Output Overrides}, for details. -@end example If @var{noescape} is non-@code{nil}, that inhibits use of quoting characters in the output. (This argument is supported in Emacs versions From d35e705bdcd7e81122ba8357b7fed61075e50498 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 11:31:07 +0000 Subject: [PATCH 066/325] ; log-view-mode-map: Fix binding M-RET in text mode frames. --- lisp/vc/log-view.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 87ffc6dfe0e..27c62847b50 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -130,7 +130,7 @@ (defvar-keymap log-view-mode-map "RET" #'log-view-toggle-entry-display - "M-" #'log-view-display-entry-and-diff + "M-RET" #'log-view-display-entry-and-diff "m" #'log-view-mark-entry "u" #'log-view-unmark-entry "U" #'log-view-unmark-all-entries From 881be95cddcab3cf37373678002c35334c177c97 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Fri, 26 Dec 2025 10:42:57 +0100 Subject: [PATCH 067/325] Allow reviewing packages before installaion * lisp/emacs-lisp/package.el (package-review-policy) (package-review-directory, package-review-diff-command): Add new options. (package--review-p): Add new function to consult 'package-review-policy'. (package-review): Add new function. (package-unpack): Use new functions. (package-install-from-archive): Return package descriptors of installed packages. (package-download-transaction): Handle failure of a incomplete transaction. (package-install): Report if a package installation failed. (package-upgrade): Anticipate a failed package transaction by not deleting a package beforehand. (package-install-from-buffer): Handle the failure to download dependencies or a rejection during the actual package review. * doc/emacs/package.texi: Document feature. * etc/NEWS: Mention new feature. --- doc/emacs/package.texi | 11 ++ etc/NEWS | 8 + lisp/emacs-lisp/package.el | 310 ++++++++++++++++++++++++++++++------- 3 files changed, 272 insertions(+), 57 deletions(-) diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index 2de3d25e7f9..e6432678c62 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -402,6 +402,17 @@ package is somehow unavailable, Emacs signals an error and stops installation.) A package's requirements list is shown in its help buffer. +@cindex review +@vindex package-review-policy + If you are cautious when it comes to installing and upgrading packages +from package archives, you can configure @code{package-review-policy} to +give you a chance to review packages before installing them. By setting +the user option to @code{t}, you get to review all packages (including +dependencies), during which you can browse the source code, examine a +diff between the downloaded package and a previous installation or read +a changelog. You can also configure @code{package-review-policy} to +selectively trust or distrust specific packages or archives. + @cindex GNU ELPA @cindex NonGNU ELPA By default, Emacs downloads packages from two archives: diff --git a/etc/NEWS b/etc/NEWS index 564479d2b1d..6df77525bf6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2827,6 +2827,14 @@ packages. --- *** Uninstalling a package now removes its directory from 'load-path'. ++++ +*** Packages can be reviewed before installation or upgrade. +The user option 'package-review-policy' can configure which packages +the user should be allowed to review before any processing takes place. +The package review can include reading the downloaded source code, +presenting a diff between the downloaded code and a previous +installation or displaying a changelog. + ** Rcirc +++ diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index bd5bee0a9ca..fccaf9f9f3e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -669,40 +669,201 @@ untar into a directory named DIR; otherwise, signal an error." (apply #'nconc (mapcar (lambda (pair) (list (car pair) (cdr pair))) alist)))) +(defcustom package-review-policy nil + "Policy to review incoming packages before installing them. +Reviewing a package allows you to read the source code without +installing anything, compare it to previous installations of the package +and read the changelog. The default value of nil will install packages +without any additional prompts, while t reviews all packages. By +setting this user option to a list you can also selectively list what +packages and archives to review. For the former, an entry of the +form (archive STRING) will review all packages form the archive +STRING (see `package-archives'), and an entry of the form (package +SYMBOL) will review package who's name matches SYMBOL. By prefixing the +list with a symbol `not' the rules are inverted." + :type + (let ((choice '(choice :tag "Review all packages form archive" + (cons (const archive) (string :tag "Archive name")) + (cons (const package) (symbol :tag "Package name"))))) + `(choice + (const :tag "Review all packages" t) + (repeat :tag "Review these specific packages and archives" ,choice) + (cons :tag "Review the complement of these packages and archives" + (const not) (repeat ,choice)))) + :risky t + :version "31.1") + +(defcustom package-review-directory temporary-file-directory + "Directory to unpack packages for review. +The value of this user option is used to rebind the variable +`temporary-file-directory'. The directory doesn't have to exist. If +that is the case, Emacs creates the directory for you. You can +therefore set the option to + + (setopt package-review-directory (expand-file-name \"emacs\" (xdg-cache-home))) + +if you wish to have Emacs unpack the packages in your home directory, in +case you are concerned about moving files between file systems." + :type 'directory + :version "31.1") + +(defcustom package-review-diff-command + (cons diff-command + '("-u" ;unified patch formatting + "-N" ;treat absent files as empty + "-x" "'*.elc'" ;ignore byte compiled files + "-x" "'*-autoloads.el'" ;ignore the autoloads file + "-x" "'*-pkg.el'" ;ignore the package description + "-x" "'*.info'" ;ignore compiled Info files + )) + "Configuration how `package-review' should generate a Diff. +The structure of the value must be (COMMAND . SWITCHES), where +`diff-command' is rebound to be COMMAND and SWITCHES are passed to +`diff' as the SWITCHES argument if the user selects a diff-related +option during review." + :type '(cons (string :tag "Diff command") + (repeat :tag "Diff arguments" string)) + :version "31.1") + +(defun package--review-p (pkg-desc) + "Return non-nil if upgrading PKG-DESC requires a review. +This package consults `package-review-policy' to determine if the user +wants to review the package prior to installation. See `package-review'." + (let ((archive (package-desc-archive pkg-desc)) + (name (package-desc-name pkg-desc))) + (pcase-exhaustive package-review-policy + ((and (pred listp) list) + (xor (any (lambda (ent) + (pcase ent + ((or `(archive . ,(pred (equal archive))) + `(package . ,(pred (eq name)))) + t) + (_ nil))) + (if (eq (car list) 'not) (cdr list) list)) + (eq (car list) 'not))) + ('t t)))) + + +(declare-function mail-text "sendmail" ()) +(declare-function message-goto-body "message" (&optional interactive)) +(declare-function diff-no-select "diff" (old new &optional switches no-async buf)) + +(defun package-review (pkg-desc pkg-dir old-desc) + "Review the installation of PKG-DESC. +PKG-DIR is the directory where the downloaded source of PKG-DIR have +been downloaded. OLD-DESC is either a `package-desc' object of the +previous installation or nil, if there is no prior installation. If the +review fails, the function throws a symbol `review-failed' with PKG-DESC +attached." + (let ((news (let* ((pkg-dir (package-desc-dir pkg-desc)) + (file (expand-file-name "news" pkg-dir))) + (and (file-regular-p file) + (file-readable-p file) + file))) + (enable-recursive-minibuffers t) + (diff-command (car package-review-diff-command))) + (while (pcase-exhaustive + (car (read-multiple-choice + (format "Install \"%s\"?" (package-desc-name pkg-desc)) + `((?y "yes" "Proceed with installation") + (?n "no" "Abort installation") + ,@(and old-desc '((?d "diff" "Show the installation diff") + (?m "mail" "Send an email to the maintainers"))) + ,@(and news '((?c "changelog" "Show the changelog"))) + (?b "browse" "Browse the source")))) + (?y nil) + (?n + (delete-directory pkg-dir t) + (throw 'review-failed pkg-desc)) + (?d + (diff (package-desc-dir old-desc) pkg-dir (cdr package-review-diff-command) t) + t) + (?m + (require 'diff) ;for `diff-no-select' + (with-temp-buffer + (diff-no-select + (package-desc-dir old-desc) pkg-dir + (cdr package-review-diff-command) + t (current-buffer)) + ;; delete sentinel message + (goto-char (point-max)) + (forward-line -2) + (narrow-to-region (point-min) (point)) + ;; prepare mail buffer + (let ((tmp-buf (current-buffer))) + (compose-mail (with-demoted-errors "Failed to find maintainers: %S" + (package-maintainers pkg-desc))) + (pcase mail-user-agent + ('sendmail-user-agent (mail-text)) + (_ (message-goto-body))) + (insert-buffer-substring tmp-buf))) + t) + (?c + (view-file news) + t) + (?b + (dired pkg-dir "-R") ;FIXME: Is recursive dired portable? + t))))) + (declare-function dired-get-marked-files "dired") (defun package-unpack (pkg-desc) - "Install the contents of the current buffer as a package." + "Install the contents of the current buffer as a package. +The argument PKG-DESC contains metadata of the yet to be installed +package. The function returns a `package-desc' object of the actually +installed package." (let* ((name (package-desc-name pkg-desc)) - (dirname (package-desc-full-name pkg-desc)) - (pkg-dir (expand-file-name dirname package-user-dir))) - (pcase (package-desc-kind pkg-desc) - ('dir - (make-directory pkg-dir t) - (let ((file-list - (or (and (derived-mode-p 'dired-mode) - (dired-get-marked-files nil 'marked)) - (directory-files-recursively default-directory "" nil)))) - (dolist (source-file file-list) - (let ((target (expand-file-name - (file-relative-name source-file default-directory) - pkg-dir))) - (make-directory (file-name-directory target) t) - (copy-file source-file target t))) - ;; Now that the files have been installed, this package is - ;; indistinguishable from a `tar' or a `single'. Let's make - ;; things simple by ensuring we're one of them. - (setf (package-desc-kind pkg-desc) - (if (length> file-list 1) 'tar 'single)))) - ('tar - (make-directory package-user-dir t) - (let* ((default-directory (file-name-as-directory package-user-dir))) - (package-untar-buffer dirname))) - ('single - (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir))) - (make-directory pkg-dir t) - (package--write-file-no-coding el-file))) - (kind (error "Unknown package kind: %S" kind))) + (full-name (package-desc-full-name pkg-desc)) + (pkg-dir (expand-file-name full-name package-user-dir)) + (review-p (package--review-p pkg-desc)) + (unpack-dir (if review-p + (let ((temporary-file-directory package-review-directory)) + (make-directory temporary-file-directory t) ;ensure existence + (expand-file-name + full-name + (make-temp-file "emacs-package-review-" t))) + pkg-dir)) + (old-desc (package--get-activatable-pkg name))) + (make-directory unpack-dir t) + (save-window-excursion + (pcase (package-desc-kind pkg-desc) + ('dir + (let ((file-list + (or (and (derived-mode-p 'dired-mode) + (dired-get-marked-files nil 'marked)) + (directory-files-recursively default-directory "" nil)))) + (dolist (source-file file-list) + (let ((target (expand-file-name + (file-relative-name source-file default-directory) + unpack-dir))) + (make-directory (file-name-directory target) t) + (copy-file source-file target t))) + ;; Now that the files have been installed, this package is + ;; indistinguishable from a `tar' or a `single'. Let's make + ;; things simple by ensuring we're one of them. + (setf (package-desc-kind pkg-desc) + (if (length> file-list 1) 'tar 'single)))) + ('tar + (let ((default-directory (file-name-directory unpack-dir))) + (package-untar-buffer (file-name-nondirectory unpack-dir)))) + ('single + (let ((el-file (expand-file-name (format "%s.el" name) unpack-dir))) + (package--write-file-no-coding el-file))) + (kind (error "Unknown package kind: %S" kind)))) + + ;; check if the user wants to review this package + (when review-p + (unwind-protect + (progn + (save-window-excursion + (package-review pkg-desc unpack-dir old-desc)) + (make-directory package-user-dir t) + (rename-file unpack-dir pkg-dir)) + (let ((temp-dir (file-name-directory unpack-dir))) + (when (file-directory-p temp-dir) + (delete-directory temp-dir t))))) + (cl-assert (file-directory-p pkg-dir)) + (package--make-autoloads-and-stuff pkg-desc pkg-dir) ;; Update package-alist. (let ((new-desc (package-load-descriptor pkg-dir))) @@ -722,8 +883,9 @@ untar into a directory named DIR; otherwise, signal an error." (package--native-compile-async new-desc)) ;; After compilation, load again any files loaded by ;; `activate-1', so that we use the byte-compiled definitions. - (package--reload-previously-loaded new-desc))) - pkg-dir)) + (package--reload-previously-loaded new-desc)) + + new-desc))) (defun package-generate-description-file (pkg-desc pkg-file) "Create the foo-pkg.el file PKG-FILE for single-file package PKG-DESC." @@ -1740,13 +1902,16 @@ if all the in-between dependencies are also in PACKAGE-LIST." (cdr (assoc (package-desc-archive desc) package-archives))) (defun package-install-from-archive (pkg-desc) - "Download and install a package defined by PKG-DESC." + "Download and install a package defined by PKG-DESC. +The function returns the new `package-desc' object of the installed +package." ;; This won't happen, unless the archive is doing something wrong. (when (eq (package-desc-kind pkg-desc) 'dir) (error "Can't install directory package from archive")) (let* ((location (package-archive-base pkg-desc)) (file (concat (package-desc-full-name pkg-desc) - (package-desc-suffix pkg-desc)))) + (package-desc-suffix pkg-desc))) + new-desc) (package--with-response-buffer location :file file (if (or (not (package-check-signature)) (member (package-desc-archive pkg-desc) @@ -1754,7 +1919,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." ;; If we don't care about the signature, unpack and we're ;; done. (let ((save-silently t)) - (package-unpack pkg-desc)) + (setq new-desc (package-unpack pkg-desc))) ;; If we care, check it and *then* write the file. (let ((content (buffer-string))) (package--check-signature @@ -1767,7 +1932,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (cl-assert (not (multibyte-string-p content))) (insert content) (let ((save-silently t)) - (package-unpack pkg-desc))) + (setq new-desc (package-unpack pkg-desc)))) ;; Here the package has been installed successfully, mark it as ;; signed if appropriate. (when good-sigs @@ -1798,15 +1963,27 @@ if all the in-between dependencies are also in PACKAGE-LIST." (unless (save-excursion (goto-char (point-min)) (looking-at-p "[[:space:]]*\\'")) - (write-region nil nil readme))))))) + (write-region nil nil readme))))) + new-desc)) (defun package-download-transaction (packages) "Download and install all the packages in PACKAGES. -PACKAGES should be a list of `package-desc'. -This function assumes that all package requirements in -PACKAGES are satisfied, i.e. that PACKAGES is computed -using `package-compute-transaction'." - (mapc #'package-install-from-archive packages)) +PACKAGES should be a list of `package-desc'. This function assumes that +all package requirements in PACKAGES are satisfied, i.e. that PACKAGES +is computed using `package-compute-transaction'. The function returns a +list of `package-desc' objects that have been installed, or nil if the +transaction had no effect." + (let* ((installed '()) + (pkg-desc (catch 'review-failed + (dolist (pkg-desc packages nil) + (push (package-install-from-archive pkg-desc) + installed))))) + (if pkg-desc + (progn + (message "Rejected `%s', reverting transaction." (package-desc-name pkg-desc)) + (mapc #'package-delete installed) + nil) + installed))) (defun package--archives-initialize () "Make sure the list of installed and remote packages are initialized." @@ -1855,6 +2032,10 @@ had been enabled." nil 'interactive))) (cl-check-type pkg (or symbol package-desc)) + (when (or (and package-install-upgrade-built-in + (package--active-built-in-p pkg)) + (package-installed-p pkg)) + (user-error "Package is already installed")) (package--archives-initialize) (add-hook 'post-command-hook #'package-menu--post-refresh) (let ((name (if (package-desc-p pkg) @@ -1877,11 +2058,11 @@ had been enabled." (package-compute-transaction (list pkg) (package-desc-reqs pkg))) (package-compute-transaction () (list (list pkg)))))) - (progn - (package-download-transaction transaction) - (package--quickstart-maybe-refresh) - (message "Package `%s' installed." name)))))) - + (if (package-download-transaction transaction) + (progn + (package--quickstart-maybe-refresh) + (message "Package `%s' installed" name)) + (error "Package `%s' not installed" name)))))) (declare-function package-vc-upgrade "package-vc" (pkg)) @@ -1900,12 +2081,17 @@ NAME should be a symbol." ;; `pkg-desc' will be nil when the package is an "active built-in". (if (and pkg-desc (package-vc-p pkg-desc)) (package-vc-upgrade pkg-desc) - (when pkg-desc - (package-delete pkg-desc 'force 'dont-unselect)) - (package-install name - ;; An active built-in has never been "selected" - ;; before. Mark it as installed explicitly. - (and pkg-desc 'dont-select))))) + (let ((new-desc (cadr (assq name package-archive-contents)))) + (when (or (null new-desc) + (version-list-= (package-desc-version pkg-desc) + (package-desc-version new-desc))) + (user-error "Cannot upgrade `%s'" name)) + (package-install new-desc + ;; An active built-in has never been "selected" + ;; before. Mark it as installed explicitly. + (and pkg-desc 'dont-select)) + (when pkg-desc + (package-delete pkg-desc 'force 'dont-unselect)))))) (defun package--upgradeable-packages (&optional include-builtins) ;; Initialize the package system to get the list of package @@ -2040,10 +2226,20 @@ Downloads and installs required packages as needed." (name (package-desc-name pkg-desc))) ;; Download and install the dependencies. (let* ((requires (package-desc-reqs pkg-desc)) - (transaction (package-compute-transaction nil requires))) - (package-download-transaction transaction)) - ;; Install the package itself. - (package-unpack pkg-desc) + (transaction (package-compute-transaction nil requires)) + (installed (package-download-transaction transaction))) + (when (and (catch 'review-failed + ;; Install the package itself. + (package-unpack pkg-desc) + nil) + (or (null transaction) installed)) + (mapc #'package-delete installed) + (when installed + (message "Review uninstalled dependencies: %s" + (mapconcat #'package-desc-full-name + installed + ", "))) + (user-error "Installation aborted"))) (unless (package--user-selected-p name) (package--save-selected-packages (cons name package-selected-packages))) From c8d19034aa9997aed6a5ffe65064920b48c76e5f Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 23 Dec 2025 19:39:31 +0100 Subject: [PATCH 068/325] Allow 'package-isolate' to fetch missing packages * lisp/emacs-lisp/package.el (package-isolate): Fetch missing packages and make them available in the new Emacs process, but not the current one. * etc/NEWS: Mention change. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/package.el | 42 +++++++++++++++++++++++--------------- 2 files changed, 31 insertions(+), 16 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 6df77525bf6..98059ef15f6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2804,6 +2804,11 @@ When called from Lisp, it now only accepts a symbol. When invoking the command in a Dired buffer with marked files, the command will only copy those files. +--- +*** 'package-isolate' can now also install packages. +If a package is missing, 'package-isolate' will fetch the missing +tarballs and prepare them to be activated in the sub-process. + +++ *** package-x.el is now obsolete. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index fccaf9f9f3e..19e412d5fd3 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2484,14 +2484,16 @@ argument, don't ask for confirmation to install packages." (defun package-isolate (packages &optional temp-init) "Start an uncustomized Emacs and only load a set of PACKAGES. Interactively, prompt for PACKAGES to load, which should be specified -separated by commas. -If called from Lisp, PACKAGES should be a list of packages to load. -If TEMP-INIT is non-nil, or when invoked with a prefix argument, -the Emacs user directory is set to a temporary directory. -This command is intended for testing Emacs and/or the packages -in a clean environment." +separated by commas. If called from Lisp, PACKAGES should be a list of +`package-desc' objects to load. If an element of PACKAGES is not +installed, it will be fetched, but not activated in the current session. +If TEMP-INIT is non-nil, or when invoked with a prefix argument, the +Emacs user directory is set to a temporary directory. This command is +intended for testing Emacs and/or the packages in a clean environment." (interactive - (cl-loop for p in (cl-loop for p in (package--alist) append (cdr p)) + (cl-loop for p in (append + (cl-loop for p in (package--alist) append (cdr p)) + (cl-loop for p in package-archive-contents append (cdr p))) unless (package-built-in-p p) collect (cons (package-desc-full-name p) p) into table finally return @@ -2500,21 +2502,27 @@ in a clean environment." (completing-read-multiple "Packages to isolate: " table nil t) - collect (alist-get c table nil nil #'string=)) - current-prefix-arg))) + collect (alist-get c table nil nil #'string=)) + current-prefix-arg))) (let* ((name (concat "package-isolate-" (mapconcat #'package-desc-full-name packages ","))) - (all-packages (delete-consecutive-dups - (sort (append packages (mapcan #'package--dependencies packages)) - (lambda (p0 p1) - (string< (package-desc-name p0) (package-desc-name p1)))))) - initial-scratch-message package-load-list) + (all-packages (package-compute-transaction + packages (mapcan #'package-desc-reqs packages))) + (package-alist (copy-tree package-alist t)) + (temp-install-dir nil) initial-scratch-message load-list) + (when-let* ((missing (seq-remove #'package-installed-p all-packages)) + (package-user-dir (make-temp-file "package-isolate" t))) + (setq temp-install-dir (list package-user-dir)) + ;; We bind `package-activate-1' to prevent activating the package + ;; in `package-unpack' for this session. + (cl-letf (((symbol-function #'package-activate-1) #'ignore)) + (package-download-transaction missing))) (with-temp-buffer (insert ";; This is an isolated testing environment, with these packages enabled:\n\n") (dolist (package all-packages) (push (list (package-desc-name package) (package-version-join (package-desc-version package))) - package-load-list) + load-list) (insert ";; - " (package-desc-full-name package)) (unless (memq package packages) (insert " (dependency)")) @@ -2535,7 +2543,9 @@ in a clean environment." ,@(mapcar (lambda (dir) `(add-to-list 'package-directory-list ,dir)) - (cons package-user-dir package-directory-list)) + (append (list package-user-dir) + temp-install-dir + package-directory-list)) (setq package-load-list ',package-load-list) (package-activate-all))))))) From 5b89d4696560cfea8d00731921b038e16b73ec82 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Mon, 5 Jan 2026 14:42:19 +0100 Subject: [PATCH 069/325] Bind 'apropos-user-option' to C-h u * doc/emacs/help.texi: Adjust documentation. * etc/NEWS: Mention change. * lisp/help.el (help-map): Add binding. --- doc/emacs/help.texi | 3 ++- etc/NEWS | 5 +++++ lisp/help.el | 1 + 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 657356cd825..8c4c2c82692 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -422,7 +422,8 @@ search for noninteractive functions too. Search for functions and variables. Both interactive functions (commands) and noninteractive functions can be found by this. -@item M-x apropos-user-option +@item C-h u +@kindex C-h u @findex apropos-user-option Search for user-customizable variables. With a prefix argument, search for non-customizable variables too. diff --git a/etc/NEWS b/etc/NEWS index 98059ef15f6..68cb6c642fb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -684,6 +684,11 @@ project, during completion. That makes some items shorter. The category defaults are the same as for 'buffer' but any user customizations would need to be re-added. +** Help + ++++ +*** New keybinding 'C-h u' for 'apropos-user-option'. + ** IDLWAVE has been moved to GNU ELPA. The version bundled with Emacs is out-of-date, and is now marked as obsolete. Use 'M-x list-packages' to install the 'idlwave' package from diff --git a/lisp/help.el b/lisp/help.el index 0bb1053fa6a..76c3770fbba 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -99,6 +99,7 @@ buffer.") "f" #'describe-function "g" #'describe-gnu-project "h" #'view-hello-file + "u" #'apropos-user-option "i" #'info "4 i" #'info-other-window From da42dd049126d51436371ba184f18292a06060e3 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 10 Jan 2026 12:43:17 +0100 Subject: [PATCH 070/325] ; Fix order of @item and indices in help.texi * doc/emacs/help.texi (Apropos): Place @kindex and @findex before @item. --- doc/emacs/help.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 8c4c2c82692..c16e94df5aa 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -422,9 +422,9 @@ search for noninteractive functions too. Search for functions and variables. Both interactive functions (commands) and noninteractive functions can be found by this. -@item C-h u @kindex C-h u @findex apropos-user-option +@item C-h u Search for user-customizable variables. With a prefix argument, search for non-customizable variables too. From fc682db9d8ee44869c1fbf26497991c4760b5c31 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 11:49:55 +0000 Subject: [PATCH 071/325] * lisp/vc/vc.el (vc-deduce-fileset): Don't return empty FILESET. Suggested by Spencer Baugh . --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 94bc72fc406..09918fad31e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1474,7 +1474,7 @@ BEWARE: this function may change the current buffer." (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files))) ((and (not buffer-file-name) (setq backend (vc-responsible-backend default-directory))) - (list backend nil)) + (list backend default-directory)) ((and allow-unregistered (not (vc-registered buffer-file-name))) (if state-model-only-files (list (vc-backend-for-registration (buffer-file-name)) From cd88b8c2ba237fa2c02569c053fc80ceede143e8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 11:51:54 +0000 Subject: [PATCH 072/325] ; Fix last change. --- lisp/vc/vc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 09918fad31e..af129f3da5f 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -1474,7 +1474,7 @@ BEWARE: this function may change the current buffer." (vc-deduce-fileset not-state-changing allow-unregistered state-model-only-files))) ((and (not buffer-file-name) (setq backend (vc-responsible-backend default-directory))) - (list backend default-directory)) + (list backend (list default-directory))) ((and allow-unregistered (not (vc-registered buffer-file-name))) (if state-model-only-files (list (vc-backend-for-registration (buffer-file-name)) From 09aad81166d2d1ebc97f3f480e70869427ef07d1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 12:08:11 +0000 Subject: [PATCH 073/325] vc--apply-to-other-working-tree: Handle 'diff-default-read-only'. * lisp/vc/vc.el (vc--apply-to-other-working-tree): Bind inhibit-read-only to non-nil to handle the case when diff-default-read-only is non-nil (bug#80128). --- lisp/vc/vc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index af129f3da5f..a976c498c13 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -5471,7 +5471,8 @@ MOVE non-nil means to move instead of copy." (with-temp-buffer (cond* (patch-string (diff-mode) - (insert patch-string)) + (let ((inhibit-read-only t)) ; `diff-default-read-only'. + (insert patch-string))) ;; Some backends don't tolerate unregistered files ;; appearing in the fileset for a diff operation. ((bind* (diff-fileset From 53225d8a3a4d8641c8e459658d4fcbc8d03d6e65 Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Fri, 9 Jan 2026 21:56:52 +0800 Subject: [PATCH 074/325] Fix cursor position in calendar-generate-window (bug#80069) * lisp/calendar/calendar.el (calendar-generate-window): Move cursor to today before running calendar-today-visible-hook. --- lisp/calendar/calendar.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 0d49a6571d5..2da45c18880 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1450,9 +1450,12 @@ Optional integers MON and YR are used instead of today's date." (calendar-mark-holidays)) (unwind-protect (if calendar-mark-diary-entries (diary-mark-entries)) - (run-hooks (if (calendar-date-is-visible-p today) - 'calendar-today-visible-hook - 'calendar-today-invisible-hook))))) + (if (not (calendar-date-is-visible-p today)) + (run-hooks 'calendar-today-invisible-hook) + ;; Functions in calendar-today-visible-hook may rely on the cursor + ;; being on today's date. + (calendar-cursor-to-visible-date today) + (run-hooks 'calendar-today-visible-hook))))) (defun calendar-generate (month year) "Generate a three-month Gregorian calendar centered around MONTH, YEAR." From ee65464ca1f8fe62c9fa43a0d7c393c649423c62 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Jan 2026 14:25:45 +0200 Subject: [PATCH 075/325] ; Fix documentation of a recent commit * lisp/emacs-lisp/package.el (package-review-policy) (package-review-diff-command): Fix doc strings and tags of option values. (package-review-directory, package--review-p, package-review): Doc fixes. --- lisp/emacs-lisp/package.el | 41 +++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 19e412d5fd3..c928aeb0ed3 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -673,22 +673,22 @@ untar into a directory named DIR; otherwise, signal an error." "Policy to review incoming packages before installing them. Reviewing a package allows you to read the source code without installing anything, compare it to previous installations of the package -and read the changelog. The default value of nil will install packages +and read the change log. The default value of nil will install packages without any additional prompts, while t reviews all packages. By setting this user option to a list you can also selectively list what packages and archives to review. For the former, an entry of the -form (archive STRING) will review all packages form the archive +form (archive STRING) will review all packages from the archive STRING (see `package-archives'), and an entry of the form (package -SYMBOL) will review package who's name matches SYMBOL. By prefixing the -list with a symbol `not' the rules are inverted." +SYMBOL) will review packages whose names match SYMBOL. If you prefix +the list with a symbol `not', the rules are inverted." :type - (let ((choice '(choice :tag "Review all packages form archive" + (let ((choice '(choice :tag "Review specific packages or archives" (cons (const archive) (string :tag "Archive name")) (cons (const package) (symbol :tag "Package name"))))) `(choice (const :tag "Review all packages" t) (repeat :tag "Review these specific packages and archives" ,choice) - (cons :tag "Review the complement of these packages and archives" + (cons :tag "Review packages and archives except these" (const not) (repeat ,choice)))) :risky t :version "31.1") @@ -696,11 +696,12 @@ list with a symbol `not' the rules are inverted." (defcustom package-review-directory temporary-file-directory "Directory to unpack packages for review. The value of this user option is used to rebind the variable -`temporary-file-directory'. The directory doesn't have to exist. If -that is the case, Emacs creates the directory for you. You can +`temporary-file-directory'. The directory doesn't have to exist; if +it doesn't, Emacs will create the directory for you. You can therefore set the option to - (setopt package-review-directory (expand-file-name \"emacs\" (xdg-cache-home))) + (setopt package-review-directory + (expand-file-name \"emacs\" (xdg-cache-home))) if you wish to have Emacs unpack the packages in your home directory, in case you are concerned about moving files between file systems." @@ -716,18 +717,18 @@ case you are concerned about moving files between file systems." "-x" "'*-pkg.el'" ;ignore the package description "-x" "'*.info'" ;ignore compiled Info files )) - "Configuration how `package-review' should generate a Diff. -The structure of the value must be (COMMAND . SWITCHES), where -`diff-command' is rebound to be COMMAND and SWITCHES are passed to -`diff' as the SWITCHES argument if the user selects a diff-related -option during review." - :type '(cons (string :tag "Diff command") - (repeat :tag "Diff arguments" string)) + "Configuration of how `package-review' should generate a Diff. +The structure of the value must be (COMMAND . OPTIONS), where +`diff-command' is rebound to be COMMAND and OPTIONS are command-line +switches and arguments passed to `diff-no-select' as the SWITCHES argument +if the user selects a diff-related option during review." + :type '(cons (string :tag "Diff command name") + (repeat :tag "Diff command-line arguments" string)) :version "31.1") (defun package--review-p (pkg-desc) "Return non-nil if upgrading PKG-DESC requires a review. -This package consults `package-review-policy' to determine if the user +This function consults `package-review-policy' to determine if the user wants to review the package prior to installation. See `package-review'." (let ((archive (package-desc-archive pkg-desc)) (name (package-desc-name pkg-desc))) @@ -749,10 +750,10 @@ wants to review the package prior to installation. See `package-review'." (declare-function diff-no-select "diff" (old new &optional switches no-async buf)) (defun package-review (pkg-desc pkg-dir old-desc) - "Review the installation of PKG-DESC. -PKG-DIR is the directory where the downloaded source of PKG-DIR have + "Review the package specified PKG-DESC which is about to be installed. +PKG-DIR is the directory where the downloaded source of PKG-DESC have been downloaded. OLD-DESC is either a `package-desc' object of the -previous installation or nil, if there is no prior installation. If the +previous installation or nil, if there was no prior installation. If the review fails, the function throws a symbol `review-failed' with PKG-DESC attached." (let ((news (let* ((pkg-dir (package-desc-dir pkg-desc)) From 98f56a156e9bc1b74a6238abbfac6a4a9022a874 Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Thu, 1 Jan 2026 18:26:38 +0200 Subject: [PATCH 076/325] NS: Use Cocoa implementation of EmacsBell -init if named image is declared * configure.ac: Check for 'NSImageNameCaution' declaration when building on GNUstep. * src/nsterm.m ([EmacsBell init]): Use fallback implementation on GNUstep only if 'NSImageNameCaution' is not declared. (Bug#80107) --- configure.ac | 5 +++++ src/nsterm.m | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac index 9907ab86e83..5be2588600d 100644 --- a/configure.ac +++ b/configure.ac @@ -2886,6 +2886,11 @@ Mac OS X 12.x or later. [Define to use native OS APIs for images.]) NATIVE_IMAGE_API="yes (ns)" fi + + if test "${NS_IMPL_GNUSTEP}" = yes; then + AC_CHECK_DECLS([NSImageNameCaution], [], [], + [[#import ]]) + fi fi AC_SUBST([LIBS_GNUSTEP]) diff --git a/src/nsterm.m b/src/nsterm.m index fe5bc35086d..f96096242d2 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1221,7 +1221,7 @@ - (id)init { nestCount = 0; isAttached = false; -#ifdef NS_IMPL_GNUSTEP +#if NS_IMPL_GNUSTEP && !HAVE_DECL_NSIMAGENAMECAUTION // GNUstep doesn't provide named images. This was reported in // 2011, see https://savannah.gnu.org/bugs/?33396 // From 88d3101fdd10f5e922aae9d99fcfd103a33747db Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Jan 2026 14:36:10 +0200 Subject: [PATCH 077/325] ; Fix description of NS/GNUstep CPP conditions * admin/CPP-DEFINES (NS_IMPL_GNUSTEP, NS_IMPL_COCOA): Fix description (bug#80110). --- admin/CPP-DEFINES | 2 ++ 1 file changed, 2 insertions(+) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index c07fdc487ee..bdd5a097ab7 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -34,7 +34,9 @@ __ANDROID_API__ A numerical "API level" indicating the version of HAVE_NTGUI Use the native W32 GUI for windows, frames, menus&scrollbars. HAVE_NS Use the NeXT/OpenStep/Cocoa UI under macOS or GNUstep. NS_IMPL_GNUSTEP Compile support for GNUstep implementation of NS GUI API. + Only true on systems other than macOS. NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API. + Only true on macOS. HAVE_X11 Compile support for the X11 GUI. HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. HAVE_HAIKU Compile support for the Haiku window system. From 4e779d20f1840fef380f5688ceb2cd80658bde0b Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Mon, 29 Dec 2025 12:35:24 -0800 Subject: [PATCH 078/325] Update cursor display using Xterm escape sequences * lisp/term/xterm.el (xterm-update-cursor): New user option. (xterm--init): Use it. (xterm--post-command-hook): New function for all xterm functionality installed in 'post-command-hook'. (xterm--init-frame-title): Install it. (xterm--init-update-cursor, xterm--set-cursor-type) (xterm--update-cursor-type, xterm--update-cursor-color): New functions. (xterm--cursor-type-to-int): New constant. * doc/emacs/display.texi (Cursor Display): * etc/NEWS: Document the new feature. --- doc/emacs/display.texi | 53 ++++++++++++-------- etc/NEWS | 9 ++++ lisp/term/xterm.el | 111 ++++++++++++++++++++++++++++++++++++++++- 3 files changed, 152 insertions(+), 21 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 05a25323543..d475fc3cfde 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2048,20 +2048,41 @@ variable @code{visible-cursor} is @code{nil} when Emacs starts or resumes, it uses the normal cursor. @vindex cursor-type - On a graphical display, many more properties of the text cursor can -be altered. To customize its color, change the @code{:background} -attribute of the face named @code{cursor} (@pxref{Face -Customization}). (The other attributes of this face have no effect; -the text shown under the cursor is drawn using the frame's background -color.) To change its shape, customize the buffer-local variable -@code{cursor-type}; possible values are @code{box} (the default), -@code{(box . @var{size})} (box cursor becoming a hollow box under -masked images larger than @var{size} pixels in either dimension), -@code{hollow} (a hollow box), @code{bar} (a vertical bar), @code{(bar -. @var{n})} (a vertical bar @var{n} pixels wide), @code{hbar} (a -horizontal bar), @code{(hbar . @var{n})} (a horizontal bar @var{n} + On a graphical display and many Xterm-compatible text terminals, the +color and shape of the text cursor can be altered. To customize its +color, change the @code{:background} attribute of the face named +@code{cursor} (@pxref{Face Customization}). (The other attributes of +this face have no effect; the text shown under the cursor is drawn using +the frame's background color.) To change its shape, customize the +buffer-local variable @code{cursor-type}; possible values are @code{box} +(the default), @code{(box . @var{size})} (box cursor becoming a hollow +box under masked images larger than @var{size} pixels in either +dimension), @code{hollow} (a hollow box), @code{bar} (a vertical bar), +@code{(bar . @var{n})} (a vertical bar @var{n} pixels wide), @code{hbar} +(a horizontal bar), @code{(hbar . @var{n})} (a horizontal bar @var{n} pixels tall), or @code{nil} (no cursor at all). +@vindex xterm-update-cursor + On Xterm-compatible text terminals cursor customiztaion is controlled +by the user option @code{xterm-update-cursor}. Valid values are: +@code{t} to update the cursor's color and shape, @code{type} to update +the cursor's shape only, @code{color} to update the cursor's color only, +and @code{nil} to not update the cursor's appearance. Xterm-compatible +text terminals can not display a hollow box and instead use a filled +box. Similarly, Xterm-compatible text terminals ignore the pixel sizes +for @code{bar} and @code{hbar}. + +@findex hl-line-mode +@findex global-hl-line-mode +@cindex highlight current line + To make the cursor even more visible, you can use HL Line mode, a +minor mode that highlights the line containing point. Use @kbd{M-x +hl-line-mode} to enable or disable it in the current buffer. @kbd{M-x +global-hl-line-mode} enables or disables the same mode globally. + + The remaining controls only work on graphical displays where Emacs can +fully control the way the cursor appears. + @findex blink-cursor-mode @cindex cursor, blinking @cindex blinking cursor @@ -2105,14 +2126,6 @@ non-blinking hollow box. (For a bar cursor, it instead appears as a thinner bar.) To turn off cursors in non-selected windows, change the variable @code{cursor-in-non-selected-windows} to @code{nil}. -@findex hl-line-mode -@findex global-hl-line-mode -@cindex highlight current line - To make the cursor even more visible, you can use HL Line mode, a -minor mode that highlights the line containing point. Use @kbd{M-x -hl-line-mode} to enable or disable it in the current buffer. @kbd{M-x -global-hl-line-mode} enables or disables the same mode globally. - @node Line Truncation @section Line Truncation diff --git a/etc/NEWS b/etc/NEWS index 68cb6c642fb..27aff3b7a1e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -772,6 +772,15 @@ Emacs previously discarded arguments to emacsclient of zero length, such as in 'emacsclient --eval "(length (pop server-eval-args-left))" ""'. These are no longer discarded. ++++ +** New user option 'xterm-update-cursor' to update cursor display on TTYs. +When enabled, Emacs sends Xterm escape sequences on Xterm-compatible +terminals to update the cursor's appearacse. Emacs can update the +cursor's shape and color. For example, if you use a purple bar cursor +on graphical displays then when this option is enabled Emacs will use a +purple bar cursor on compatible terminals as well. See the Info node +"(emacs) Cursor Display" for more information. + * Editing Changes in Emacs 31.1 diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index dd179c4e3eb..47e82decb03 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -80,6 +80,20 @@ capabilities, and only when that terminal understands bracketed paste." :version "28.1" :type 'boolean) +(defcustom xterm-update-cursor nil + "If non-nil, try to update the cursor's appearance on XTerm terminals. + +If set to t all supported attributes of the cursor are updated. +If set to `type' only the cursor type is updated. This uses the CSI +DECSCUSR escape sequence. +If set to `color' only the cursor color is updated. This uses the OSC +12 escape sequence." + :version "31.1" + :type '(radio (const :tag "Do not update" nil) + (const :tag "Update" t) + (const :tag "Update type only" type) + (const :tag "Update color only" color))) + (defconst xterm-paste-ending-sequence "\e[201~" "Characters sent by the terminal to end a bracketed paste.") @@ -988,6 +1002,8 @@ We run the first FUNCTION whose STRING matches the input events." (when xterm-set-window-title (xterm--init-frame-title)) + (when xterm-update-cursor + (xterm--init-update-cursor)) (let ((bg-color (terminal-parameter nil 'xterm--background-color)) (fg-color (terminal-parameter nil 'xterm--foreground-color))) @@ -1025,6 +1041,17 @@ We run the first FUNCTION whose STRING matches the input events." ;; We likewise unconditionally enable support for focus tracking. (xterm--init-focus-tracking)) +(defun xterm--post-command-hook () + "Hook for xterm features that need to be frequently updated." + + (unless (display-graphic-p) + (when xterm-set-window-title + (xterm-set-window-title)) + (when (memq xterm-update-cursor '(t type)) + (xterm--update-cursor-type)) + (when (memq xterm-update-cursor '(t color)) + (xterm--update-cursor-color)))) + (defun terminal-init-xterm () "Terminal initialization function for xterm." (unwind-protect @@ -1067,7 +1094,7 @@ We run the first FUNCTION whose STRING matches the input events." (xterm-set-window-title) (add-hook 'after-make-frame-functions 'xterm-set-window-title-flag) (add-hook 'window-configuration-change-hook 'xterm-unset-window-title-flag) - (add-hook 'post-command-hook 'xterm-set-window-title) + (add-hook 'post-command-hook 'xterm--post-command-hook) (add-hook 'minibuffer-exit-hook 'xterm-set-window-title)) (defvar xterm-window-title-flag nil @@ -1300,6 +1327,88 @@ versions of xterm." (b (caddr fg-color))) (set-face-foreground 'default (format "#%04x%04x%04x" r g b) frame))))) +(defun xterm--init-update-cursor () + "Register hooks to run `xterm--update-cursor-type' appropriately." + + (when (memq xterm-update-cursor '(color t)) + (xterm--query + "\e]12;?\e\\" + '(("\e]12;" . (lambda () + (let ((str (xterm--read-string ?\e ?\\))) + ;; The response is specifically formated to set the + ;; color + (push + (concat "\e]12;" str "\e\\") + (terminal-parameter nil 'tty-mode-reset-strings))))))) + ;; No need to set tty-mode-set-strings because + ;; xterm--post-command-hook handles restoring the cursor color. + + (xterm--update-cursor-color)) + + (when (memq xterm-update-cursor '(type t)) + (xterm--update-cursor-type)) + + (add-hook 'post-command-hook 'xterm--post-command-hook)) + +(defconst xterm--cursor-type-to-int + '(nil 0 + box 1 + hollow 1 + bar 5 + hbar 3) + "Mapping of cursor type symbols to control sequence integers. + +Cursor type symbols are the same as for `cursor-type'.") + +(defun xterm--set-cursor-type (terminal type) + (let ((type-int (or (plist-get xterm--cursor-type-to-int type) 1)) + (old (terminal-parameter terminal 'xterm--cursor-style))) + + (when old + (set-terminal-parameter + terminal + 'tty-mode-set-strings + (delete (format "\e[%d q" old) + (terminal-parameter terminal 'tty-mode-set-strings)))) + (let ((set-string (format "\e[%d q" type-int))) + (push set-string (terminal-parameter terminal 'tty-mode-set-strings)) + (send-string-to-terminal set-string terminal)) + (unless old + ;; Assume that the default cursor is appropriate when exiting Emacs. + (push "\e[0 q" (terminal-parameter terminal 'tty-mode-reset-strings))) + + (set-terminal-parameter terminal 'xterm--cursor-type type-int))) + +(defun xterm--update-cursor-type () + "Update the cursor type for Xterm-compatible terminals. +This updates the selected frame's terminal based on `cursor-type'." + (let ((buffer-cursor cursor-type) + (window-cursor (window-cursor-type)) + (frame-cursor (frame-parameter nil 'cursor-type)) + type) + ;; All of them can be conses, in which case the type symbol is the car. + (when (consp buffer-cursor) (setf buffer-cursor (car buffer-cursor))) + (when (consp window-cursor) (setf window-cursor (car window-cursor))) + (when (consp frame-cursor) (setf frame-cursor (car frame-cursor))) + + (cond + ((not (eq window-cursor t)) + (setf type window-cursor)) + ((not (eq buffer-cursor t)) + (setf type buffer-cursor)) + (t + (setf type frame-cursor))) + (xterm--set-cursor-type nil type))) + +(defun xterm--update-cursor-color () + "Update the cursor color for Xterm-compatible terminals. +This updates the selected frame's terminal based on the face `cursor'." + (let* ((color (color-values (face-background 'cursor))) + (r (nth 0 color)) + (g (nth 1 color)) + (b (nth 2 color))) + (send-string-to-terminal (format "\e]12;rgb:%04x/%04x/%04x\e\\" r g b)))) + (provide 'xterm) ;Backward compatibility. (provide 'term/xterm) ;;; xterm.el ends here From b07b3ae9f439c9fb18b09d5c33f160aca392a81d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 12:46:01 +0000 Subject: [PATCH 079/325] ; Fixes to last change. --- doc/emacs/display.texi | 12 ++++++------ lisp/term/xterm.el | 42 +++++++++++++++++------------------------- 2 files changed, 23 insertions(+), 31 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index d475fc3cfde..0cda594d5b1 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2063,14 +2063,14 @@ dimension), @code{hollow} (a hollow box), @code{bar} (a vertical bar), pixels tall), or @code{nil} (no cursor at all). @vindex xterm-update-cursor - On Xterm-compatible text terminals cursor customiztaion is controlled -by the user option @code{xterm-update-cursor}. Valid values are: + On Xterm-compatible text terminals cursor customization is controlled +by the user option @code{xterm-update-cursor}. Valid values are @code{t} to update the cursor's color and shape, @code{type} to update the cursor's shape only, @code{color} to update the cursor's color only, -and @code{nil} to not update the cursor's appearance. Xterm-compatible -text terminals can not display a hollow box and instead use a filled -box. Similarly, Xterm-compatible text terminals ignore the pixel sizes -for @code{bar} and @code{hbar}. +and @code{nil} to not update the cursor's appearance. Text terminals +can not display a hollow box and instead use a filled box. Similarly, +all text terminals ignore the pixel sizes for @code{bar} and +@code{hbar}. @findex hl-line-mode @findex global-hl-line-mode diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 47e82decb03..cc9d5101d52 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -81,7 +81,8 @@ capabilities, and only when that terminal understands bracketed paste." :type 'boolean) (defcustom xterm-update-cursor nil - "If non-nil, try to update the cursor's appearance on XTerm terminals. + "Whether to try to update cursor appearance on text terminals. +This works only for Xterm-compatible text terminals. If set to t all supported attributes of the cursor are updated. If set to `type' only the cursor type is updated. This uses the CSI @@ -1043,7 +1044,6 @@ We run the first FUNCTION whose STRING matches the input events." (defun xterm--post-command-hook () "Hook for xterm features that need to be frequently updated." - (unless (display-graphic-p) (when xterm-set-window-title (xterm-set-window-title)) @@ -1329,25 +1329,22 @@ versions of xterm." (defun xterm--init-update-cursor () "Register hooks to run `xterm--update-cursor-type' appropriately." - (when (memq xterm-update-cursor '(color t)) (xterm--query "\e]12;?\e\\" - '(("\e]12;" . (lambda () - (let ((str (xterm--read-string ?\e ?\\))) - ;; The response is specifically formated to set the - ;; color - (push - (concat "\e]12;" str "\e\\") - (terminal-parameter nil 'tty-mode-reset-strings))))))) - ;; No need to set tty-mode-set-strings because - ;; xterm--post-command-hook handles restoring the cursor color. + `(("\e]12;" . ,(lambda () + (let ((str (xterm--read-string ?\e ?\\))) + ;; The response is specifically formated to set the + ;; color + (push + (concat "\e]12;" str "\e\\") + (terminal-parameter nil 'tty-mode-reset-strings))))))) + ;; No need to set `tty-mode-set-strings' because + ;; `xterm--post-command-hook' handles restoring the cursor color. (xterm--update-cursor-color)) - (when (memq xterm-update-cursor '(type t)) (xterm--update-cursor-type)) - (add-hook 'post-command-hook 'xterm--post-command-hook)) (defconst xterm--cursor-type-to-int @@ -1357,13 +1354,11 @@ versions of xterm." bar 5 hbar 3) "Mapping of cursor type symbols to control sequence integers. - Cursor type symbols are the same as for `cursor-type'.") (defun xterm--set-cursor-type (terminal type) (let ((type-int (or (plist-get xterm--cursor-type-to-int type) 1)) (old (terminal-parameter terminal 'xterm--cursor-style))) - (when old (set-terminal-parameter terminal @@ -1376,7 +1371,6 @@ Cursor type symbols are the same as for `cursor-type'.") (unless old ;; Assume that the default cursor is appropriate when exiting Emacs. (push "\e[0 q" (terminal-parameter terminal 'tty-mode-reset-strings))) - (set-terminal-parameter terminal 'xterm--cursor-type type-int))) (defun xterm--update-cursor-type () @@ -1390,14 +1384,12 @@ This updates the selected frame's terminal based on `cursor-type'." (when (consp buffer-cursor) (setf buffer-cursor (car buffer-cursor))) (when (consp window-cursor) (setf window-cursor (car window-cursor))) (when (consp frame-cursor) (setf frame-cursor (car frame-cursor))) - - (cond - ((not (eq window-cursor t)) - (setf type window-cursor)) - ((not (eq buffer-cursor t)) - (setf type buffer-cursor)) - (t - (setf type frame-cursor))) + (cond ((not (eq window-cursor t)) + (setf type window-cursor)) + ((not (eq buffer-cursor t)) + (setf type buffer-cursor)) + (t + (setf type frame-cursor))) (xterm--set-cursor-type nil type))) (defun xterm--update-cursor-color () From 316fd1070242a48ab28c0e5223ca53486cc11e68 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 12:51:37 +0000 Subject: [PATCH 080/325] ; Spelling fix. --- lisp/term/xterm.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index cc9d5101d52..a91608b0f56 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -1334,8 +1334,8 @@ versions of xterm." "\e]12;?\e\\" `(("\e]12;" . ,(lambda () (let ((str (xterm--read-string ?\e ?\\))) - ;; The response is specifically formated to set the - ;; color + ;; The response is specifically formatted to set + ;; the color. (push (concat "\e]12;" str "\e\\") (terminal-parameter nil 'tty-mode-reset-strings))))))) From bdd9acb6aa3b7ef049b5aa4b8114e37476d0d6ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= Date: Fri, 2 Jan 2026 19:24:48 -0600 Subject: [PATCH 081/325] hideshow: Reword documentation (bug#80116) * etc/NEWS: Reword entry. * lisp/progmodes/hideshow.el: Reword Commentary Header. (hs-block-start-mdata-select, hs-block-end-regexp) (hs-c-start-regexp, hs-forward-sexp-function) (hs-adjust-block-beginning-function) (hs-adjust-block-end-function, hs-find-block-beginning-function) (hs-find-next-block-function) (hs-looking-at-block-start-predicate) (hs-inside-comment-predicate): Reword docstrings. (hs-block-positions): Reword docstring, and move 'hs-adjust-block-beginning-function' so that it is not affected by 'pos-eol'. (hs-find-block-beg-fn--default): Use 0 instead of 'hs-block-start-mdata-select'. * lisp/treesit.el (treesit-hs-find-block-beginning): Update code. --- etc/NEWS | 2 +- lisp/progmodes/hideshow.el | 131 ++++++++++++++++++++----------------- lisp/treesit.el | 4 +- 3 files changed, 73 insertions(+), 64 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 27aff3b7a1e..93d40a9d384 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1241,7 +1241,7 @@ buffer-local variables 'hs-block-start-regexp', 'hs-c-start-regexp', 'hs-forward-sexp-function', etc. +++ -*** 'hs-hide-level' and 'hs-cycle' can now hide comments too. +*** 'hs-hide-level' can now hide comments too. This is controlled by 'hs-hide-comments-when-hiding-all'. ** C-ts mode diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 0c665f2afdf..4f2942ee9e9 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -169,13 +169,25 @@ ;; These variables help hideshow know what is considered a block, which ;; function to use to get the block positions, etc. ;; -;; A block is defined as text surrounded by `hs-block-start-regexp' and -;; `hs-block-end-regexp'. +;; A (code) block is defined as text surrounded by +;; `hs-block-start-regexp' and `hs-block-end-regexp'. ;; ;; For some major modes, forward-sexp does not work properly. In those ;; cases, `hs-forward-sexp-function' specifies another function to use ;; instead. +;; *** Non-regexp matching +;; +;; By default, Hideshow uses regular expressions to match blocks. For +;; something more advanced than regexp is necessary to modify these +;; variables (see their docstring): +;; - `hs-forward-sexp-function' +;; - `hs-find-block-beginning-function' +;; - `hs-find-next-block-function' +;; - `hs-looking-at-block-start-predicate' +;; - `hs-inside-comment-predicate' (For comments) +;; - `hs-block-end-regexp' (Preferably, this should be set to nil) +;; ;; *** Tree-sitter support ;; ;; All the treesit based modes already have support for hiding/showing @@ -616,24 +628,26 @@ Note that `mode-line-format' is buffer-local.") (defvar-local hs-block-start-regexp "\\s(" "Regexp for beginning of block.") -;; This is useless, so probably should be deprecated. (defvar-local hs-block-start-mdata-select 0 "Element in `hs-block-start-regexp' match data to consider as block start. -The internal function `hs-forward-sexp' moves point to the beginning of this -element (using `match-beginning') before calling `hs-forward-sexp-function'.") +This is used by `hs-block-positions' to move point to the beginning of +this element (using `match-beginning') before calling +`hs-forward-sexp-function'. + +This is used for regexp matching.") (defvar-local hs-block-end-regexp "\\s)" "Regexp for end of block. -As a special case, the value can be also a function without arguments to -determine if point is looking at the end of the block, and return -non-nil and set `match-data' to that block end positions.") +This is mostly used to determine if point is at the end of the block. + +As a special case, it can be nil (to use the position from +`hs-forward-sexp-function'), or a function without arguments. If it's a +function, it should return non-nil if point is at end of a block, and +set `match-data' to that position.") (defvar-local hs-c-start-regexp nil "Regexp for beginning of comments. -Differs from mode-specific comment regexps in that surrounding -whitespace is stripped. - -If not bound, hideshow will use current `comment-start' value without +If not bound, Hideshow will use current `comment-start' value without any trailing whitespace.") (define-obsolete-variable-alias @@ -641,13 +655,13 @@ any trailing whitespace.") 'hs-forward-sexp-function "31.1") (defvar-local hs-forward-sexp-function #'forward-sexp - "Function used to do a `forward-sexp'. -It is called with 1 argument (like `forward-sexp'). + "Function used to reposition point to the end of the region to hide. +For backward compatibility, the function is called with one argument, +which can be ignored. -Should change for Algol-ish modes. For single-character block -delimiters such as `(' and `)' `hs-forward-sexp-function' would just be -`forward-sexp'. For other modes such as simula, a more specialized -function is necessary.") +The function is called in front of the beginning of the block (usually the +current value of `hs-block-start-regexp' in the buffer) and should +reposition point to the end of the block.") (define-obsolete-variable-alias 'hs-adjust-block-beginning @@ -655,22 +669,23 @@ function is necessary.") (defvar-local hs-adjust-block-beginning-function nil "Function used to tweak the block beginning. -It should return the position from where we should start hiding, as -opposed to hiding it from the position returned when searching for -`hs-block-start-regexp'. +It is called at the beginning of the block (usually the current value of +`hs-block-start-regexp' in the buffer) and should return the start +position of the region in the buffer that will be hidden. It is called with a single argument ARG which is the position in buffer after the block beginning.") (defvar-local hs-adjust-block-end-function nil "Function used to tweak the block end. +It is called at the end of the block with one argument, the start +position of the region in the buffer that will be hidden. It should +return either the last position to hide or nil. If it returns nil, +Hideshow will guess the end position. + This is useful to ensure some characters such as parenthesis or curly braces get properly hidden in modes without parenthesis pairs -delimiters (such as python). - -It is called with one argument, which is the start position where the -overlay will be created, and should return either the last position to -hide or nil. If it returns nil, hideshow will guess the end position.") +delimiters (such as python).") (define-obsolete-variable-alias 'hs-find-block-beginning-func @@ -679,13 +694,9 @@ hide or nil. If it returns nil, hideshow will guess the end position.") (defvar-local hs-find-block-beginning-function #'hs-find-block-beg-fn--default - "Function used to do `hs-find-block-beginning'. -It should reposition point at the beginning of the current block -and return point, or nil if original point was not in a block. - -Specifying this function is necessary for languages such as -Python, where regexp search and `syntax-ppss' check is not enough -to find the beginning of the current block.") + "Function used to reposition point at the beginning of current block. +If it finds the block beginning, it should reposition point there and +return non-nil, otherwise it should return nil.") (define-obsolete-variable-alias 'hs-find-next-block-func @@ -694,20 +705,20 @@ to find the beginning of the current block.") (defvar-local hs-find-next-block-function #'hs-find-next-block-fn--default - "Function used to do `hs-find-next-block'. + "Function to find the start of the next block. It should reposition point at next block start. -It is called with three arguments REGEXP, BOUND, and COMMENTS. REGEXP -is a regexp representing block start. When block start is found, -`match-data' should be set using REGEXP. BOUND is a buffer position -that limits the search. When COMMENTS is non-nil, REGEXP matches not -only beginning of a block but also beginning of a comment. In this -case, the function should find nearest block or comment and return -non-nil. +It is called with three arguments REGEXP, BOUND, and COMMENTS. -Specifying this function is necessary for languages such as Python, -where regexp search is not enough to find the beginning of the next -block.") +REGEXP is a regexp representing block start. When block start is found, +should set the match data according to the beginning position of the +matched REGEXP or block start position. + +BOUND is a buffer position that limits the search. + +When COMMENTS is non-nil, REGEXP matches not only beginning of a block +but also beginning of a comment. In this case, the function should find +the nearest block or comment and return non-nil.") (define-obsolete-variable-alias 'hs-looking-at-block-start-p-func @@ -716,16 +727,13 @@ block.") (defvar-local hs-looking-at-block-start-predicate #'hs-looking-at-block-start-p--default - "Function used to do `hs-looking-at-block-start-p'. -It should return non-nil if the point is at the block start and set -match data with the beginning and end of that position. - -Specifying this function is necessary for languages such as -Python, where `looking-at' and `syntax-ppss' check is not enough -to check if the point is at the block start.") + "Function used to check if point is at the block start. +It should return non-nil if point is at the block start and modify the +match data to the block beginning start and end positions (specifically, +for `match-end').") (defvar-local hs-inside-comment-predicate #'hs-inside-comment-p--default - "Function used to check if point is inside a comment. + "Function used to get comment positions. If point is inside a comment, the function should return a list containing the buffer position of the start and the end of the comment, otherwise it should return nil.") @@ -802,21 +810,24 @@ point. If either ADJUST-BEG or ADJUST-END are non-nil, adjust block positions according to `hs-adjust-block-beginning', `hs-adjust-block-end-function' -and `hs-block-end-regexp'." +and `hs-block-end-regexp'. + +This is for code block positions only, for comments use +`hs-inside-comment-predicate'." ;; `catch' is used here if the search fails due unbalanced parentheses ;; or any other unknown error caused in `hs-forward-sexp-function'. (catch 'hs--block-exit (save-match-data (save-excursion (when (funcall hs-looking-at-block-start-predicate) - (let ((beg (match-end 0)) end) - ;; `beg' is the point at the end of the block - ;; beginning, which may need to be adjusted + (let* ((beg (match-end 0)) end) + ;; `beg' is the point at the block beginning, which may need + ;; to be adjusted (when adjust-beg + (setq beg (pos-eol)) (save-excursion (when hs-adjust-block-beginning-function - (goto-char (funcall hs-adjust-block-beginning-function beg))) - (setq beg (pos-eol)))) + (goto-char (funcall hs-adjust-block-beginning-function beg))))) (goto-char (match-beginning hs-block-start-mdata-select)) (condition-case _ @@ -1146,7 +1157,7 @@ property of an overlay." (overlay-put ov 'invisible (and hide-p 'hs))) (defun hs-looking-at-block-start-p--default () - "Return non-nil if the point is at the block start." + "Return non-nil if point is at the block start." (and (looking-at hs-block-start-regexp) (save-match-data (not (nth 8 (syntax-ppss)))))) @@ -1262,7 +1273,7 @@ Return point, or nil if original point was not in a block." ;; look backward for the start of a block that contains the cursor (save-excursion (while (and (re-search-backward hs-block-start-regexp nil t) - (goto-char (match-beginning hs-block-start-mdata-select)) + (goto-char (match-beginning 0)) ;; go again if in a comment or a string (or (save-match-data (nth 8 (syntax-ppss))) (not (setq done (and (<= here (cadr (hs-block-positions))) diff --git a/lisp/treesit.el b/lisp/treesit.el index ee19606c1b2..3feaa51c0a6 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -4287,11 +4287,9 @@ For BOUND, MOVE, BACKWARD, LOOKING-AT, see the descriptions in "Tree-sitter implementation of `hs-find-block-beginning-function'." (let* ((pred (bound-and-true-p hs-treesit-things)) (thing (treesit-thing-at (point) pred)) - (beg (when thing (treesit-node-start thing))) - (end (when beg (min (1+ beg) (point-max))))) + (beg (when thing (treesit-node-start thing)))) (when thing (goto-char beg) - (set-match-data (list beg end)) t))) (defun treesit-hs-find-next-block (_regexp maxp comments) From f5ef8f9e8eb6ad19eaab11f4a2724cd6df7f6878 Mon Sep 17 00:00:00 2001 From: James Thomas Date: Mon, 15 Dec 2025 03:31:16 +0530 Subject: [PATCH 082/325] ; Doc fix: 'fileset-run-cmd' is not just for shell * doc/emacs/files.texi (Filesets): Fix wording (bug#80008). --- doc/emacs/files.texi | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 84d9c3b97ee..e3dc8d85441 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2771,10 +2771,14 @@ are shown in the Customize buffer. Remember to select @samp{Save for future sessions} if you want to use the same filesets in future Emacs sessions. +@findex filesets-open +@findex filesets-close +@findex filesets-run-cmd +@vindex filesets-commands You can use the command @kbd{M-x filesets-open} to visit all the files in a fileset, and @kbd{M-x filesets-close} to close them. Use -@kbd{M-x filesets-run-cmd} to run a shell command on all the files in -a fileset. These commands are also available from the @samp{Filesets} +@kbd{M-x filesets-run-cmd} to run a command (such as @code{multi-isearch-files} or @command{grep}) on all the files in +a fileset. These commands, which are specified in @code{filesets-commands}, are also available from the @samp{Filesets} menu, where each existing fileset is represented by a submenu. @xref{Version Control}, for a different concept of filesets: From ddd9fcb57c8a52535d8924c45b129f1c5ec0676b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 10 Jan 2026 15:28:17 +0200 Subject: [PATCH 083/325] ; * doc/emacs/files.texi (Filesets): Fix long lines. --- doc/emacs/files.texi | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index e3dc8d85441..567c1492518 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -2777,8 +2777,10 @@ sessions. @vindex filesets-commands You can use the command @kbd{M-x filesets-open} to visit all the files in a fileset, and @kbd{M-x filesets-close} to close them. Use -@kbd{M-x filesets-run-cmd} to run a command (such as @code{multi-isearch-files} or @command{grep}) on all the files in -a fileset. These commands, which are specified in @code{filesets-commands}, are also available from the @samp{Filesets} +@kbd{M-x filesets-run-cmd} to run a command (such as +@code{multi-isearch-files} or @command{grep}) on all the files in +a fileset. These commands, which are specified in +@code{filesets-commands}, are also available from the @samp{Filesets} menu, where each existing fileset is represented by a submenu. @xref{Version Control}, for a different concept of filesets: From e13642593276b25c5032ec9254aeb23feb2d313c Mon Sep 17 00:00:00 2001 From: pinmacs Date: Wed, 7 Jan 2026 22:09:40 +0100 Subject: [PATCH 084/325] ; * lisp/net/sieve-mode.el (sieve-indent-offset) Use the new 'sieve-indent-offset' customizable variable. Copyright-paperwork-exempt: yes --- lisp/net/sieve-mode.el | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index 1f2ac56d418..54bccc179aa 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -48,6 +48,13 @@ "Sieve." :group 'languages) +(defcustom sieve-indent-offset 2 + "Indentation offset for Sieve mode." + :type 'integer + :group 'sieve + :safe #'integerp + :version "31.1") + (defcustom sieve-mode-hook nil "Hook run in sieve mode buffers." :type 'hook) @@ -180,7 +187,7 @@ Turning on Sieve mode runs `sieve-mode-hook'." (let ((depth (car (syntax-ppss)))) (when (looking-at "[ \t]*}") (setq depth (1- depth))) - (indent-line-to (* 2 depth)))) + (indent-line-to (* sieve-indent-offset depth)))) ;; Skip to the end of the indentation if at the beginning of the ;; line. (when (save-excursion From 57df5d5cbaf88b21ad53152b145b5b0c8303951d Mon Sep 17 00:00:00 2001 From: "Jacob S. Gordon" Date: Thu, 8 Jan 2026 16:20:00 -0500 Subject: [PATCH 085/325] ; 'holiday-float': Improve documentation of edge case When MONTH DAY falls on DAYNAME the holiday may be closer to MONTH DAY than expected. Describe this situation in the function's doc string. (Bug#00000) * lisp/calendar/holidays.el (holiday-float): Improve documentation. --- lisp/calendar/holidays.el | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 3acaf9b91e2..696a5b50aa1 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -654,10 +654,17 @@ STRING)). Returns nil if it is not visible in the current calendar window." (defun holiday-float (month dayname n string &optional day) "Holiday called STRING on the Nth DAYNAME after/before MONTH DAY. -DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on. -If N>0, use the Nth DAYNAME after MONTH DAY. -If N<0, use the Nth DAYNAME before MONTH DAY. -DAY defaults to 1 if N>0, and MONTH's last day otherwise. +DAYNAME = 0 means Sunday, DAYNAME = 1 means Monday, and so on. DAY +defaults to 1 if N > 0, and MONTH's last day otherwise. + +If N > 0, use the Nth DAYNAME after MONTH DAY. +If N < 0, use the Nth DAYNAME before MONTH DAY. + +When MONTH DAY falls on DAYNAME, the holiday will be |N|-1 weeks before +or after MONTH DAY. For example, with N = +1 (-1) the holiday falls on +MONTH DAY, and with N = +2 (-2) the holiday falls 1 week after (before) +MONTH DAY. + If the holiday is visible in the calendar window, returns a list (((month day year) STRING)). Otherwise returns nil." ;; This is messy because the holiday may be visible, while the date From e5a8c4ae00cbd71ad14caeac627b9af49a0bb179 Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Tue, 30 Dec 2025 07:18:33 +0200 Subject: [PATCH 086/325] ; NS: Fix typo in -resetCursorRects implementations * src/nsterm.m ([EmacsView resetCursorRects]): Fix typo in selector name; restrict respondsToSelector: check to Cocoa. ([EmacsScroller resetCursorRects]): Likewise. (Bug#80098) --- src/nsterm.m | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index f96096242d2..0e8738d7c1b 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7058,8 +7058,8 @@ - (void)resetCursorRects [self addCursorRect: visible cursor: currentCursor]; #if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101300 -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 - if ([currentCursor respondsToSelector: @selector(setOnMouseEntered)]) +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 + if ([currentCursor respondsToSelector: @selector(setOnMouseEntered:)]) #endif [currentCursor setOnMouseEntered: YES]; #endif @@ -10539,9 +10539,9 @@ - (void)resetCursorRects [self addCursorRect: visible cursor: [NSCursor arrowCursor]]; #if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 101300 -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101300 if ([[NSCursor arrowCursor] respondsToSelector: - @selector(setOnMouseEntered)]) + @selector(setOnMouseEntered:)]) #endif [[NSCursor arrowCursor] setOnMouseEntered: YES]; #endif From 0bb36ec255071afee2bdf8928290f47ee0e3d7ab Mon Sep 17 00:00:00 2001 From: JD Smith Date: Sat, 10 Jan 2026 15:25:02 -0500 Subject: [PATCH 087/325] Limit yanks to a single set of modification hook calls * lisp/subr.el (insert-for-yank-1): Locally set `inhibit-modification-hooks' to t prior to changing yanked text properties. Bug#77221 --- lisp/subr.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 4ae3647b7d4..e9a8623595b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4837,6 +4837,7 @@ It also runs the string through `yank-transform-functions'." (param (or (nth 1 handler) string)) (opoint (point)) (inhibit-read-only inhibit-read-only) + (inhibit-modification-hooks inhibit-modification-hooks) end) ;; FIXME: This throws away any yank-undo-function set by previous calls @@ -4847,9 +4848,10 @@ It also runs the string through `yank-transform-functions'." (insert param)) (setq end (point)) - ;; Prevent read-only properties from interfering with the - ;; following text property changes. - (setq inhibit-read-only t) + ;; Prevent read-only properties from interfering with the following + ;; text property changes, and inhibit further modification hook + ;; calls. + (setq inhibit-read-only t inhibit-modification-hooks t) (unless (nth 2 handler) ; NOEXCLUDE (remove-yank-excluded-properties opoint end)) From b26e9bb6bc7c0f6330dc67c365e45232ddb54368 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 8 Jan 2026 09:01:21 +0000 Subject: [PATCH 088/325] Jsonrpc: add major mode for events buffers If the 'jq' program is installed, this dramatically simplifies debugging LSP transcripts. * lisp/jsonrpc.el (jsonrpc-events-jq-at-point): New function. (jsonrpc-events-occur-at-point): New function. (jsonrpc-events-mode-map): New variable. (jsonrpc-events-mode): New major mode. (jsonrpc-events-buffer): Use new mode. --- lisp/jsonrpc.el | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index d7bba4e389c..955a4f89009 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -208,6 +208,34 @@ JSONRPC message." "jsonrpc-lambda-elem"))) `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e)))) +(defun jsonrpc-events-jq-at-point () + "Find first { in line, use forward-sexp to grab JSON, pipe through jq." + (interactive) + (save-excursion + (beginning-of-line) + (when (search-forward "{" (line-end-position) t) + (backward-char) + (let ((start (point))) + (forward-sexp) + (shell-command-on-region start (point) "jq" "*jq output*"))))) + +(defun jsonrpc-events-occur-at-point () + "Run occur on thing at point." + (interactive) + (occur (thing-at-point 'symbol))) + +(defvar jsonrpc-events-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'jsonrpc-events-jq-at-point) + (define-key map (kbd "C-c C-o") 'jsonrpc-events-occur-at-point) + map) + "Keymap for `jsonrpc-events-mode'.") + +(define-derived-mode jsonrpc-events-mode special-mode "JSONRPC-Events" + "Major mode for JSONRPC events buffers." + (buffer-disable-undo) + (setq buffer-read-only t)) + (defun jsonrpc-events-buffer (connection) "Get or create JSONRPC events buffer for CONNECTION." (let ((probe (jsonrpc--events-buffer connection))) @@ -215,8 +243,7 @@ JSONRPC message." probe (with-current-buffer (get-buffer-create (format "*%s events*" (jsonrpc-name connection))) - (buffer-disable-undo) - (setq buffer-read-only t) + (jsonrpc-events-mode) (setf (jsonrpc--events-buffer connection) (current-buffer)))))) From cc5ebad8410a0523509ac0e8d23eb96ab43bef0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 9 Jan 2026 11:22:51 +0000 Subject: [PATCH 089/325] Flymake: clarify :region in docstring of f-diagnostic-functions * lisp/progmodes/flymake.el (flymake-diagnostic-functions): Clarify meaning of :region. Re-fill docstring. --- lisp/progmodes/flymake.el | 110 +++++++++++++++++++------------------- 1 file changed, 54 insertions(+), 56 deletions(-) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index ec71f353ee3..f73bdadef72 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -695,12 +695,12 @@ region is invalid. This function saves match data." (defvar flymake-diagnostic-functions nil "Special hook of Flymake backends that check a buffer. -The functions in this hook diagnose problems in a buffer's -contents and provide information to the Flymake user interface -about where and how to annotate problems diagnosed in a buffer. +The functions in this hook diagnose problems in a buffer's contents and +provide information to the Flymake user interface about where and how to +annotate problems diagnosed in a buffer. -Each backend function must be prepared to accept an arbitrary -number of arguments: +Each backend function must be prepared to accept an arbitrary number of +arguments: * the first argument is always REPORT-FN, a callback function detailed below; @@ -710,74 +710,72 @@ number of arguments: Currently, Flymake may provide these keyword-value pairs: -* `:recent-changes', a list of recent changes since the last time - the backend function was called for the buffer. An empty list - indicates that no changes have been recorded. If it is the - first time that this backend function is called for this - activation of `flymake-mode', then this argument isn't provided - at all (i.e. it's not merely nil). +* `:recent-changes', a list of recent changes since the last time the + backend function was called for the buffer. An empty list indicates + that no changes have been recorded. If it is the first time that this + backend function is called for this activation of `flymake-mode', then + this argument isn't provided at all (i.e. it's not merely nil). - Each element is in the form (BEG END TEXT) where BEG and END - are buffer positions, and TEXT is a string containing the text - contained between those positions (if any) after the change was - performed. + Each element is in the form (BEG END TEXT) where BEG and END are + buffer positions, and TEXT is a string containing the text contained + between those positions (if any) after the change was performed. -* `:changes-start' and `:changes-end', the minimum and maximum - buffer positions touched by the recent changes. These are only - provided if `:recent-changes' is also provided. +* `:changes-start' and `:changes-end', the minimum and maximum buffer + positions touched by the recent changes. These are only provided if + `:recent-changes' is also provided. -Whenever Flymake or the user decides to re-check the buffer, -backend functions are called as detailed above and are expected -to initiate this check, but aren't required to complete it before -exiting: if the computation involved is expensive, especially for -large buffers, that task can be scheduled for the future using -asynchronous processes or other asynchronous mechanisms. +Whenever Flymake or the user decides to re-check the buffer, backend +functions are called as detailed above and are expected to initiate this +check, but aren't required to complete it before exiting: if the +computation involved is expensive, especially for large buffers, that +task can be scheduled for the future using asynchronous processes or +other asynchronous mechanisms. -In any case, backend functions are expected to return quickly or -signal an error, in which case the backend is disabled. Flymake -will not try disabled backends again for any future checks of -this buffer. To reset the list of disabled backends, turn -`flymake-mode' off and on again, or interactively call -`flymake-start' with a prefix argument. +In any case, backend functions are expected to return quickly or signal +an error, in which case the backend is disabled. Flymake will not try +disabled backends again for any future checks of this buffer. To reset +the list of disabled backends, turn `flymake-mode' off and on again, or +interactively call `flymake-start' with a prefix argument. If the function returns, Flymake considers the backend to be -\"running\". If it has not done so already, the backend is -expected to call the function REPORT-FN with a single argument -REPORT-ACTION also followed by an optional list of keyword-value -pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...). +\"running\". If it has not done so already, the backend is expected to +call the function REPORT-FN with a single argument REPORT-ACTION also +followed by an optional list of keyword-value pairs in the +form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...). Currently accepted values for REPORT-ACTION are: * A (possibly empty) list of diagnostic objects created with - `flymake-make-diagnostic', causing Flymake to delete all - previous diagnostic annotations in the buffer and create new - ones from this list. + `flymake-make-diagnostic', causing Flymake to delete all previous + diagnostic annotations in the buffer and create new ones from this + list. - A backend may call REPORT-FN repeatedly in this manner, but - only until Flymake considers that the most recently requested - buffer check is now obsolete because, say, buffer contents have - changed in the meantime. The backend is only given notice of - this via a renewed call to the backend function. Thus, to - prevent making obsolete reports and wasting resources, backend - functions should first cancel any ongoing processing from - previous calls. + A backend may call REPORT-FN repeatedly in this manner, but only until + Flymake considers that the most recently requested buffer check is now + obsolete because, say, buffer contents have changed in the meantime. + The backend is only given notice of this via a renewed call to the + backend function. Thus, to prevent making obsolete reports and + wasting resources, backend functions should first cancel any ongoing + processing from previous calls. -* The symbol `:panic', signaling that the backend has encountered - an exceptional situation and should be disabled. +* The symbol `:panic', signaling that the backend has encountered an + exceptional situation and should be disabled. Currently accepted REPORT-KEY arguments are: -* `:explanation' value should give user-readable details of - the situation encountered, if any. +* `:explanation' value should give user-readable details of the + situation encountered, if any. -* `:force': value should be a boolean suggesting that Flymake - consider the report even if it was somehow unexpected. +* `:force': value should be a boolean suggesting that Flymake consider + the report even if it was somehow unexpected. -* `:region': a cons (BEG . END) of buffer positions indicating - that the report applies to that region only. Specifically, - this means that Flymake will only delete diagnostic annotations - of past reports if they intersect the region by at least one - character.") +* `:region': a cons (BEG . END) of buffer positions specifying that + Flymake should only delete diagnostic annotations of past reports if + they intersect the region by at least one character. The list of + diagnostics objects in the report need not be contained in the region. + This makes it allows backends to choose between accumulating or + completely replacing diagnostics across different invocations of + REPORT-FN, by specifying a either 0-length region or the full buffer.") (put 'flymake-diagnostic-functions 'safe-local-variable #'null) From 6921244718522b27461b06cca7b29e187861f46f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 9 Jan 2026 11:09:21 +0000 Subject: [PATCH 090/325] Eglot: document LSP server multiplexer support This documents how to use LSP multiplexer programs like Rassumfrassum to connect multiple language servers to a single buffer. * doc/misc/eglot.texi (Top): Add "Multi-server support" menu entry. (Multi-server support): New chapter. (Using Rassumfrassum, Design rationale): New sections documenting how to use the Rassumfrassum multiplexer program with Eglot, with practical examples for C++, Python, and multi-language files. (Performance): Mention Rassumfrassum as solution for JSONRPC traffic performance issues. (Reporting bugs): Add guidance for troubleshooting multiplexer-related bugs. Improve project description guidance. Fix various typos. * lisp/progmodes/eglot.el (eglot-server-programs): Add a couple of rass entries. * etc/EGLOT-NEWS: Announce support for LSP server multiplexers via Rassumfrassum. --- doc/misc/eglot.texi | 181 +++++++++++++++++++++++++++++++++++++--- etc/EGLOT-NEWS | 14 ++++ lisp/progmodes/eglot.el | 9 +- 3 files changed, 190 insertions(+), 14 deletions(-) diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 532416f17ad..579c568f264 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -99,6 +99,7 @@ read this manual from within Emacs, type @kbd{M-x eglot-manual * Using Eglot:: Important Eglot commands and variables. * Customizing Eglot:: Eglot customization and advanced features. * Advanced server configuration:: Fine-tune a specific language server +* Multi-server support:: Use more than one server in a buffer * Extending Eglot:: Writing Eglot extensions in Elisp * Troubleshooting Eglot:: Troubleshooting and reporting bugs. * GNU Free Documentation License:: The license for this manual. @@ -1511,6 +1512,152 @@ is serialized by Eglot to the following JSON text: @} @end example +@node Multi-server support +@chapter Multi-server support +@cindex multiple servers per buffer +@cindex LSP server multiplexer +@cindex per-buffer multiple servers + +One of the most frequently requested features for Eglot in close to a +decade of existence is the ability to use more than one LSP server in a +single buffer. This is distinct from using multiple servers in a +project, where each server manages a disjoint set of files written in +different languages. + +The latter case---multiple servers for different files---is +intrinsically supported by Eglot. For example, in a web project with +JavaScript, CSS, and Python files, Eglot can seamlessly manage separate +language servers for each file type within the same project +(@pxref{Starting Eglot}). Each buffer communicates with its appropriate +server, and this works out-of-the-box. + +However, there are several scenarios where multiple servers per buffer +are useful: + +@itemize @bullet +@item +Combining a spell-checking language server like @command{codebook-lsp} +with language-specific servers for C++, Go, or Python files. The +spell-checker provides diagnostics for comments and strings, while the +language server handles syntax and semantics. + +@item +One might want multiple servers to cover different aspects of the same +language. For Python, you might combine @command{ty} for type checking +with @command{ruff} for linting and formatting. For JavaScript, you +might use @command{typescript-language-server} for language features +together with @command{eslint} for linting. + +@item +When working on multi-language files like Vue @file{.vue} files, which +contain JavaScript, CSS, and HTML embedded in a single file, multiple +servers can manage the different areas of the buffer. +@end itemize + +These use cases are not directly supported by Eglot's architecture, +however, you can use a language-agnostic @dfn{LSP server multiplexer} +that sits between Eglot and the actual language servers. Eglot still +communicates with a single LSP server process in each buffer, but that +process mediates communication to multiple language-specific servers, +meaning that for practical purposes, it's @emph{as if} Eglot was +connected to them directly. + +This approach is more powerful and user-friendly than current +workarounds that combine one LSP server in a buffer with additional +non-LSP mechanisms such as extra Flymake backends (@pxref{Top,,, +Flymake, GNU Flymake manual}) for the same buffer. + +@menu +* Using Rassumfrassum:: Setup the @code{rass} LSP multiplexer +* Design rationale:: Benefits and drawbacks of LSP multiplexers +@end menu + +@node Using Rassumfrassum +@section Using Rassumfrassum + +@uref{https://github.com/joaotavora/rassumfrassum, Rassumfrassum} is an +LSP server multiplexer program that fits the bill. Like most language +servers, it must be installed separately since it is not bundled with +Emacs (at time of writing). The installation is similar to installing +any other language server, and usually amounts to making sure the +program executable is somewhere in @code{PATH} or @code{exec-path}. + +The Rassumfrassum program, invoked via the @command{rass} command, works +by spawning multiple LSP server subprocesses and aggregating their +capabilities, requests, and responses into a single unified LSP +interface. From Eglot's perspective, it appears to be communicating with +a single server. + +To use Rassumfrassum with Eglot, you can start it interactively with a +prefix argument to @code{eglot} and specify the @command{rass} command +followed by the actual servers you want to use, separated by @code{--}: + +@example +C-u M-x eglot RET rass -- clangd -- codebook-lsp serve RET +@end example + +@noindent +This starts @command{clangd} for C++ language support and +@command{codebook-lsp} for spell-checking in the same buffer. + +For Python, you might use: + +@example +C-u M-x eglot RET rass -- ty server -- ruff server RET +@end example + +@noindent +or simply @kbd{C-u M-x eglot RET rass python}, using the ``preset'' +feature. This combines @command{ty} for type checking with +@command{ruff} for linting and formatting. + +These configurations can be integrated into the +@code{eglot-server-programs} variable (@pxref{Setting Up LSP Servers}) +for automatic use: + +@lisp +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + '(c-ts-base-mode . ("rass" "--" "clangd" "--" + "codebook-lsp" "serve"))) + (add-to-list 'eglot-server-programs + '(python-mode . ("rass" "--" "ty" "server" "--" + "ruff" "server")))) +@end lisp + +@node Design rationale +@section Design rationale + +Using an LSP server multiplexer like @command{rass} relieves Eglot from +knowing about the specific characteristics of individual servers and the +complexity of managing multiple simultaneous server connections per +buffer. This helps preserve the essential features that distinguish +Eglot's code base from other LSP offers for Emacs: simple, performant +and mindful of the core tenet of LSP, which is for a client to be +language-agnostic. + +This approach has an additional benefit: because the multiplexer +mediates all communication between Eglot and the servers, it can take +advantage of different optimization opportunities. For instance, at the +system level it may be multi-threaded to process different JSONRPC +streams in with true parallelism, something which is currently +impossible to do in plain Elisp. At the LSP-level it can merge server +responses intelligently, truncate unnecessarily large objects, and cache +significant amounts of information in efficient ways. In many cases, +this can reduce the amount of JSONRPC traffic exchanged with Emacs to +levels well below what would occur if a client connected to multiple +servers separately. Some of these optimizations may apply even when a +program like @command{rass} is mediating communication to a single +server. + +The multiplexer approach is not without drawbacks. Since LSP is a +relatively large protocol with a decade of existence and many backward +compatibility concerns, combining the responses of servers using completely +different mechanisms of the protocol to respond to the same request +sometimes leads to complexity in covering the corner cases. However, +offloading this complexity to a completely separate layer has proven +very effective in practice. + @node Extending Eglot @chapter Extending Eglot @@ -1687,9 +1834,13 @@ slowly, try to customize the variable @code{eglot-events-buffer-config} 0. This will disable recording any events and may speed things up. In other situations, the cause of poor performance lies in the language -server itself. Servers use aggressive caching and other techniques to -improve their performance. Often, this can be tweaked by changing the -server configuration (@pxref{Advanced server configuration}). +server itself. Some servers use aggressive caching and other techniques +to improve their performance. Often, this can be tweaked by changing +the server configuration (@pxref{Advanced server configuration}). + +Another aspect that may cause performance degradation is the amount of +JSONRPC information exchanged with Emacs. Using an LSP program like +@ref{Using Rassumfrassum,Rassumfrassum} may alleviate such problems. @node Getting the latest version @section Getting the latest version @@ -1751,10 +1902,17 @@ may be using. If possible, try to replicate the problem with the C/C@t{++} or Python servers, as these are very easy to install. @item -Describe how to setup a @emph{minimal} project directory where Eglot +If using an LSP multiplexer server like @ref{Using Rassumfrassum, +Rassumfrassum}, first verify if the program replicates by using one of +the multiplexed servers directly. If it doesn't the problem lies in the +LSP multiplexer program and should be reported there. + +@item +Include a description of a @emph{minimal} project directory where Eglot should be started for the problem to happen. Describe each file's name -and its contents. Alternatively, you can supply the address of a public -Git repository. +and its contents, or---sometimes better--- zip that project directory +completely and attach it. Alternatively, you can supply the address of +a public Git repository. @item Include versions of the software used. The Emacs version can be @@ -1767,12 +1925,13 @@ first check if the problem isn't already fixed in the latest version It's also essential to include the version of ELPA packages that are explicitly or implicitly loaded. The optional but popular Company or Markdown packages are distributed as GNU ELPA packages, not to mention -Eglot itself in some situations. Some major modes (Go, Rust, etc.) are -provided by ELPA packages. It's sometimes easy to miss these, since -they are usually implicitly loaded when visiting a file in that -language. +Eglot itself in some situations. Prefer reproducing the problem with +built-in Treesit major modes like @code{go-ts-mode} or +@code{rust-ts-mode} since the non-ts modes for such languages are +usually provided by ELPA packages, and it's often easy to miss them. -ELPA packages usually live in @code{~/.emacs.d/elpa} (or what is in +If you can't reproduce your bug without ELPA packages, you may find the +ones you're using in @code{~/.emacs.d/elpa} (or what is in @code{package-user-dir}). Including a listing of files in that directory is a way to tell the maintainers about ELPA package versions. diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 9c7786f09b9..8735e966ee9 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,20 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes to upcoming Eglot +** Support for LSP server multiplexers via Rassumfrassum + +Eglot can now leverage LSP server multiplexer programs like Rassumfrassum +(invoked via the 'rass' command) to use multiple language servers in a +single buffer. This enables combining spell-checkers with language +servers, using multiple servers for the same language (e.g., 'ty' for +type checking and 'ruff' for linting in Python), or handling +multi-language files like Vue. + +Some invocations of 'rass' are offered as alternatives in the built-in +'eglot-server-programs' variable. The manual (readable with 'M-x +eglot-manual') contains a comprehensive discussion of how to set up and +use multiplexers in the new "Multi-server support" chapter. + ** Support for pull diagnostics (github#1559, github#1290) For servers supporting the 'diagnosticProvider' capability, Eglot diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8be3a459b95..b6c4d5b7a89 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -238,7 +238,7 @@ automatically)." (defvar eglot-server-programs ;; FIXME: Maybe this info should be distributed into the major modes ;; themselves where they could set a buffer-local `eglot-server-program' - ;; instead of keeping this database centralized. + ;; which would allow deprecating this database. ;; FIXME: With `derived-mode-add-parents' in Emacs≥30, some of ;; those entries can be simplified, but we keep them for when ;; `eglot.el' is installed via GNU ELPA in an older Emacs. @@ -248,7 +248,8 @@ automatically)." (vimrc-mode . ("vim-language-server" "--stdio")) ((python-mode python-ts-mode) . ,(eglot-alternatives - '("pylsp" "pyls" ("basedpyright-langserver" "--stdio") + '(("rass" "python") + "pylsp" "pyls" ("basedpyright-langserver" "--stdio") ("pyright-langserver" "--stdio") ("pyrefly" "lsp") ("ty" "server") @@ -262,7 +263,9 @@ automatically)." (tsx-ts-mode :language-id "typescriptreact") (typescript-ts-mode :language-id "typescript") (typescript-mode :language-id "typescript")) - . ("typescript-language-server" "--stdio")) + . ,(eglot-alternatives + '(("rass ts") + ("typescript-language-server" "--stdio")))) ((bash-ts-mode sh-mode) . ("bash-language-server" "start")) ((php-mode phps-mode php-ts-mode) . ,(eglot-alternatives From 89633fef71286b9f50585ec95f883de7041b4be7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 10 Jan 2026 17:10:38 +0000 Subject: [PATCH 091/325] Eglot: rework Flymake integration ahead of more changes LSP Diagnostics are converted to Flymake diagnostics just-in-time. Introduce helpers that allow precise control over the type of the reports (clearing or incremental) and the inhibition of reports. * lisp/progmodes/eglot.el (eglot--pulled-diagnostics) (eglot--pushed-diagnostics): Rework docstring. (eglot--flymake-sniff-diagnostics): Rename from eglot--flymake-diagnostics. (eglot--diagnostics-map, cl-loop, eglot-warning) (eglot-note, eglot-error): Move to Flymake section. (eglot--find-buffer-visiting): New helper.. (eglot--flymake-handle-push): New helper. (eglot--flymake-report-1, eglot--flymake-report-2) (eglot--flymake-report-push+pulled): New helpers. (eglot--flymake-make-diag): Take REGION arg. (eglot--handle-notification): Use eglot--flymake-handle-push. (eglot--flymake-pull): Call eglot--flymake-report-push+pulled. (eglot--flymake-report): Delete. (eglot--flymake-reset): New helper. (eglot--managed-mode): Use eglot--flymake-reset. (eglot--diag-to-lsp-diag): Delete. (eglot--signal-textDocument/didOpen) (eglot--managed-mode): Use eglot--flymake-reset. (eglot--maybe-activate-editing-mode): Don't reset Flymake things here. (eglot--code-action-params): Tweak. (eglot--code-action-bounds): Use eglot--flymake-sniff-diagnostics. (eglot--capf-session-flush): Tweak. --- lisp/progmodes/eglot.el | 321 +++++++++++++++++++++++----------------- 1 file changed, 182 insertions(+), 139 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b6c4d5b7a89..a4440235cbe 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2227,15 +2227,16 @@ Use `eglot-managed-p' to determine if current buffer is managed.") (defvar eglot--highlights nil "Overlays for `eglot-highlight-eldoc-function'.") (defvar-local eglot--pulled-diagnostics nil - "A list (DIAGNOSTICS RESULT-ID) \"pulled\" for current buffer. -DIAGNOSTICS is a list of Flymake diagnostics objects. RESULT-ID -identifies this diagnostic result as is used for incremental updates.") + "A list (DIAGNOSTICS VERSION RESULT-ID) \"pulled\" for current buffer. +DIAGNOSTICS is a sequence of LSP or Flymake diagnostics objects. +RESULT-ID identifies this diagnostic result as is used for incremental +updates.") (defvar-local eglot--pushed-diagnostics nil "A list (DIAGNOSTICS VERSION) \"pushed\" for current buffer. -DIAGNOSTICS is a list of Flymake diagnostics objects. VERSION is the -LSP Document version reported for DIAGNOSTICS (comparable to -`eglot--docver') or nil if server didn't bother.") +DIAGNOSTICS is a sequence of LSP or Flymake diagnostics objects. +VERSION is the LSP Document version reported for DIAGNOSTICS (comparable +to `eglot--docver') or nil if server didn't bother.") (defvar-local eglot--suggestion-overlay (make-overlay 0 0) "Overlay for `eglot-code-action-suggestion'.") @@ -2316,11 +2317,8 @@ LSP Document version reported for DIAGNOSTICS (comparable to (cl-loop for (var . saved-binding) in eglot--saved-bindings do (set (make-local-variable var) saved-binding)) (remove-function (local 'imenu-create-index-function) #'eglot-imenu) - (when eglot--flymake-report-fn - (setq eglot--pulled-diagnostics nil - eglot--pushed-diagnostics nil) - (eglot--flymake-report) - (setq eglot--flymake-report-fn nil)) + (eglot--flymake-reset) + (setq eglot--flymake-report-fn nil) (run-hooks 'eglot-managed-mode-hook) (let ((server eglot--cached-server)) (setq eglot--cached-server nil) @@ -2373,8 +2371,6 @@ If it is activated, also signal textDocument/didOpen." ;; Called when `revert-buffer-in-progress-p' is t but ;; `revert-buffer-preserve-modes' is nil. (when (and buffer-file-name (eglot-current-server)) - (setq eglot--pulled-diagnostics nil - eglot--pushed-diagnostics nil) (eglot--managed-mode) (eglot--signal-textDocument/didOpen) ;; Run user hook after 'textDocument/didOpen' so server knows @@ -2643,40 +2639,6 @@ still unanswered LSP requests to the server\n")))) when rest concat (if titlep ":" "/"))))) "] "))) - -;;; Flymake customization -;;; -(put 'eglot-note 'flymake-category 'flymake-note) -(put 'eglot-warning 'flymake-category 'flymake-warning) -(put 'eglot-error 'flymake-category 'flymake-error) - -(defun eglot--flymake-diagnostics (beg &optional end) - "Like `flymake-diagnostics', but for Eglot-specific diagnostics." - (cl-loop for diag in (flymake-diagnostics beg end) - for data = (flymake-diagnostic-data diag) - for lsp-diag = (alist-get 'eglot-lsp-diag data) - for version = (alist-get 'eglot--doc-version data) - when (and lsp-diag (or (null version) - (= version eglot--docver))) - collect diag)) - -(defun eglot--diag-to-lsp-diag (diag) - (alist-get 'eglot-lsp-diag (flymake-diagnostic-data diag))) - -(defvar eglot-diagnostics-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'eglot-code-actions-at-mouse) - (define-key map [left-margin mouse-1] #'eglot-code-actions-at-mouse) - map) - "Keymap active in Eglot-backed Flymake diagnostic overlays.") - -(cl-loop for i from 1 - for type in '(eglot-note eglot-warning eglot-error) - do (put type 'flymake-overlay-control - `((mouse-face . highlight) - (priority . ,(+ 50 i)) - (keymap . ,eglot-diagnostics-map)))) - ;;; Protocol implementation (Requests, notifications, etc) ;;; @@ -2765,56 +2727,6 @@ Value is (TRUENAME . (:uri STR)), where STR is what is sent to the server on textDocument/didOpen and similar calls. TRUENAME is the expensive cached value of `file-truename'.") -(cl-defmethod eglot-handle-notification - (server (_method (eql textDocument/publishDiagnostics)) - &key uri diagnostics version - &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode' - "Handle notification publishDiagnostics." - (cl-flet ((find-it (abspath) - ;; `find-buffer-visiting' would be natural, but calls the - ;; potentially slow `file-truename' (bug#70036). - (cl-loop for b in (eglot--managed-buffers server) - when (with-current-buffer b - (equal (car eglot--TextDocumentIdentifier-cache) - abspath)) - return b))) - (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) - (buffer (find-it path))) - (with-current-buffer buffer - (cl-loop - initially - (if (and version (/= version eglot--docver)) - (cl-return)) - (setq - ;; if no explicit version received, assume it's current. - version eglot--docver - flymake-list-only-diagnostics - (assoc-delete-all path flymake-list-only-diagnostics)) - for diag-spec across diagnostics - collect (eglot--flymake-make-diag diag-spec version) - into diags - finally - (setq eglot--pushed-diagnostics (list diags version)) - (when (not (null flymake-no-changes-timeout )) - ;; only add to current report if Flymake - ;; starts on idle-timer (github#957) - (eglot--flymake-report)))) - (cl-loop - for diag-spec across diagnostics - collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec - (let* ((start (plist-get range :start)) - (line (1+ (plist-get start :line))) - (char (1+ (plist-get start :character)))) - (flymake-make-diagnostic - path (cons line char) nil - (eglot--flymake-diag-type severity) - (list source code message)))) - into diags - finally - (setq flymake-list-only-diagnostics - (assoc-delete-all path flymake-list-only-diagnostics)) - (push (cons path diags) flymake-list-only-diagnostics))))) - (cl-defun eglot--register-unregister (server things how) "Helper for `registerCapability'. THINGS are either registrations or unregisterations (sic)." @@ -3155,6 +3067,7 @@ When called interactively, use the currently active server" (setq eglot--recent-changes nil eglot--docver 0 eglot--TextDocumentIdentifier-cache nil) + (eglot--flymake-reset) (jsonrpc-notify (eglot--current-server-or-lose) :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem)))) @@ -3192,6 +3105,80 @@ When called interactively, use the currently active server" :text (buffer-substring-no-properties (point-min) (point-max)) :textDocument (eglot--TextDocumentIdentifier))))) +(defun eglot--find-buffer-visiting (server abspath) + ;; `find-buffer-visiting' would be natural, but calls the + ;; potentially slow `file-truename' (bug#70036). + (cl-loop for b in (eglot--managed-buffers server) + when (with-current-buffer b + (equal (car eglot--TextDocumentIdentifier-cache) + abspath)) + return b)) + + +;;; Flymake integration + +(put 'eglot-note 'flymake-category 'flymake-note) +(put 'eglot-warning 'flymake-category 'flymake-warning) +(put 'eglot-error 'flymake-category 'flymake-error) + +(defvar eglot-diagnostics-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'eglot-code-actions-at-mouse) + (define-key map [left-margin mouse-1] #'eglot-code-actions-at-mouse) + map) + "Keymap active in Eglot-backed Flymake diagnostic overlays.") + +(cl-loop for i from 1 + for type in '(eglot-note eglot-warning eglot-error) + do (put type 'flymake-overlay-control + `((mouse-face . highlight) + (priority . ,(+ 50 i)) + (keymap . ,eglot-diagnostics-map)))) + +(defun eglot--flymake-sniff-diagnostics (beg &optional end) + "Like `flymake-diagnostics', but for Eglot-specific diagnostics." + (cl-loop for diag in (flymake-diagnostics beg end) + for data = (flymake-diagnostic-data diag) + for lsp-diag = (alist-get 'eglot-lsp-diag data) + for version = (alist-get 'eglot--doc-version data) + when (and lsp-diag (or (null version) + (= version eglot--docver))) + collect diag)) + +(cl-defmacro eglot--flymake-report-1 (diags mode &key (version 'eglot--docver) force) + "Maybe convert, report and store the diagnostics objects DIAGS. +DIAGS is either a vector of LSP diagnostics or a list of Flymake +diagnostics. MODE can be `:stay' or `:clear' depending on whether we +want to accumulate or reset diagnostics in the buffer. VERSION is the +version the diagnostics pertain to." + ;; JT@2026-01-10: criteria for "incremental" reports could be + ;; tightened to e.g. check eglot--capf-session nillness, but we'd have + ;; to schedule an after-session re-report, and that's way too complex + `(when (and (or ,force flymake-no-changes-timeout) + eglot--flymake-report-fn) + (when (and ,diags (vectorp ,diags)) + (setf ,diags + (cl-loop + for d across ,diags + collect (eglot--flymake-make-diag + d + ,version (eglot-range-region (plist-get d :range)))))) + (eglot--flymake-report-2 ,diags ,mode))) + +(cl-defmethod eglot-handle-notification + (server (_method (eql textDocument/publishDiagnostics)) + &key uri diagnostics version + &allow-other-keys) + "Handle notification publishDiagnostics." + (eglot--flymake-handle-push + server uri diagnostics version + (lambda (diags) + (setq eglot--pushed-diagnostics (list diags eglot--docver)) + (when (not (null flymake-no-changes-timeout )) + ;; only add to current report if Flymake + ;; starts on idle-timer (github#957) + (eglot--flymake-report-push+pulled))))) + (defun eglot--flymake-diag-type (severity) "Convert LSP diagnostic SEVERITY to Eglot/Flymake diagnostic type." (cond ((null severity) 'eglot-error) @@ -3199,13 +3186,14 @@ When called interactively, use the currently active server" ((= severity 2) 'eglot-warning) (t 'eglot-note))) -(defun eglot--flymake-make-diag (diag-spec version) +(defun eglot--flymake-make-diag (diag-spec version region) "Convert LSP diagnostic DIAG-SPEC to Flymake diagnostic. -VERSION is the document version number." +REGION is the (BEG . END) region the diagnostics pertina to. VERSION is +the document version number." (eglot--dbind ((Diagnostic) range code message severity source tags) diag-spec (pcase-let - ((`(,beg . ,end) (eglot-range-region range))) + ((`(,beg . ,end) region)) ;; Fallback to `flymake-diag-region' if server botched the range (when (= beg end) (if-let* ((st (plist-get range :start)) @@ -3247,11 +3235,48 @@ may be called multiple times (respecting the protocol of ((eglot-server-capable :diagnosticProvider) (eglot--flymake-pull)) ;; Otherwise push whatever we might have, and wait for - ;; `textDocument/publishDiagnostics'. - (t (eglot--flymake-report)))) + ;; further `textDocument/publishDiagnostics'. + (t (eglot--flymake-report-push+pulled :force t)))) (t (funcall report-fn nil)))) +(cl-defun eglot--flymake-handle-push (server uri diagnostics version then) + "Handle a diagnostics \"push\" from SERVER for document URI. +DIAGNOSTICS is a list of LSP diagnostic objects. VERSION is the +LSP-reported version comparable to `eglot--docver' for which these +objects presumably pertain. If diagnostics are thought to belong to +`eglot--docver' THEN is a unary function taking DIAGNOSTICS and tasked +to eventually report the corresponding Flymake conversions of each +object. The originator of this \"push\" is usually either regular +`textDocument/publishDiagnostics' or an experimental +`$/streamDiagnostics' notification." + (if-let* ((path (expand-file-name (eglot-uri-to-path uri))) + (buffer (eglot--find-buffer-visiting server path))) + (with-current-buffer buffer + (if (and version (/= version eglot--docver)) + (cl-return-from eglot--flymake-handle-push)) + (setq + ;; if no explicit version received, assume it's current. + version eglot--docver + flymake-list-only-diagnostics + (assoc-delete-all path flymake-list-only-diagnostics)) + (funcall then diagnostics)) + (cl-loop + for diag-spec across diagnostics + collect (eglot--dbind ((Diagnostic) code range message severity source) diag-spec + (let* ((start (plist-get range :start)) + (line (1+ (plist-get start :line))) + (char (1+ (plist-get start :character)))) + (flymake-make-diagnostic + path (cons line char) nil + (eglot--flymake-diag-type severity) + (list source code message)))) + into diags + finally + (setq flymake-list-only-diagnostics + (assoc-delete-all path flymake-list-only-diagnostics)) + (push (cons path diags) flymake-list-only-diagnostics)))) + (cl-defun eglot--flymake-pull (&aux (server (eglot--current-server-or-lose)) (origin (current-buffer))) "Pull diagnostics from server, for all managed buffers. @@ -3260,7 +3285,7 @@ When response arrives call registered `eglot--flymake-report-fn'." ((pull-for (buf &optional then) (with-current-buffer buf (let ((version eglot--docver) - (prev-result-id (cadr eglot--pulled-diagnostics))) + (prev-result-id (caddr eglot--pulled-diagnostics))) (eglot--async-request server :textDocument/diagnostic @@ -3274,14 +3299,11 @@ When response arrives call registered `eglot--flymake-report-fn'." (pcase kind ("full" (setq eglot--pulled-diagnostics - (list - (cl-loop - for spec across items - collect (eglot--flymake-make-diag spec version)) - resultId)) - (eglot--flymake-report)) + (list items version resultId)) + (eglot--flymake-report-push+pulled :force t)) ("unchanged" - (when (eq buf origin) (eglot--flymake-report 'void))))) + (when (eq buf origin) + (eglot--flymake-report-1 nil :stay :force t))))) (when then (funcall then))) :hint :textDocument/diagnostic))))) ;; JT@2025-12-15: No known server yet supports "relatedDocuments" so @@ -3294,38 +3316,47 @@ When response arrives call registered `eglot--flymake-report-fn'." (mapc #'pull-for (remove origin (eglot--managed-buffers server)))))))) -(cl-defun eglot--flymake-report - (&optional keep +(defun eglot--flymake-reset () + (setq eglot--pulled-diagnostics nil + eglot--pushed-diagnostics nil) + (when eglot--flymake-report-fn + (eglot--flymake-report-1 nil :clear :force t))) + +(cl-defun eglot--flymake-report-2 (diags mode) + "Really report the Flymake diagnostics objects DIAGS. +MODE is like `eglot--flymake-report-1'." + (apply eglot--flymake-report-fn + diags + (cond ((eq mode :clear) + `(:region ,(cons (point-min) (point-max)))) + ((eq mode :stay) + `(:region ,(cons (point-min) (point-min))))))) + +(cl-defun eglot--flymake-report-push+pulled + (&key force &aux (pushed-docver (cadr eglot--pushed-diagnostics)) (pushed-outdated-p (and pushed-docver (< pushed-docver eglot--docver)))) "Push previously collected diagnostics to `eglot--flymake-report-fn'. If KEEP, knowingly push a dummy do-nothing update." - (unless eglot--flymake-report-fn - ;; Occasionally called from contexts where report-fn not setup, such - ;; as a `didOpen''ed but yet undisplayed buffer. - (cl-return-from eglot--flymake-report)) (eglot--widening - (if (or keep (and (null eglot--pulled-diagnostics) pushed-outdated-p)) - ;; Here, we don't have anything interesting to give to - ;; Flymake. Either a textDocument/diagnostics response - ;; specifically told use that nothing changed, or - ;; `flymake-start' kicked in before server had a chance to - ;; push something. We just want to keep whatever diagnostics - ;; it has annotated in the buffer but as a nice-to-have, we - ;; want to signal we're alive and clear a possible "Wait" - ;; state. We hackingly achieve this by reporting an empty - ;; list and making sure it pertains to a 0-length region. - (funcall eglot--flymake-report-fn nil - :region (cons (point-min) (point-min))) - ;; Using :region keyword always forces Flymake to delete them - ;; (github#159). - (funcall eglot--flymake-report-fn - (append (car eglot--pulled-diagnostics) - (unless pushed-outdated-p - (car eglot--pushed-diagnostics))) - :region (cons (point-min) (point-max)))))) + (if (and (null eglot--pulled-diagnostics) pushed-outdated-p) + ;; Here, we don't have anything interesting to give to Flymake. + ;; Either a textDocument/diagnostics response specifically told + ;; use that nothing changed, or `flymake-start' kicked in before + ;; server had a chance to push something. We just want to keep + ;; whatever diagnostics it has annotated in the buffer and and + ;; clear a possible "Wait" state. + (eglot--flymake-report-2 nil :stay) + (cl-macrolet ((report (x m) + `(eglot--flymake-report-1 + (car ,x) ,m :force force))) + (report eglot--pulled-diagnostics :clear) + (unless pushed-outdated-p + (report eglot--pushed-diagnostics :stay)))))) + +;;; Xref integration (defun eglot-xref-backend () "Eglot xref backend." 'eglot) (defvar eglot--temp-location-buffers (make-hash-table :test #'equal) @@ -3523,6 +3554,8 @@ If BUFFER, switch to it before." :workspace/symbol `(:query ,pattern)))))) + +;;; Eglot interactive commands and helpers (defun eglot-format-buffer () "Format contents of current buffer." (interactive) @@ -3565,12 +3598,15 @@ for which LSP on-type-formatting should be requested." nil on-type-format))) + + +;;; Completion (defvar eglot-cache-session-completions t "If non-nil Eglot caches data during completion sessions.") (defvar eglot--capf-session :none "A cache used by `eglot-completion-at-point'.") -(defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session :none)) +(defun eglot--capf-session-flush (&optional _) (setq eglot--capf-session nil)) (defun eglot--dumb-flex (pat comp ignorecase) "Return destructively fontified COMP iff PAT matches it." @@ -3826,6 +3862,8 @@ for which LSP on-type-formatting should be requested." (eglot--apply-text-edits additionalTextEdits))) (eglot--signal-textDocument/didChange))))))))) + +;;; Eldoc integration (defun eglot--hover-info (contents &optional _range) (mapconcat #'eglot--format-markup (if (vectorp contents) contents (list contents)) "\n")) @@ -3971,6 +4009,8 @@ for which LSP on-type-formatting should be requested." :hint :textDocument/documentHighlight) nil))) + +;;; Imenu integration (defun eglot--imenu-SymbolInformation (res) "Compute `imenu--index-alist' for RES vector of SymbolInformation." (mapcar @@ -4032,6 +4072,8 @@ Returns a list as described in docstring of `imenu--index-alist'." (((SymbolInformation)) (eglot--imenu-SymbolInformation res)) (((DocumentSymbol)) (eglot--imenu-DocumentSymbol res)))))) + +;;; Code actions and rename (cl-defun eglot--apply-text-edits (edits &optional version silent) "Apply EDITS for current buffer if at VERSION, or if it's nil. If SILENT, don't echo progress in mode-line." @@ -4187,7 +4229,7 @@ edit proposed by the server." "Calculate appropriate bounds depending on region and point." (let (diags boftap) (cond ((use-region-p) `(,(region-beginning) ,(region-end))) - ((setq diags (eglot--flymake-diagnostics (point))) + ((setq diags (eglot--flymake-sniff-diagnostics (point))) (cl-loop for d in diags minimizing (flymake-diagnostic-beg d) into beg maximizing (flymake-diagnostic-end d) into end @@ -4203,8 +4245,9 @@ edit proposed by the server." :range (eglot-region-range beg end) :context `(:diagnostics - [,@(mapcar #'eglot--diag-to-lsp-diag - (eglot--flymake-diagnostics beg end))] + [,@(mapcar (lambda (x) + (alist-get 'eglot-lsp-diag (flymake-diagnostic-data x))) + (eglot--flymake-sniff-diagnostics beg end))] ,@(when only `(:only [,only])) ,@(when triggerKind `(:triggerKind ,triggerKind))))) From fa5a65629262d47d95c70e5e1404b225ce7fb2f8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 8 Jan 2026 20:37:19 +0000 Subject: [PATCH 092/325] Eglot: add support for experimental $/streamingDiagnosticsProvider * lisp/progmodes/eglot.el (eglot-client-capabilities): Advertise $streamingDiagnostics (eglot--streamed-diagnostics): New variable. (eglot-handle-notification<$/streamDiagnostics>): New method. (eglot--flymake-make-diag): Tweak docstring. (eglot-flymake-backend): Rework. (eglot--flymake-reset): Set eglot--streamed-diagnostics. --- lisp/progmodes/eglot.el | 79 ++++++++++++++++++++++++++++++++++++++--- 1 file changed, 75 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index a4440235cbe..f7d38d8e417 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1151,7 +1151,8 @@ object." :tagSupport `(:valueSet [,@(mapcar - #'car eglot--tag-faces)]))) + #'car eglot--tag-faces)])) + :$streamingDiagnostics `(:dynamicRegistration :json-false)) :window `(:showDocument (:support t) :showMessage (:messageActionItem (:additionalPropertiesSupport t)) @@ -2238,6 +2239,14 @@ DIAGNOSTICS is a sequence of LSP or Flymake diagnostics objects. VERSION is the LSP Document version reported for DIAGNOSTICS (comparable to `eglot--docver') or nil if server didn't bother.") +(defvar-local eglot--streamed-diagnostics nil + "A (VERSION MAP PREV-MAP) description of \"streamed\" diagnostics. +MAP and PREV-MAP are alists of (TOKEN . DIAGS) entries. DIAGS is a +sequence of LSP/Flymake diagnostics objects. TOKEN identifies the +source of a partial report. VERSION is the LSP Document version +reported for diagnostics in MAP. PREV-MAP contains the diagnostics of +the previous reports for TOKEN.") + (defvar-local eglot--suggestion-overlay (make-overlay 0 0) "Overlay for `eglot-code-action-suggestion'.") @@ -3179,6 +3188,59 @@ version the diagnostics pertain to." ;; starts on idle-timer (github#957) (eglot--flymake-report-push+pulled))))) +(cl-defmethod eglot-handle-notification + (server (_method (eql $/streamDiagnostics)) + &key uri diagnostics version token kind + &allow-other-keys) + "Handle notification $/streamDiagnostics." + (cl-macrolet ((report (what mode) + `(eglot--flymake-report-1 ,what ,mode))) + (eglot--flymake-handle-push + server uri diagnostics version + (lambda (lsp-diags) + (cl-symbol-macrolet ((map (cadr eglot--streamed-diagnostics))) + (let* ((doc-v eglot--docver) + (known-v (car eglot--streamed-diagnostics)) + (prev-map (caddr eglot--streamed-diagnostics)) + (diags (if (equal kind "unchanged") + (cdr (assoc token (if (eq known-v doc-v) + map prev-map))) + lsp-diags)) + probe) + ;; (trace-values (buffer-name) "lsp-diags" (length lsp-diags) + ;; "diags" (length diags) "kind" kind + ;; "known-v" known-v "doc-v" doc-v) + (cond ((and known-v (< doc-v known-v)) + ;; Ignore out of date (shouldn't happen) + (report nil :stay)) + ((or (null known-v) (> doc-v known-v)) + ;; `doc-v' is greater than (potentially nil) + ;; recorded `known-v'. Save old known-v and map, + ;; "inaugurate" new doc-v, report this initial subset, + ;; clearing all existing diagnostics. + (cl-loop for (tk . diags) in map + do (setf (alist-get tk prev-map nil nil #'equal) diags)) + (let ((entry (cons token diags))) + (setq eglot--streamed-diagnostics + `(,doc-v (,entry) ,prev-map)) + (report (cdr entry) :clear))) + ((setq probe (assoc token map)) + ;; `diags' are an update to an existing report for + ;; this token, for this `doc-v' Record and report + ;; all to Flymake, clearing all existing diagnostics. + (setcdr probe diags) + (cl-loop for e in map + for m = :clear then :stay + do (report (cdr e) m))) + (t + ;; It's the first time we hear about `token' for this + ;; already inaugurated `doc-v' add its diagnostics to + ;; the map, and report only this subset, not clearing + ;; any old diagnostics. + (let ((entry (cons token diags))) + (push entry map) + (report (cdr entry) :stay)))))))))) + (defun eglot--flymake-diag-type (severity) "Convert LSP diagnostic SEVERITY to Eglot/Flymake diagnostic type." (cond ((null severity) 'eglot-error) @@ -3188,8 +3250,8 @@ version the diagnostics pertain to." (defun eglot--flymake-make-diag (diag-spec version region) "Convert LSP diagnostic DIAG-SPEC to Flymake diagnostic. -REGION is the (BEG . END) region the diagnostics pertina to. VERSION is -the document version number." +VERSION is the document version number. REGION is the (BEG . END) +pertaining to DIAG-SPEC." (eglot--dbind ((Diagnostic) range code message severity source tags) diag-spec (pcase-let @@ -3234,6 +3296,14 @@ may be called multiple times (respecting the protocol of ;; Use pull diagnostics if server supports it ((eglot-server-capable :diagnosticProvider) (eglot--flymake-pull)) + ((eglot-server-capable :$streamingDiagnosticsProvider) + (let ((v (car eglot--streamed-diagnostics)) + (map (cadr eglot--streamed-diagnostics))) + (if (and v (< v eglot--docver)) + (eglot--flymake-report-2 nil :stay) + (cl-loop for e in map + for m = :clear then :stay + do (eglot--flymake-report-1 (cdr e) m))))) ;; Otherwise push whatever we might have, and wait for ;; further `textDocument/publishDiagnostics'. (t (eglot--flymake-report-push+pulled :force t)))) @@ -3318,7 +3388,8 @@ When response arrives call registered `eglot--flymake-report-fn'." (defun eglot--flymake-reset () (setq eglot--pulled-diagnostics nil - eglot--pushed-diagnostics nil) + eglot--pushed-diagnostics nil + eglot--streamed-diagnostics nil) (when eglot--flymake-report-fn (eglot--flymake-report-1 nil :clear :force t))) From 236647ab58e6d3dd0b092e753c54317ad9004f39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 9 Jan 2026 15:45:08 +0000 Subject: [PATCH 093/325] Eglot: spectacular optimization in files with many diagnostics In a large (or simply long) file with many diagnostics, calling eglot-range-region repeteadly constantly throws Emacs for a spin around the buffer, since each diagnostics comes annotated with a (line/col): LSP range spec that is reasonably expensive to translate into Elisp point positions. A much faster approach for such large lists is to first sort all the objects containing ranges by their start lines and then do a single pass of the buffer, moving lines by delta. By much faster, I do mean spectacularly (100x) faster. A long python with 7000 "ruff" diagnostics, before the change, typical editor operations (add/delete words) are impossible. 14053 84% - jsonrpc-connection-receive 14052 84% - # 14052 84% - apply 14052 84% - eglot-handle-notification 14052 84% - applyn 14052 84% - # 14052 84% - eglot--flymake-handle-push 12295 74% - eglot--flymake-make-diag 12218 73% + eglot-range-region 50 0% + eglot--check-object 12 0% plist-member 3 0% flymake-make-diagnostic After the change: 99 1% - jsonrpc-connection-receive 99 1% - # 99 1% - apply 99 1% - eglot-handle-notification 99 1% - apply 99 1% - # 99 1% - eglot--flymake-handle-push 99 1% - eglot--call-with-ranged 99 1% - # 99 1% - eglot-move-to-utf-16-linepos 99 1% line-end-position * lisp/progmodes/eglot.el (eglot-move-to-linepos-function): Forward declare. (eglot--call-with-ranged, eglot--collecting-ranged): New helpers. (eglot--flymake-report-1) (eglot--imenu-SymbolInformation): Use eglot--collecting-ranged. (eglot--imenu-DocumentSymbol): Could use eglot--collecting-ranged. * etc/EGLOT-NEWS: Mention it --- etc/EGLOT-NEWS | 7 ++++ lisp/progmodes/eglot.el | 91 ++++++++++++++++++++++++++++++++--------- 2 files changed, 79 insertions(+), 19 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 8735e966ee9..3fe87d77690 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,13 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes to upcoming Eglot +** Dramatically faster handling of files with many diagnostics + +Diagnostic conversion between LSP and Flymake versions is now much +faster. Previously, editing, e.g. a Python file with thousands of +diagnostics was next to impossible to to periodic interruptions of +diagnostic reports. Now it's practically unnoticeable. + ** Support for LSP server multiplexers via Rassumfrassum Eglot can now leverage LSP server multiplexer programs like Rassumfrassum diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f7d38d8e417..82610d093ad 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1280,6 +1280,61 @@ If optional MARKERS, make markers instead." (list :start (eglot--pos-to-lsp-position from) :end (eglot--pos-to-lsp-position to))) +(defvar eglot-move-to-linepos-function) +(cl-defun eglot--call-with-ranged (objs key fn &aux (curline 0)) + (unless key + (setq key (lambda (o) (plist-get o :range)))) + (cl-flet ((moveit (line col) + (forward-line (- line curline)) + (setq curline line) + (unless (eobp) + (unless (wholenump col) (setq col 0)) + (funcall eglot-move-to-linepos-function col)) + (point))) + (eglot--widening + (goto-char (point-min)) + (cl-loop + with pairs = (if key + (mapcar (lambda (obj) (cons obj (funcall key obj))) + objs) + (mapcar (lambda (range) (cons range range)) + objs)) + with sorted = + (sort pairs + (lambda (p1 p2) + (< (plist-get (plist-get (cdr p1) :start) :line) + (plist-get (plist-get (cdr p2) :start) :line)))) + for (object . range) in sorted + for spos = (plist-get range :start) + for epos = (plist-get range :end) + for sline = (plist-get spos :line) + for scol = (plist-get spos :character) + for eline = (plist-get epos :line) + for ecol = (plist-get epos :character) + collect (funcall fn object (cons (moveit sline scol) + (moveit eline ecol))))))) + +(cl-defmacro eglot--collecting-ranged ((object-sym region-sym + objects + &optional key) + &rest body) + "Iterate over OBJECTS, binding each element and its region. +For each element in OBJECTS, bind OBJECT-SYM to the element and +REGION-SYM to its computed Emacs region (a cons of buffer positions). +Evaluate BODY and collect the result into a list. Return that list. + +KEY, if non-nil, should be a function to extract the LSP range from each +element. If nil, elements are assumed to be plists with `:range' keys. + +This macro uses optimized incremental navigation instead of repeatedly +calling `eglot-range-region', providing significant performance benefits +when processing many ranges." + (declare (indent 1) (debug t)) + `(eglot--call-with-ranged + ,objects + ,key + (lambda (,object-sym ,region-sym) ,@body))) + (defun eglot-server-capable (&rest feats) "Determine if current server is capable of FEATS." (unless (cl-some (lambda (feat) @@ -3167,11 +3222,8 @@ version the diagnostics pertain to." eglot--flymake-report-fn) (when (and ,diags (vectorp ,diags)) (setf ,diags - (cl-loop - for d across ,diags - collect (eglot--flymake-make-diag - d - ,version (eglot-range-region (plist-get d :range)))))) + (eglot--collecting-ranged (o r ,diags) + (eglot--flymake-make-diag o ,version r)))) (eglot--flymake-report-2 ,diags ,mode))) (cl-defmethod eglot-handle-notification @@ -4090,20 +4142,20 @@ for which LSP on-type-formatting should be requested." (alist-get kind eglot--symbol-kind-names "Unknown") (mapcan (pcase-lambda (`(,container . ,objs)) - (let ((elems (mapcar - (eglot--lambda ((SymbolInformation) kind name location) - (let ((reg (eglot-range-region - (plist-get location :range))) - (kind (alist-get kind eglot--symbol-kind-names))) - (cons (propertize name - 'imenu-region reg - 'imenu-kind kind - ;; Backward-compatible props - ;; to be removed later: - 'breadcrumb-region reg - 'breadcrumb-kind kind) - (car reg)))) - objs))) + (let ((elems + (eglot--collecting-ranged + (s reg objs (lambda (o) + (plist-get :range (plist-get o :location)))) + (eglot--dbind ((SymbolInformation) kind name) s + (let ((kind (alist-get kind eglot--symbol-kind-names))) + (cons (propertize name + 'imenu-region reg + 'imenu-kind kind + ;; Backward-compatible props + ;; to be removed later: + 'breadcrumb-region reg + 'breadcrumb-kind kind) + (car reg))))))) (if container (list (cons container elems)) elems))) (seq-group-by (eglot--lambda ((SymbolInformation) containerName) containerName) objs)))) @@ -4123,6 +4175,7 @@ for which LSP on-type-formatting should be requested." 'breadcrumb-kind kind))) (if (seq-empty-p children) (cons name (car reg)) + ;; FIXME: leverage eglot--collecting-ranged (cons name (mapcar (lambda (c) (apply #'dfs c)) children)))))) (mapcar (lambda (s) (apply #'dfs s)) res))) From 7e13073c3c1abe6975c997fa99c2d5c0c753de9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 9 Jan 2026 19:25:04 +0000 Subject: [PATCH 094/325] Eglot: don't notify server of in-disk changes for managed files Not only is this notification strictly redundant for files managed by Eglot (since didSave, didClose and didChange are scrupulously sent), but it also confuses some serers which end up posting a bunch of useless textDocument/publishDiagnostics, for example. --- lisp/progmodes/eglot.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 82610d093ad..6cc48beea5e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2392,7 +2392,7 @@ the previous reports for TOKEN.") (when (and eglot-autoshutdown (null (eglot--managed-buffers server)) ;; Don't shutdown if up again soon. - (with-no-warnings (not revert-buffer-in-progress-p))) + (not (eglot--revert-in-progress-p))) (eglot-shutdown server))))))) (defun eglot--managed-mode-off () @@ -2427,6 +2427,9 @@ the previous reports for TOKEN.") (when eglot-semantic-tokens-mode (eglot-semantic-tokens-mode)))) +(defun eglot--revert-in-progress-p () + (with-no-warnings revert-buffer-in-progress-p)) + (defun eglot--maybe-activate-editing-mode () "Maybe activate `eglot--managed-mode'. @@ -4546,6 +4549,7 @@ happens to be inside or matching the project root." (candidate (if dir (file-relative-name file dir) file))) (cond ((and (memq action '(created changed deleted)) + (not (eglot--find-buffer-visiting server file)) (cl-loop for (compiled . kind) in globs thereis (and (> (logand kind action-bit) 0) (funcall compiled candidate)))) From fefd6526e268b8cf7c0a65bc6aaa91d2b83f123f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 9 Jan 2026 21:23:41 +0000 Subject: [PATCH 095/325] Eglot: enhance eglot-list-connections-mode * lisp/progmodes/eglot.el (eglot-list-connections-mode) (eglot-list-connections): Tweak. --- lisp/progmodes/eglot.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 6cc48beea5e..8be88ab7316 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4708,7 +4708,8 @@ If NOERROR, return predicate, else erroring function." \\{eglot-list-connections-mode-map}" :interactive nil (setq-local tabulated-list-format - `[("Language server" 16) ("Project name" 16) ("Modes handled" 16)]) + `[("Language server" 16) ("Project name" 20) ("Buffers" 7) + ("Modes" 20) ("Invocation" 32)]) (tabulated-list-init-header)) (defun eglot-list-connections () @@ -4726,9 +4727,14 @@ If NOERROR, return predicate, else erroring function." `[,(or (plist-get (eglot--server-info server) :name) (jsonrpc-name server)) ,(eglot-project-nickname server) + ,(format "%s" (length (eglot--managed-buffers server))) ,(mapconcat #'symbol-name (eglot--major-modes server) - ", ")])) + ", ") + ,(let ((c (process-command + (jsonrpc--process server)))) + (if (consp c) (mapconcat #'identity c " ") + "network"))])) (cl-reduce #'append (hash-table-values eglot--servers-by-project)))) (revert-buffer) From 189e39c52a08276bf1521bbe507e0b87ae90c2dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 10 Jan 2026 22:47:23 +0000 Subject: [PATCH 096/325] Eglot: improve automated test machinery * test/lisp/progmodes/eglot-tests.el (eglot--wait-for): Fix thinkos and improve. (eglot--tests-connect): Take TIMEOUT and SERVER kwargs. (eglot-test-eclipse-connect) (eglot-test-slow-sync-connection-wait) (eglot-test-slow-sync-connection-intime): Update eglot--tests-connect call. --- test/lisp/progmodes/eglot-tests.el | 81 +++++++++++++++++------------- 1 file changed, 46 insertions(+), 35 deletions(-) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index ac6fd5174bb..0062645ea37 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -238,39 +238,47 @@ directory hierarchy." ,@body) (remove-hook 'jsonrpc-event-hook #',log-event-hook-sym)))))) -(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) args &body body) +(cl-defmacro eglot--wait-for ((events-sym &optional (timeout 1) message) + args &body body) (declare (indent 2) (debug (sexp sexp sexp &rest form))) - `(eglot--with-timeout '(,timeout ,(or message - (format "waiting for:\n%s" (pp-to-string body)))) + `(eglot--with-timeout '(,timeout + ,(or message + (format "waiting for:\n%s" (pp-to-string body)))) (eglot--test-message "waiting for `%s'" (with-output-to-string (mapc #'princ ',body))) - (let ((events - (cl-loop thereis (cl-loop for json in ,events-sym - for method = (plist-get json :method) - when (keywordp method) - do (plist-put json :method - (substring - (symbol-name method) - 1)) - when (funcall - (jsonrpc-lambda ,args ,@body) json) - return (cons json before) - collect json into before) - for i from 0 - when (zerop (mod i 5)) - ;; do (eglot--test-message "still struggling to find in %s" - ;; ,events-sym) - do - ;; `read-event' is essential to have the file - ;; watchers come through. - (cond ((fboundp 'flush-standard-output) - (read-event nil nil 0.1) (princ ".") - (flush-standard-output)) - (t - (read-event "." nil 0.1))) - (accept-process-output nil 0.1)))) - (setq ,events-sym (cdr events)) - (cl-destructuring-bind (&key method id &allow-other-keys) (car events) + (let ((probe + (cl-loop + thereis + (cl-loop for (json . tail) on ,events-sym + for method = (plist-get json :method) + when (keywordp method) + do (plist-put + json :method (substring (symbol-name method) 1)) + when (funcall (jsonrpc-lambda ,args ,@body) json) + return json + do + (unless + ;; $/progress is *truly* uninteresting and spammy + (and (string-match "$/progress" (format "%s" method))) + (eglot--test-message + "skip uninteresting event %s[%s]" + (plist-get json :method) + (plist-get json :id))) + finally (setq ,events-sym tail)) + for i from 0 + when (zerop (mod i 5)) + ;; do (eglot--test-message "still struggling to find in %s" + ;; ,events-sym) + do + ;; `read-event' is essential to have the file + ;; watchers come through. + (cond ((fboundp 'flush-standard-output) + (read-event nil nil 0.1) (princ ".") + (flush-standard-output)) + (t + (read-event "." nil 0.1))) + (accept-process-output nil 0.1)))) + (cl-destructuring-bind (&key method id &allow-other-keys) probe (eglot--test-message "detected: %s" (or method (and id (format "id=%s" id)))))))) @@ -286,10 +294,13 @@ directory hierarchy." (define-derived-mode typescript-mode prog-mode "TypeScript") (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-mode))) -(defun eglot--tests-connect (&optional timeout) +(cl-defun eglot--tests-connect (&key timeout server) (let* ((timeout (or timeout 10)) (eglot-sync-connect t) - (eglot-connect-timeout timeout)) + (eglot-connect-timeout timeout) + (eglot-server-programs + (if server `((,major-mode . ,(string-split server))) + eglot-server-programs))) (apply #'eglot--connect (eglot--guess-contact)))) (defun eglot--simulate-key-event (char) @@ -317,7 +328,7 @@ directory hierarchy." (with-current-buffer (eglot--find-file-noselect "project/src/main/java/foo/Main.java") (eglot--sniffing (:server-notifications s-notifs) - (should (eglot--tests-connect 20)) + (should (eglot--tests-connect :timeout 20)) (eglot--wait-for (s-notifs 10) (&key _id method &allow-other-keys) (string= method "language/status")))))) @@ -1069,7 +1080,7 @@ int main() { (let ((eglot-sync-connect t) (eglot-server-programs `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) - (should (eglot--tests-connect 3)))))) + (should (eglot--tests-connect :timeout 3)))))) (ert-deftest eglot-test-slow-sync-connection-intime () "Connect synchronously with `eglot-sync-connect' set to 2." @@ -1081,7 +1092,7 @@ int main() { (let ((eglot-sync-connect 2) (eglot-server-programs `((c-mode . ("sh" "-c" "sleep 1 && clangd"))))) - (should (eglot--tests-connect 3)))))) + (should (eglot--tests-connect :timeout 3)))))) (ert-deftest eglot-test-slow-async-connection () "Connect asynchronously with `eglot-sync-connect' set to 2." From 68de337f265f6d1ea8243793855eba9185c2b3e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sat, 10 Jan 2026 22:48:00 +0000 Subject: [PATCH 097/325] Eglot: improve diagnostics tests * test/lisp/progmodes/eglot-tests.el (eglot-test-basic-diagnostics): Robustify. (eglot-test-basic-pull-diagnostics) (eglot-test-basic-stream-diagnostics): New tests. --- test/lisp/progmodes/eglot-tests.el | 62 ++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 4 deletions(-) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 0062645ea37..a51ef42d276 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -442,15 +442,69 @@ directory hierarchy." (with-current-buffer (eglot--find-file-noselect "diag-project/main.c") (eglot--sniffing (:server-notifications s-notifs) - (eglot--tests-connect) - (eglot--wait-for (s-notifs 10) - (&key _id method &allow-other-keys) - (string= method "textDocument/publishDiagnostics")) + (eglot--tests-connect :server "clangd") (flymake-start) + (eglot--wait-for (s-notifs 10) + (&key method &allow-other-keys) + (string= method "textDocument/publishDiagnostics")) (goto-char (point-min)) (flymake-goto-next-error 1 '() t) (should (eq 'flymake-error (face-at-point))))))) +(ert-deftest eglot-test-basic-pull-diagnostics () + "Test basic diagnostics." + (skip-unless (executable-find "ty")) + (eglot--with-fixture + `(("diag-project" . + (("main.py" . "def main:\npuss")))) + (with-current-buffer + (eglot--find-file-noselect "diag-project/main.py") + (eglot--sniffing (:server-replies s-replies) + (eglot--tests-connect :server "ty server") + (flymake-start) + (eglot--wait-for (s-replies 5) + (&key _id method &allow-other-keys) + (string= method "textDocument/diagnostic")) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'flymake-error (face-at-point))))))) + +(ert-deftest eglot-test-basic-stream-diagnostics () + "Test basic diagnostics." + (skip-unless (executable-find "rass")) + (skip-unless (executable-find "ruff")) + (skip-unless (executable-find "ty")) + (eglot--with-fixture + `(("diag-project" . + (("main.py" . "from lib import greet\ndef main():\n greet()") + ("lib.py" . "def geet():\n print('hello')")))) + (set-buffer (eglot--find-file-noselect "diag-project/main.py")) + (eglot--sniffing (:server-notifications s-notifs) + (eglot--tests-connect :server "rass -- ty server -- ruff server") + (flymake-start) + (cl-loop repeat 2 ;; 2 stream notifs for 2 rass servers + do (eglot--wait-for (s-notifs 5) + (&key method &allow-other-keys) + (string= method "$/streamDiagnostics"))) + (goto-char (point-min)) + (flymake-goto-next-error 1 '() t) + (should (eq 'flymake-error (face-at-point)))) + + ;; Now fix it + (set-buffer (eglot--find-file-noselect "lib.py")) + (search-forward "geet") + (replace-match "greet") + (eglot--sniffing (:server-notifications s-notifs) + (eglot--signal-textDocument/didChange) + (set-buffer (eglot--find-file-noselect "main.py")) + (flymake-start) + (cl-loop repeat 2 + do (eglot--wait-for (s-notifs 5) + (&key method &allow-other-keys) + (string= method "$/streamDiagnostics"))) + (goto-char (point-min)) + (should-error (flymake-goto-next-error 1 '() t))))) + (ert-deftest eglot-test-basic-symlink () "Test basic symlink support." (skip-unless (executable-find "clangd")) From fde1a5ebeb5ff0f2a88d83f6c76984c8a4b19946 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 00:35:54 +0000 Subject: [PATCH 098/325] Eglot: de-spam eglot-mode-line-progress Too spammy when many progress reporters are created by servers such as rust-analyzer. * lisp/progmodes/eglot.el (eglot-mode-line-progress): Tweak. --- lisp/progmodes/eglot.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8be88ab7316..f95451b35af 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2667,14 +2667,16 @@ still unanswered LSP requests to the server\n")))) (cl-loop for pr hash-values of (eglot--progress-reporters server) when (eq (car pr) 'eglot--mode-line-reporter) - collect (eglot--mode-line-props - (format "%s%%%%" (or (nth 4 pr) "?")) - 'eglot-mode-line - nil - (format "(%s) %s %s" (nth 1 pr) - (nth 2 pr) (nth 3 pr))) - into reports - finally (return (mapconcat #'identity reports " /"))))) + for v = (nth 4 pr) + when v sum 1 into n and sum v into acc + collect (format "(%s) %s %s" (nth 1 pr) (nth 2 pr) (nth 3 pr)) + into blurbs finally return + (unless (zerop n) + (eglot--mode-line-props + (format "%d%%%%" (/ acc n 1.0)) + 'eglot-mode-line + nil + (mapconcat #'identity blurbs "\n")))))) "Eglot mode line construct for LSP progress reports.") (defconst eglot-mode-line-action-suggestion From 4e6a81da6ce9a4ec44642424533496db483c139a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 02:05:56 +0000 Subject: [PATCH 099/325] Eglot: add new command 'eglot-momentary-inlay-hints' * doc/misc/eglot.texi (Eglot Commands) (Customization Variables): Advertise eglot-momentary-inlay-hints. * etc/EGLOT-NEWS: Advertise new command. * lisp/progmodes/eglot.el (eglot--momentary-hints-data): New variable. (eglot-momentary-inlay-hints): New command. --- doc/misc/eglot.texi | 17 +++++++++++++++++ etc/EGLOT-NEWS | 9 +++++++++ lisp/progmodes/eglot.el | 39 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 65 insertions(+) diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 579c568f264..8483881c52a 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -766,6 +766,22 @@ serve hints about positional parameter names in function calls and a variable's automatically deduced type. Inlay hints help the user not have to remember these things by heart. +@cindex momentary inlay hints +@item eglot-momentary-inlay-hints +When bound to a single key in @code{eglot-mode-map} +(@pxref{Customization Variables}), this will arrange for inlay hints to +be displayed as long as the key is held down, and then hidden shortly +after it is released. The best way to set it up is something like this: + +@lisp +(define-key eglot-mode-map [f7] 'eglot-momentary-inlay-hints) +@end lisp + +@noindent +Note that Emacs doesn't support binding to \"key up\" events, so this +command offers an approximation by estimating your system keyboard delay +and repeat rate. + @cindex semantic tokens @item M-x eglot-semantic-tokens-mode This command toggles LSP @dfn{semantic tokens} fontification on and off @@ -978,6 +994,7 @@ For example: (define-key eglot-mode-map (kbd "C-c o") 'eglot-code-action-organize-imports) (define-key eglot-mode-map (kbd "C-c h") 'eldoc) (define-key eglot-mode-map (kbd "") 'xref-find-definitions) + (define-key eglot-mode-map (kbd "") 'eglot-momentary-inlay-hints) @end lisp @cindex progress diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 3fe87d77690..a6425ea4234 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -49,6 +49,15 @@ requests diagnostics explicitly rather than relying on sporadic server is known to support the "pull" variant exclusively, while the 'ty' server is known to support it alongside "push". +** New command 'eglot-momentary-inlay-hints' + +When bound to a single key in 'eglot-mode-map' this will arrange for +inlay hints to be displayed as long as the key is held down, and then +hidden shortly after it is released. Emacs doesn't support binding to +\"key up\" events, but this function offers an approximation. It relies +on measuring your keyboard initial delay and repeat rate, and may not be +100% accurate. + ** Support for watching files outside the project (bug#79809) Eglot now supports and advertises the 'relativePatternSupport' diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f95451b35af..b22ed2b9c57 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4882,6 +4882,45 @@ If NOERROR, return predicate, else erroring function." (jit-lock-unregister #'eglot--update-hints) (eglot--delete-overlays 'eglot--inlay-hint)))) +(defvar eglot--momentary-hints-data (list nil nil nil 0 nil)) + +(defun eglot-momentary-inlay-hints () + "Display inlay hints while holding down a key. +Emacs doesn't support binding to \"key up\" events, but this function +offers an approximation. When bound to a key it will arrange for inlay +hints to be displayed as long as the key is held down, and then hidden +shortly after it is released. This relies on measuring your keyboard +initial delay and repeat rate, and may not be 100% accurate." + (interactive) + (when eglot-inlay-hints-mode + (eglot-inlay-hints-mode -1)) + (cl-symbol-macrolet + ((timer (nth 0 eglot--momentary-hints-data)) + (initial-delay (nth 1 eglot--momentary-hints-data)) + (repeat-delay (nth 2 eglot--momentary-hints-data)) + (calls (nth 3 eglot--momentary-hints-data)) + (last-call-time (nth 4 eglot--momentary-hints-data))) + (cl-incf calls) + (cl-flet ((runit (delay) + (setf timer + (run-at-time (+ 0.1 delay) + nil (lambda () + (dolist (o (overlays-in (point-min) (point-max))) + (when (overlay-get o 'eglot--inlay-hint) + (delete-overlay o))) + (setf timer nil calls 0))) + last-call-time (float-time)))) + (cond ((timerp timer) + (when (and (not initial-delay) (= calls 2)) + (setf initial-delay (- (float-time) last-call-time))) + (when (and (not repeat-delay) (= calls 3)) + (setf repeat-delay (- (float-time) last-call-time))) + (cancel-timer timer) + (runit (or repeat-delay 0.5))) + (t + (eglot--update-hints-1 (window-start) (window-end)) + (runit (or initial-delay 1.0))))))) + ;;; Semantic tokens (defmacro eglot--semtok-define-things () From 25a6f28ad5f647519eabc99177769bd310250235 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 03:40:12 +0000 Subject: [PATCH 100/325] Eglot: release version 1.20 * lisp/progmodes/eglot.el (Version): Bump to 1.20. * etc/EGLOT-NEWS: Announce new version. --- etc/EGLOT-NEWS | 2 +- lisp/progmodes/eglot.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index a6425ea4234..638c62bbcbd 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -18,7 +18,7 @@ to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. -* Changes to upcoming Eglot +* Changes in Eglot 1.20 (11/1/2026) ** Dramatically faster handling of files with many diagnostics diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b22ed2b9c57..f75a512e18a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. -;; Version: 1.19 +;; Version: 1.20 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot From 0e4a8ae1faaa399c422f0bc6c073f72fd0014eb6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 10 Jan 2026 23:51:46 -0500 Subject: [PATCH 101/325] lisp/subr.el (insert-for-yank-1): Use `with-silent-modifications` --- lisp/subr.el | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index e9a8623595b..63c3e8b8684 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -4836,8 +4836,6 @@ It also runs the string through `yank-transform-functions'." (get-text-property 0 'yank-handler string))) (param (or (nth 1 handler) string)) (opoint (point)) - (inhibit-read-only inhibit-read-only) - (inhibit-modification-hooks inhibit-modification-hooks) end) ;; FIXME: This throws away any yank-undo-function set by previous calls @@ -4848,18 +4846,14 @@ It also runs the string through `yank-transform-functions'." (insert param)) (setq end (point)) - ;; Prevent read-only properties from interfering with the following - ;; text property changes, and inhibit further modification hook - ;; calls. - (setq inhibit-read-only t inhibit-modification-hooks t) + (with-silent-modifications + (unless (nth 2 handler) ; NOEXCLUDE + (remove-yank-excluded-properties opoint end)) - (unless (nth 2 handler) ; NOEXCLUDE - (remove-yank-excluded-properties opoint end)) - - ;; If last inserted char has properties, mark them as rear-nonsticky. - (if (and (> end opoint) - (text-properties-at (1- end))) - (put-text-property (1- end) end 'rear-nonsticky t)) + ;; If last inserted char has properties, mark them as rear-nonsticky. + (if (and (> end opoint) + (text-properties-at (1- end))) + (put-text-property (1- end) end 'rear-nonsticky t))) (if (eq yank-undo-function t) ; not set by FUNCTION (setq yank-undo-function (nth 3 handler))) ; UNDO From 1bc8e61df480cbf45e401baf2e81a62093e6d2a2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 11 Jan 2026 10:21:12 +0100 Subject: [PATCH 102/325] Don't use "make -j" when running tests * test/infra/gitlab-ci.yml (.job-template): * test/README: Don't use "make -j". --- test/README | 4 ++++ test/infra/gitlab-ci.yml | 5 ++--- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/test/README b/test/README index d897e9e2c8b..a287ae69734 100644 --- a/test/README +++ b/test/README @@ -33,6 +33,10 @@ The following examples expect this directory as the current working directory. If you call make from Emacs' root directory, use "make -C test" instead. +Running several tests in parallel could result in unexpected side +effects with ephemeral test errors. Therefore, it is recommend not to +use "make -j". + The Makefile sets the environment variable $EMACS_TEST_DIRECTORY, which points to this directory. This environment variable does not exist when the tests are run outside make. The Makefile supports the diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 1f0f33bbe86..23af677d186 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -90,7 +90,6 @@ default: -e EMACS_TEST_JUNIT_REPORT=${EMACS_TEST_JUNIT_REPORT} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} - -e NPROC=`nproc` -e http_proxy=${http_proxy} -e https_proxy=${https_proxy} -e no_proxy=${no_proxy} @@ -104,8 +103,8 @@ default: git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && - make -j \$NPROC && - make -k -j \$NPROC ${make_params}"' + make && + make -k ${make_params}"' after_script: # - docker ps -a # - pwd; printenv From 38092d879b747b829fb80328925c3f282d8936e9 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sun, 11 Jan 2026 10:22:54 +0100 Subject: [PATCH 103/325] Fix crash where dead frame remains on list of live frames (Bug#80120) * src/fns.c (delq_no_quit): New function. * src/lisp.h: Extern delq_no_quit. * src/frame.c (delete_frame): Call delq_no_quit to remove frame from Vframe_list uninterruptedly (Bug#80120). --- src/fns.c | 25 +++++++++++++++++++++++++ src/frame.c | 4 +--- src/lisp.h | 1 + 3 files changed, 27 insertions(+), 3 deletions(-) diff --git a/src/fns.c b/src/fns.c index 3604e633f8d..5c30d950cff 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2104,6 +2104,31 @@ argument. */) return list; } +/* Like Fdelq but do not report errors and neither quit nor process + signals. Use only on objects known to be non-circular lists. */ +Lisp_Object +delq_no_quit (Lisp_Object elt, Lisp_Object list) +{ + Lisp_Object prev = Qnil, tail = list; + + for (; !NILP (tail); tail = XCDR (tail)) + { + Lisp_Object tem = XCAR (tail); + + if (EQ (elt, tem)) + { + if (NILP (prev)) + list = XCDR (tail); + else + Fsetcdr (prev, XCDR (tail)); + } + else + prev = tail; + } + + return list; +} + DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0, doc: /* Delete members of SEQ which are `equal' to ELT, and return the result. SEQ must be a sequence (i.e. a list, a vector, or a string). diff --git a/src/frame.c b/src/frame.c index a03be0cd52f..5d38f015130 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2778,9 +2778,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) delete_all_child_windows (f->root_window); fset_root_window (f, Qnil); - block_input (); - Vframe_list = Fdelq (frame, Vframe_list); - unblock_input (); + Vframe_list = delq_no_quit (frame, Vframe_list); SET_FRAME_VISIBLE (f, false); /* Allow the vector of menu bar contents to be freed in the next diff --git a/src/lisp.h b/src/lisp.h index 49f7c1c9782..68d1226b2ee 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4284,6 +4284,7 @@ extern Lisp_Object nconc2 (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_quit (Lisp_Object, Lisp_Object); extern Lisp_Object assq_no_signal (Lisp_Object, Lisp_Object); extern Lisp_Object assoc_no_quit (Lisp_Object, Lisp_Object); +extern Lisp_Object delq_no_quit (Lisp_Object, Lisp_Object); extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t); extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t); extern Lisp_Object string_to_multibyte (Lisp_Object); From 4484a9f87536ee0caff4b1f53fde8f4f3ac4adbe Mon Sep 17 00:00:00 2001 From: Phil Sainty Date: Fri, 2 Jan 2026 18:34:25 +1300 Subject: [PATCH 104/325] Avoid byte-compiled code in `ibuffer-maybe-show-predicates' value (bug#80117) * lisp/ibuffer.el (ibuffer-hidden-buffer-p): New function. (ibuffer-maybe-show-predicates): Use it. (ibuffer-fontification-alist): Use it (for consistency). This prevents byte-compiled code appearing in the *Help* buffer and in the customize UI for `ibuffer-maybe-show-predicates'. --- lisp/ibuffer.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index d8692595ee0..99fe5cd2f5a 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -166,9 +166,7 @@ elisp byte-compiler." buffer-file-name)) font-lock-doc-face) (20 (string-match "^\\*" (buffer-name)) font-lock-keyword-face) - (25 (and (string-match "^ " (buffer-name)) - (null buffer-file-name)) - italic) + (25 (ibuffer-hidden-buffer-p) italic) (30 (memq major-mode ibuffer-help-buffer-modes) font-lock-comment-face) (35 (derived-mode-p 'dired-mode) font-lock-function-name-face) (40 (and (boundp 'emacs-lock-mode) emacs-lock-mode) ibuffer-locked-buffer)) @@ -236,9 +234,7 @@ view of the buffers." "The string to use for eliding long columns." :type 'string) -(defcustom ibuffer-maybe-show-predicates `(,(lambda (buf) - (and (string-match "^ " (buffer-name buf)) - (null buffer-file-name)))) +(defcustom ibuffer-maybe-show-predicates '(ibuffer-hidden-buffer-p) "A list of predicates for buffers to display conditionally. A predicate can be a regexp or a function. @@ -2035,6 +2031,13 @@ the value of point at the beginning of the line for that buffer." e))) bmarklist)))) +(defun ibuffer-hidden-buffer-p (&optional buf) + "The default member of `ibuffer-maybe-show-predicates'. +Non-nil if BUF is not visiting a file and its name begins with a space. +BUF defaults to the current buffer." + (and (string-match "^ " (buffer-name buf)) + (null (buffer-file-name buf)))) + (defun ibuffer-visible-p (buf all &optional ibuffer-buf) (and (or all (not From a59fafde755acc8fe29b3ec8464f8200a9be4591 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 12:42:47 +0000 Subject: [PATCH 105/325] Eglot: don't use text-property-search-forward unavailable on 26.3 * lisp/progmodes/eglot.el (eglot--format-markup) (eglot--semtok-font-lock-2): Rewrite. * test/lisp/progmodes/eglot-tests.el (eglot--semtok-wait): Rewrite. --- lisp/progmodes/eglot.el | 35 +++++++++++++++--------------- test/lisp/progmodes/eglot-tests.el | 9 +++++++- 2 files changed, 26 insertions(+), 18 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index f75a512e18a..05075bffc87 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2172,21 +2172,22 @@ MARKUP is either an LSP MarkedString or MarkupContent object." (setq-local markdown-fontify-code-blocks-natively t) (insert string) (let ((inhibit-message t) - (message-log-max nil) - match) + (message-log-max nil)) (ignore-errors (delay-mode-hooks (funcall render-mode))) (font-lock-ensure) (goto-char (point-min)) (let ((inhibit-read-only t)) - (when (fboundp 'text-property-search-forward) - ;; If `render-mode' is `gfm-view-mode', the `invisible' - ;; regions are set to `markdown-markup'. Set them to 't' - ;; instead, since this has actual meaning in the "*eldoc*" - ;; buffer where we're taking this string (#bug79552). - (while (setq match (text-property-search-forward 'invisible)) - (put-text-property (prop-match-beginning match) - (prop-match-end match) - 'invisible t)))) + ;; If `render-mode' is `gfm-view-mode', the `invisible' + ;; regions are set to `markdown-markup'. Set them to 't' + ;; instead, since this has actual meaning in the "*eldoc*" + ;; buffer where we're taking this string (#bug79552). + (cl-loop for from = (point) then to + while (< from (point-max)) + for inv = (get-text-property from 'invisible) + for to = (or (next-single-property-change from 'invisible) + (point-max)) + when inv + do (put-text-property from to 'invisible t))) (string-trim (buffer-string)))))) (defun eglot--read-server (prompt &optional dont-if-just-the-one) @@ -5125,12 +5126,12 @@ lock machinery calls us again." (with-silent-modifications (save-excursion (cl-loop - initially (goto-char beg) - for match = (text-property-search-forward 'eglot--semtok-faces) - while (and match (< (point) end)) - do (dolist (f (prop-match-value match)) - (add-face-text-property - (prop-match-beginning match) (prop-match-end match) f))))))) + for from = beg then to + while (< from end) + for faces = (get-text-property from 'eglot--semtok-faces) + for to = (or (next-single-property-change from 'eglot--semtok-faces nil end) end) + when faces + do (dolist (f faces) (add-face-text-property from to f))))))) ;;; Call and type hierarchies diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index a51ef42d276..c2d67dc3530 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -1576,7 +1576,14 @@ GUESSED-MAJOR-MODES-SYM are bound to the useful return values of '(3 "Timeout waiting for semantic tokens") (while (not (save-excursion (goto-char pos) - (text-property-search-forward 'eglot--semtok-faces))) + (cl-loop + for from = (point) then to + while (< from (point-max)) + for faces = (get-text-property from 'eglot--semtok-faces) + for to = (or (next-single-property-change + from 'eglot--semtok-faces) + (point-max)) + when faces return t))) (accept-process-output nil 0.1) (font-lock-ensure)))) From 67dd97a4f76839e4f4c41357f7a2bd27cc9d59bd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 12:43:48 +0000 Subject: [PATCH 106/325] Eglot: solve misc Elisp compatibility problems on Emacs 26.3 * lisp/progmodes/eglot.el (eglot--semtok-request) (eglot--semtok-after-send-changes): Unbreak for 26.3. * test/lisp/progmodes/eglot-tests.el (eglot--tests-connect): Use split-string. (eglot-test-rust-completion-exit-function): Use skip-unless. --- lisp/progmodes/eglot.el | 4 ++-- test/lisp/progmodes/eglot-tests.el | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 05075bffc87..587b03ee1ba 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -5018,11 +5018,11 @@ See `eglot--semtok-request' implementation for details.") (defun eglot--semtok-after-send-changes () ;; (trace-values "Dispatching") - (setf (plist-get eglot--semtok-state :dispatched) t)) + (setf (cl-getf eglot--semtok-state :dispatched) t)) (cl-defun eglot--semtok-request (beg end &aux (docver eglot--docver)) "Ask for tokens. Arrange for BEG..END to be font-lock flushed." - (cl-macrolet ((c (tag) `(plist-get eglot--semtok-state ,tag))) + (cl-macrolet ((c (tag) `(cl-getf eglot--semtok-state ,tag))) (cl-labels ((req (method &optional params cont &aux (buf (current-buffer))) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index c2d67dc3530..0924058121f 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -299,7 +299,7 @@ directory hierarchy." (eglot-sync-connect t) (eglot-connect-timeout timeout) (eglot-server-programs - (if server `((,major-mode . ,(string-split server))) + (if server `((,major-mode . ,(split-string server))) eglot-server-programs))) (apply #'eglot--connect (eglot--guess-contact)))) @@ -775,7 +775,7 @@ directory hierarchy." ;; This originally appeared in github#1339 (skip-unless (executable-find "rust-analyzer")) (skip-unless (executable-find "cargo")) - (skip-when (getenv "EMACS_EMBA_CI")) + (skip-unless (not (getenv "EMACS_EMBA_CI"))) (eglot--with-fixture '(("cmpl-project" . (("main.rs" . From d33ef0c5cacf222ebcf45b6670920b5c35be1c50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 12:35:44 +0000 Subject: [PATCH 107/325] Eglot: properly announce semantic tokens support to servers * lisp/progmodes/eglot.el (eglot-client-capabilities): Property annouce semantic tokens. --- lisp/progmodes/eglot.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 587b03ee1ba..8a0d6fa5b86 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1132,7 +1132,7 @@ object." :rangeFormatting `(:dynamicRegistration :json-false) :rename `(:dynamicRegistration :json-false) :semanticTokens `(:dynamicRegistration :json-false - :requests '(:full (:delta t)) + :requests (:full (:delta t)) :overlappingTokenSupport t :multilineTokenSupport t :tokenTypes [,@eglot-semantic-token-types] From 12730179acddc224f0c43a2b8e8a028182d1e40f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 12:52:12 +0000 Subject: [PATCH 108/325] Eglot: release version 1.21 * lisp/progmodes/eglot.el (Version): Bump to 1.21. * etc/EGLOT-NEWS: Announce new version. --- etc/EGLOT-NEWS | 6 ++++++ lisp/progmodes/eglot.el | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 638c62bbcbd..6059131cf21 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -17,6 +17,12 @@ This refers to https://github.com/joaotavora/eglot/issues/. That is, to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. + +* Changes in Eglot 1.21 (11/1/2026) + +This is a bugfix release with small fixes for semantic tokens and Emacs +26.3 compatibility. + * Changes in Eglot 1.20 (11/1/2026) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8a0d6fa5b86..9fd2c9712d8 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2018-2026 Free Software Foundation, Inc. -;; Version: 1.20 +;; Version: 1.21 ;; Author: João Távora ;; Maintainer: João Távora ;; URL: https://github.com/joaotavora/eglot From c84aea1c1b4fe868635ca6dbb1769ffbc3c927e0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Thu, 30 Oct 2025 22:58:26 -0700 Subject: [PATCH 109/325] Use seq-doseq for iterating over strings in ERC * lisp/erc/erc-common.el (erc--doarray): Remove unused function. * lisp/erc/erc.el (erc--channel-mode-types, erc--process-channel-modes) (erc--parse-user-modes): Replace `erc--doarray' with `seq-doseq'. * test/lisp/erc/erc-tests.el (erc--doarray): Remove test. --- lisp/erc/erc-common.el | 19 ------------------- lisp/erc/erc.el | 6 +++--- test/lisp/erc/erc-tests.el | 13 ------------- 3 files changed, 3 insertions(+), 35 deletions(-) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index 116f702ab3e..1a0b9c323d1 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -641,25 +641,6 @@ Otherwise, return LIST-OR-ATOM." (car ,list-or-atom) ,list-or-atom)))) -(defmacro erc--doarray (spec &rest body) - "Map over ARRAY, running BODY with VAR bound to iteration element. -Behave more or less like `seq-doseq', but tailor operations for -arrays. - -\(fn (VAR ARRAY [RESULT]) BODY...)" - (declare (indent 1) (debug ((symbolp form &optional form) body))) - (let ((array (make-symbol "array")) - (len (make-symbol "len")) - (i (make-symbol "i"))) - `(let* ((,array ,(nth 1 spec)) - (,len (length ,array)) - (,i 0)) - (while-let (((< ,i ,len)) - (,(car spec) (aref ,array ,i))) - ,@body - (cl-incf ,i)) - ,(nth 2 spec)))) - (provide 'erc-common) ;;; erc-common.el ends here diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index cec261feb43..572b73188e3 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -7607,7 +7607,7 @@ Use the getter of the same name to retrieve the current value.") (ct (make-char-table 'erc--channel-mode-types)) (type ?a)) (dolist (cs types) - (erc--doarray (c cs) + (seq-doseq (c cs) (aset ct c type)) (cl-incf type)) (make-erc--channel-mode-types :key key @@ -7626,7 +7626,7 @@ complement relevant letters in STRING." (table (erc--channel-mode-types-table obj)) (fallbackp (erc--channel-mode-types-fallbackp obj)) (+p t)) - (erc--doarray (c string) + (seq-doseq (c string) (cond ((= ?+ c) (setq +p t)) ((= ?- c) (setq +p nil)) ((and status-letters (string-search (string c) status-letters)) @@ -7719,7 +7719,7 @@ dropped were they not already absent." (let ((addp t) ;; redundant-add redundant-drop adding dropping) - (erc--doarray (c string) + (seq-doseq (c string) (pcase c (?+ (setq addp t)) (?- (setq addp nil)) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 1bbee0dad52..5c1a34bc3fa 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -165,19 +165,6 @@ (advice-remove 'buffer-local-value 'erc-with-server-buffer))) -(ert-deftest erc--doarray () - (let ((array "abcdefg") - out) - ;; No return form. - (should-not (erc--doarray (c array) (push c out))) - (should (equal out '(?g ?f ?e ?d ?c ?b ?a))) - - ;; Return form evaluated upon completion. - (setq out nil) - (should (= 42 (erc--doarray (c array (+ 39 (length out))) - (when (cl-evenp c) (push c out))))) - (should (equal out '(?f ?d ?b))))) - (ert-deftest erc-hide-prompt () (let ((erc-hide-prompt erc-hide-prompt) (inhibit-message noninteractive) From f740d033aec6f33b0532ab7b5c3f0c12f8ad121e Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sat, 10 Jan 2026 19:21:06 -0800 Subject: [PATCH 110/325] ; Don't use cl-letf with generic function in ERC test * test/lisp/erc/erc-tests.el (erc--update-channel-modes): Use advice instead. See 058bac45 "cl-generic.el: Avoid an O(N^2) behavior". (Bug#80175) * test/lisp/erc/resources/erc-d/erc-d-tests.el (erc-d-tests--start-server): Increase timeout to hopefully address anomalous EMBA failure. Unrelated to cited bug. --- test/lisp/erc/erc-tests.el | 147 ++++++++++--------- test/lisp/erc/resources/erc-d/erc-d-tests.el | 2 +- 2 files changed, 75 insertions(+), 74 deletions(-) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 5c1a34bc3fa..6d0172e98fc 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -987,87 +987,88 @@ (setq erc-channel-users (make-hash-table :test #'equal) erc--target (erc--target-from-string "#test")) - (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode)) - calls) - (cl-letf (((symbol-function 'erc--handle-channel-mode) - (lambda (&rest r) (push r calls) (apply orig-handle-fn r))) - ((symbol-function 'erc-update-mode-line) #'ignore)) + (cl-letf ((calls ()) + ((symbol-function 'erc-update-mode-line) #'ignore)) + (advice-add 'erc--handle-channel-mode + :before (lambda (&rest r) (push r calls)) + '((name . erc-tests-spy))) - (ert-info ("Unknown user not created") - (erc--update-channel-modes "+o" "bob") - (should-not (erc-get-channel-user "bob"))) + (ert-info ("Unknown user not created") + (erc--update-channel-modes "+o" "bob") + (should-not (erc-get-channel-user "bob"))) - (ert-info ("Status updated when user known") - (puthash "bob" (cons (erc-add-server-user - "bob" (make-erc-server-user - :nickname "bob" - :buffers (list (current-buffer)))) - (make-erc-channel-user)) - erc-channel-users) - ;; Also asserts fallback behavior for traditional prefixes. - (should-not (erc-channel-user-op-p "bob")) - (erc--update-channel-modes "+o" "bob") - (should (erc-channel-user-op-p "bob")) - (erc--update-channel-modes "-o" "bob") ; status revoked - (should-not (erc-channel-user-op-p "bob"))) + (ert-info ("Status updated when user known") + (puthash "bob" (cons (erc-add-server-user + "bob" (make-erc-server-user + :nickname "bob" + :buffers (list (current-buffer)))) + (make-erc-channel-user)) + erc-channel-users) + ;; Also asserts fallback behavior for traditional prefixes. + (should-not (erc-channel-user-op-p "bob")) + (erc--update-channel-modes "+o" "bob") + (should (erc-channel-user-op-p "bob")) + (erc--update-channel-modes "-o" "bob") ; status revoked + (should-not (erc-channel-user-op-p "bob"))) - (ert-info ("Unknown nullary added and removed") - (should-not erc--channel-modes) - (should-not erc-channel-modes) - (erc--update-channel-modes "+u") - (should (equal erc-channel-modes '("u"))) - (should (eq t (gethash ?u erc--channel-modes))) - (should (equal (pop calls) '(?d ?u t nil))) - (erc--update-channel-modes "-u") - (should (equal (pop calls) '(?d ?u nil nil))) - (should-not (gethash ?u erc--channel-modes)) - (should-not erc-channel-modes) - (should-not calls)) + (ert-info ("Unknown nullary added and removed") + (should-not erc--channel-modes) + (should-not erc-channel-modes) + (erc--update-channel-modes "+u") + (should (equal erc-channel-modes '("u"))) + (should (eq t (gethash ?u erc--channel-modes))) + (should (equal (pop calls) '(?d ?u t nil))) + (erc--update-channel-modes "-u") + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should-not calls)) - (ert-info ("Fallback for Type B includes mode letter k") - (erc--update-channel-modes "+k" "h2") - (should (equal (pop calls) '(?b ?k t "h2"))) - (should-not erc-channel-modes) - (should (equal "h2" (gethash ?k erc--channel-modes))) - (erc--update-channel-modes "-k" "*") - (should (equal (pop calls) '(?b ?k nil "*"))) - (should-not calls) - (should-not (gethash ?k erc--channel-modes)) - (should-not erc-channel-modes)) + (ert-info ("Fallback for Type B includes mode letter k") + (erc--update-channel-modes "+k" "h2") + (should (equal (pop calls) '(?b ?k t "h2"))) + (should-not erc-channel-modes) + (should (equal "h2" (gethash ?k erc--channel-modes))) + (erc--update-channel-modes "-k" "*") + (should (equal (pop calls) '(?b ?k nil "*"))) + (should-not calls) + (should-not (gethash ?k erc--channel-modes)) + (should-not erc-channel-modes)) - (ert-info ("Fallback for Type C includes mode letter l") - (erc--update-channel-modes "+l" "3") - (should (equal (pop calls) '(?c ?l t "3"))) - (should-not erc-channel-modes) - (should (equal "3" (gethash ?l erc--channel-modes))) - (erc--update-channel-modes "-l" nil) - (should (equal (pop calls) '(?c ?l nil nil))) - (should-not (gethash ?l erc--channel-modes)) - (should-not erc-channel-modes)) + (ert-info ("Fallback for Type C includes mode letter l") + (erc--update-channel-modes "+l" "3") + (should (equal (pop calls) '(?c ?l t "3"))) + (should-not erc-channel-modes) + (should (equal "3" (gethash ?l erc--channel-modes))) + (erc--update-channel-modes "-l" nil) + (should (equal (pop calls) '(?c ?l nil nil))) + (should-not (gethash ?l erc--channel-modes)) + (should-not erc-channel-modes)) - (ert-info ("Advertised supersedes heuristics") - (setq erc-server-parameters - '(("PREFIX" . "(ov)@+") - ;; Add phony 5th type for this CHANMODES value for - ;; robustness in case some server gets creative. - ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE"))) - (erc--update-channel-modes "+qu" "fool!*@*") - (should (equal (pop calls) '(?d ?u t nil))) - (should (equal (pop calls) '(?a ?q t "fool!*@*"))) - (should (equal 1 (gethash ?q erc--channel-modes))) - (should (eq t (gethash ?u erc--channel-modes))) - (should (equal erc-channel-modes '("u"))) - (should-not (erc-channel-user-owner-p "bob")) + (ert-info ("Advertised supersedes heuristics") + (setq erc-server-parameters + '(("PREFIX" . "(ov)@+") + ;; Add phony 5th type for this CHANMODES value for + ;; robustness in case some server gets creative. + ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE"))) + (erc--update-channel-modes "+qu" "fool!*@*") + (should (equal (pop calls) '(?d ?u t nil))) + (should (equal (pop calls) '(?a ?q t "fool!*@*"))) + (should (equal 1 (gethash ?q erc--channel-modes))) + (should (eq t (gethash ?u erc--channel-modes))) + (should (equal erc-channel-modes '("u"))) + (should-not (erc-channel-user-owner-p "bob")) - ;; Remove fool!*@* from list mode "q". - (erc--update-channel-modes "-uq" "fool!*@*") - (should (equal (pop calls) '(?a ?q nil "fool!*@*"))) - (should (equal (pop calls) '(?d ?u nil nil))) - (should-not (gethash ?u erc--channel-modes)) - (should-not erc-channel-modes) - (should (equal 0 (gethash ?q erc--channel-modes)))) + ;; Remove fool!*@* from list mode "q". + (erc--update-channel-modes "-uq" "fool!*@*") + (should (equal (pop calls) '(?a ?q nil "fool!*@*"))) + (should (equal (pop calls) '(?d ?u nil nil))) + (should-not (gethash ?u erc--channel-modes)) + (should-not erc-channel-modes) + (should (equal 0 (gethash ?q erc--channel-modes)))) - (should-not calls)))) + (should-not calls) + (advice-remove 'erc--handle-channel-mode 'erc-tests-spy))) (ert-deftest erc--channel-modes () ;; Only mark :unstable when running locally. diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index f78ad80c43b..b161ea17305 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -1221,7 +1221,7 @@ DIALOGS are symbols representing the base names of dialog files in (proc (apply #'start-process args))) (set-process-query-on-exit-flag proc nil) (with-current-buffer buffer - (erc-d-t-search-for 5 "Starting") + (erc-d-t-search-for 10 "Starting") (search-forward " (") (backward-char)) (let ((pair (read buffer))) From 588d95e91dfa1b374481636608e94d70f8a12758 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 11 Jan 2026 17:19:49 +0200 Subject: [PATCH 111/325] Fix Emacs responsiveness when debugging many thread-exit events * lisp/progmodes/gdb-mi.el (gdb-start-wait-for-pending): New function. (gdb-thread-exited): Call 'gdb-start-wait-for-pending' to make sure the timer which waits for pending GDB commands is launched just once, even if many =thread-exited notifications are received at a high rate. Suggested by Neil Roberts . (Bug#80157) --- lisp/progmodes/gdb-mi.el | 31 ++++++++++++++++++++++++++++--- 1 file changed, 28 insertions(+), 3 deletions(-) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index 4994a5a37ea..2174c8d7908 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -403,6 +403,20 @@ triggers in `gdb-handler-list'." (gdb-wait-for-pending func) (funcall func))))) +(defun gdb-start-wait-for-pending (var func) + "Start waiting for pending GDB commands with VAR and FUNC. +This calls `gdb-wait-for-pending' if there isn't already a timer waiting +for running the same FUNC, as indicated by a non-nil value of VAR. +VAR should be a symbol of a boolean variable. +The assumption is that when FUNC will be called, it will do the job for +all the events that need to run FUNC after the pending GDB commands are +finished. +FUNC should reset VAR to nil, so further events of the same kind will +be handled after FUNC exits." + (when (null (symbol-value var)) + (set var t) + (gdb-wait-for-pending func))) + ;; Publish-subscribe (defmacro gdb-add-subscriber (publisher subscriber) @@ -2638,6 +2652,9 @@ means to decode using the coding-system set for the GDB process." (defun gdb-ignored-notification (_token _output-field)) +(defvar gdb--update-threads-queued-p nil + "If non-nil, we already queued the `update-threads' signal.") + ;; gdb-invalidate-threads is defined to accept 'update-threads signal (defun gdb-thread-created (_token _output-field)) (defun gdb-thread-exited (_token output-field) @@ -2649,9 +2666,17 @@ Unset `gdb-thread-number' if current thread exited and update threads list." ;; When we continue current thread and it quickly exits, ;; the pending triggers in gdb-handler-list left after gdb-running ;; disallow us to properly call -thread-info without --thread option. - ;; Thus we need to use gdb-wait-for-pending. - (gdb-wait-for-pending - (lambda () (gdb-emit-signal gdb-buf-publisher 'update-threads))))) + ;; Thus we need to use gdb-wait-for-pending. But we should start + ;; waiting only once if we get a long series of =thread-exited + ;; notifications during the wait period, because otherwise we will + ;; flood the Emacs main loop with many timers. When the time + ;; expires, it will process all the threads that exited meanwhile, + ;; and the next =thread-exited notification will start a new wait. + (gdb-start-wait-for-pending + 'gdb--update-threads-queued-p + (lambda () + (setq gdb--update-threads-queued-p nil) + (gdb-emit-signal gdb-buf-publisher 'update-threads))))) (defun gdb-thread-selected (_token output-field) "Handler for =thread-selected MI output record. From 990ef365108579e44a54a44f2e2ac89cf83b3854 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 11 Jan 2026 18:24:33 +0000 Subject: [PATCH 112/325] Eglot: support textDocument/prepareRename for more accurate eglot-rename See https://github.com/joaotavora/eglot/issues/1554. * lisp/progmodes/eglot.el (eglot--rename-interactive): New helper. (eglot-rename): Use it. --- lisp/progmodes/eglot.el | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 9fd2c9712d8..17c11af204e 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4341,14 +4341,24 @@ edit proposed by the server." (t (apply)))))))) +(cl-defun eglot--rename-interactive (&aux region) + (eglot-server-capable-or-lose :renameProvider) + (let* ((probe (eglot--request (eglot--current-server-or-lose) + :textDocument/prepareRename + (eglot--TextDocumentPositionParams))) + (def + (cond ((null probe) (user-error "[eglot] Can't rename here")) + ((plist-get probe :placeholder)) + ((plist-get probe :defaultBehavior) (thing-at-point 'symbol t)) + ((setq region (eglot-range-region probe)) + (buffer-substring-no-properties (car region) (cdr region)))))) + (list (read-from-minibuffer + (format "Rename `%s' to: " (or def "unknown symbol")) + nil nil nil nil def)))) + (defun eglot-rename (newname) "Rename the current symbol to NEWNAME." - (interactive - (let ((tap (thing-at-point 'symbol t))) - (list (read-from-minibuffer - (format "Rename `%s' to: " (or tap "unknown symbol")) - nil nil nil nil tap)))) - (eglot-server-capable-or-lose :renameProvider) + (interactive (eglot--rename-interactive)) (eglot--apply-workspace-edit (eglot--request (eglot--current-server-or-lose) :textDocument/rename `(,@(eglot--TextDocumentPositionParams) From 762902c2c62de1853472c2c1a1a724ea67be45c4 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Sun, 11 Jan 2026 20:58:28 +0200 Subject: [PATCH 113/325] Adapt tab-bar/tab-line faces to dark background mode (bug#80135) * lisp/faces.el (tab-bar, tab-line): Adapt to dark background. Suggested by Philip Kaludercic . * lisp/tab-bar.el (tab-bar-tab, tab-bar-tab-inactive, tab-bar-tab-highlight): * lisp/tab-line.el (tab-line-tab, tab-line-tab-inactive) (tab-line-tab-current, tab-line-highlight): Adapt faces to dark background. --- lisp/faces.el | 13 +++++++++++-- lisp/tab-bar.el | 16 +++++++++++++--- lisp/tab-line.el | 22 +++++++++++++++++----- 3 files changed, 41 insertions(+), 10 deletions(-) diff --git a/lisp/faces.el b/lisp/faces.el index 4555c92f201..f87ef932023 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2963,10 +2963,14 @@ Note: Other faces cannot inherit from the cursor face." :group 'basic-faces) (defface tab-bar - '((((class color) (min-colors 88)) + '((((class color) (min-colors 88) (background light)) :inherit variable-pitch :background "grey85" :foreground "black") + (((class color) (min-colors 88) (background dark)) + :inherit variable-pitch + :background "grey20" + :foreground "white") (((class mono)) :background "grey") (t @@ -2976,11 +2980,16 @@ Note: Other faces cannot inherit from the cursor face." :group 'basic-faces) (defface tab-line - '((((class color) (min-colors 88)) + '((((class color) (min-colors 88) (background light)) :inherit variable-pitch :height 0.9 :background "grey85" :foreground "black") + (((class color) (min-colors 88) (background dark)) + :inherit variable-pitch + :height 0.9 + :background "grey20" + :foreground "white") (((class mono)) :background "grey") (t diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index f9df4110757..8f70866d99f 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -48,8 +48,12 @@ (defface tab-bar-tab '((default :inherit tab-bar) - (((class color) (min-colors 88)) + (((class color) (min-colors 88) (background light)) :box (:line-width 1 :style released-button)) + (((class color) (min-colors 88) (background dark)) + :box (:line-width 1 :style released-button) + :background "grey40" + :foreground "white") (t :inverse-video nil)) "Tab bar face for selected tab." @@ -59,8 +63,10 @@ (defface tab-bar-tab-inactive '((default :inherit tab-bar-tab) - (((class color) (min-colors 88)) + (((class color) (min-colors 88) (background light)) :background "grey75") + (((class color) (min-colors 88) (background dark)) + :background "grey20") (t :inverse-video t)) "Tab bar face for non-selected tab." @@ -86,10 +92,14 @@ :group 'tab-bar-faces) (defface tab-bar-tab-highlight - '((((class color) (min-colors 88)) + '((((class color) (min-colors 88) (background light)) :box (:line-width 1 :style released-button) :background "grey85" :foreground "black") + (((class color) (min-colors 88) (background dark)) + :box (:line-width 1 :style released-button) + :background "grey40" + :foreground "white") (t :inverse-video nil)) "Tab bar face for highlighting." :version "31.1" diff --git a/lisp/tab-line.el b/lisp/tab-line.el index 7ff36a5250f..aa75f738285 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -62,8 +62,12 @@ is selected." (defface tab-line-tab '((default :inherit tab-line) - (((class color) (min-colors 88)) + (((class color) (min-colors 88) (background light)) :box (:line-width 1 :style released-button)) + (((class color) (min-colors 88) (background dark)) + :box (:line-width 1 :style released-button) + :background "grey40" + :foreground "white") (t :inverse-video nil)) "Tab line face for selected tab." :version "27.1" @@ -71,8 +75,10 @@ is selected." (defface tab-line-tab-inactive '((default :inherit tab-line-tab) - (((class color) (min-colors 88)) + (((class color) (min-colors 88) (background light)) :background "grey75") + (((class color) (min-colors 88) (background dark)) + :background "grey20") (t :inverse-video t)) "Tab line face for non-selected tab." :version "27.1" @@ -115,17 +121,23 @@ function `tab-line-tab-face-group'." (defface tab-line-tab-current '((default :inherit tab-line-tab) - (((class color) (min-colors 88)) - :background "grey85")) + (((class color) (min-colors 88) (background light)) + :background "grey85") + (((class color) (min-colors 88) (background dark)) + :background "grey40")) "Tab line face for tab with current buffer in selected window." :version "27.1" :group 'tab-line-faces) (defface tab-line-highlight - '((((class color) (min-colors 88)) + '((((class color) (min-colors 88) (background light)) :box (:line-width 1 :style released-button) :background "grey85" :foreground "black") + (((class color) (min-colors 88) (background dark)) + :box (:line-width 1 :style released-button) + :background "grey40" + :foreground "white") (t :inverse-video nil)) "Tab line face for highlighting." :version "27.1" From 9dcf0bc428f76004d2e33019de640a9d4920f4f2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 11 Jan 2026 18:26:53 -0500 Subject: [PATCH 114/325] Fix recent test suite regression (bug#80177) * lisp/emacs-lisp/cl-generic.el (cl--generic-make-function): Preserve advertised-calling-convention info. * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-quote-optimization): Require `byte-opt` to fix the test when the compiler is not loaded yet. * lisp/progmodes/elisp-mode.el: Fix some >80column problems. (elisp--xref-format-extra) (elisp--xref-format): Make them constant, now that we don't have the purespace. Also, use %S since some of the elements don't necessarily have names and even if they do, we'd want to escape any funny characters in them to avoid ambiguities. (elisp--xref-find-definitions): Fix uses of `elisp--xref-format-extra` accordingly. Improve heuristic to distinguish proper `cl-defgeneric` from implicit ones. (elisp-eldoc-docstring-length-limit) (elisp-eldoc-funcall-with-docstring-length): Remove redundant `:group`. * lisp/cedet/mode-local.el (xref-mode-local-overload): Pass the override symbol rather than its name through `elisp--xref-format-extra`. * test/lisp/progmodes/elisp-mode-tests.el (find-defs-constructor): Adjust test to new text. --- lisp/cedet/mode-local.el | 30 ++++++----- lisp/emacs-lisp/cl-generic.el | 21 +++++--- lisp/progmodes/elisp-mode.el | 66 ++++++++++++++----------- test/lisp/emacs-lisp/pcase-tests.el | 1 + test/lisp/progmodes/elisp-mode-tests.el | 2 +- 5 files changed, 70 insertions(+), 50 deletions(-) diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 73f60f1972a..808840f895d 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -723,19 +723,23 @@ SYMBOL is a function that can be overridden." override (symbol-function override))))) (when (and override override-file) - (let ((meta-name (cons override major-mode)) - ;; For the declaration: - ;; - ;;(define-mode-local-override xref-elisp-foo c-mode - ;; - ;; The override symbol name is - ;; "xref-elisp-foo-c-mode". The summary should match - ;; the declaration, so strip the mode from the - ;; symbol name. - (summary (format elisp--xref-format-extra - 'define-mode-local-override - (substring (symbol-name override) 0 (- (1+ (length (symbol-name major-mode))))) - major-mode))) + (let* ((meta-name (cons override major-mode)) + ;; For the declaration: + ;; + ;;(define-mode-local-override xref-elisp-foo c-mode + ;; + ;; The override symbol name is + ;; "xref-elisp-foo-c-mode". The summary should match + ;; the declaration, so strip the mode from the + ;; symbol name. + (overridesymbol + (intern + (substring (symbol-name override) + 0 (- (1+ (length (symbol-name major-mode))))))) + (summary (format elisp--xref-format-extra + 'define-mode-local-override + overridesymbol + major-mode))) (unless (xref-mode-local--override-present override xrefs) (push (elisp--xref-make-xref diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index d501a421ea2..320bc4c3d8e 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -324,6 +324,9 @@ DEFAULT-BODY, if present, is used as the body of a default method. ,@warnings (defalias ',name (cl-generic-define ',name ',args ',(nreverse options)) + ;; FIXME: This docstring argument is used as circumstantial + ;; evidence that this generic function was defined via + ;; `cl-defgeneric' rather than only `cl-defmethod's. ,(if (consp doc) ;An expression rather than a constant. `(help-add-fundoc-usage ,doc ',args) (help-add-fundoc-usage doc args))) @@ -844,12 +847,18 @@ You might need to add: %S" ;; at which point we replace the dummy with the real one. (with-memoization (cl--generic-lazy-function generic) (lambda (&rest args) - (let ((real - (cl--generic-make-next-function generic - (cl--generic-dispatches generic) - (cl--generic-method-table generic)))) - (let ((current-load-list nil)) - (defalias (cl--generic-name generic) real)) + (let* ((real + (cl--generic-make-next-function generic + (cl--generic-dispatches generic) + (cl--generic-method-table generic))) + (sym (cl--generic-name generic)) + (old-adv-cc (get-advertised-calling-convention + (symbol-function sym)))) + (when (listp old-adv-cc) + (set-advertised-calling-convention real old-adv-cc nil)) + (when (symbol-function sym) + (let ((current-load-list nil)) + (defalias sym real))) (apply real args))))) (defun cl--generic-make-next-function (generic dispatches methods) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 13106ee6885..c4fb6946aeb 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1249,17 +1249,13 @@ functions are annotated with \"\" via the (defun elisp--xref-backend () 'elisp) -;; WORKAROUND: This is nominally a constant, but the text properties -;; are not preserved thru dump if use defconst. See bug#21237. -(defvar elisp--xref-format - #("(%s %s)" +(defconst elisp--xref-format + #("(%S %S)" 1 3 (face font-lock-keyword-face) 4 6 (face font-lock-function-name-face))) -;; WORKAROUND: This is nominally a constant, but the text properties -;; are not preserved thru dump if use defconst. See bug#21237. -(defvar elisp--xref-format-extra - #("(%s %s %s)" +(defconst elisp--xref-format-extra + #("(%S %S %S)" 1 3 (face font-lock-keyword-face) 4 6 (face font-lock-function-name-face))) @@ -1539,22 +1535,28 @@ namespace but with lower confidence." ;; defined in C; the doc strings from the C source have ;; not been loaded yet. Second call will return "src/*.c" ;; in file; handled by t case below. - (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs)) + (push (elisp--xref-make-xref + nil symbol (help-C-file-name (symbol-function symbol) + 'subr)) + xrefs)) ((and (setq doc (documentation symbol t)) ;; This doc string is defined in cl-macs.el cl-defstruct - (string-match "Constructor for objects of type `\\(.*\\)'" doc)) + ;; FIXME: This is hideously brittle! + (string-match "Constructor for objects of type `\\(.*\\)'" + doc)) ;; `symbol' is a name for the default constructor created by ;; cl-defstruct, so return the location of the cl-defstruct. (let* ((type-name (match-string 1 doc)) (type-symbol (intern type-name)) - (file (find-lisp-object-file-name type-symbol 'define-type)) + (file (find-lisp-object-file-name + type-symbol 'define-type)) (summary (format elisp--xref-format-extra - 'cl-defstruct - (concat "(" type-name) - (concat "(:constructor " (symbol-name symbol) "))")))) - (push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs) - )) + 'cl-defstruct type-symbol + `(:constructor ,symbol)))) + (push (elisp--xref-make-xref 'define-type type-symbol + file summary) + xrefs))) ((setq generic (cl--generic symbol)) ;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el @@ -1585,22 +1587,28 @@ namespace but with lower confidence." ;; Default method has all t in specializers. (setq non-default (or non-default (not (equal t item))))) - (when (and file - (or non-default - (nth 2 info))) ;; assuming only co-located default has null doc string + ;; Assuming only co-located default has null doc string + (when (and file (or non-default (nth 2 info))) (if specializers - (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))) - (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)) + (let ((summary (format elisp--xref-format-extra + 'cl-defmethod symbol + (nth 1 info)))) + (push (elisp--xref-make-xref 'cl-defmethod met-name + file summary) + xrefs)) - (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()"))) - (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)))) + (let ((summary (format elisp--xref-format-extra + 'cl-defmethod symbol ()))) + (push (elisp--xref-make-xref 'cl-defmethod met-name + file summary) + xrefs)))) )) - (if (and (setq doc (documentation symbol t)) - ;; This doc string is created somewhere in - ;; cl--generic-make-function for an implicit - ;; defgeneric. - (string-match "\n\n(fn ARG &rest ARGS)" doc)) + ;; FIXME: We rely on the fact that `cl-defgeneric' sets + ;; a `function-documentation' property (via the third arg of + ;; `defalias'), whereas implicit declaration of a generic via + ;; `cl-defmethod' doesn't. + (if (null (get symbol 'function-documentation)) ;; This symbol is an implicitly defined defgeneric, so ;; don't return it. nil @@ -2238,7 +2246,6 @@ Intended for `eldoc-documentation-functions' (which see)." (defcustom elisp-eldoc-docstring-length-limit 1000 "Maximum length of doc strings displayed by elisp ElDoc functions." :type 'natnum - :group 'elisp :version "31.1") (defcustom elisp-eldoc-funcall-with-docstring-length 'short @@ -2248,7 +2255,6 @@ Otherwise if set to `full', display full doc string." :type '(choice (const :tag "Short" short) (const :tag "Full" full)) - :group 'elisp :version "31.1") (defun elisp-eldoc-funcall-with-docstring (callback &rest _ignored) diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index 6b731699a67..e06c1e621c2 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -80,6 +80,7 @@ (ert-deftest pcase-tests-quote-optimization () ;; FIXME: We could/should also test that we get a corresponding ;; "shadowed branch" warning. + (require 'byte-opt) ;; FIXME: Needed for pcase to see that `consp' is `pure'. (should-not (pcase-tests-grep 'FOO (macroexpand '(pcase EXP (`(,_ . ,_) (BAR)) diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 311d60dae18..8211347ba11 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -407,7 +407,7 @@ to (xref-elisp-test-descr-to-target xref)." ;; cl-defstruct location. (list (cons - (xref-make "(cl-defstruct (xref-elisp-location (:constructor xref-make-elisp-location)))" + (xref-make "(cl-defstruct xref-elisp-location (:constructor xref-make-elisp-location))" (xref-make-elisp-location 'xref-elisp-location 'define-type (expand-file-name "../../../lisp/progmodes/elisp-mode.el" emacs-test-dir))) From c270402f71e0287646d65dc40a3b343529a93e26 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 12 Jan 2026 09:59:40 +0000 Subject: [PATCH 115/325] save-place-alist-to-file: Use prin1, not pp (bug#80183) * lisp/saveplace.el (save-place-alist-to-file): Use 'prin1', not 'pp' (bug#80183). Suggested by Daniel Mendler . --- lisp/saveplace.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 3dc015f2c22..8297ab76443 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -391,7 +391,7 @@ may have changed) back to `save-place-alist'." coding-system-for-write)) (let ((print-length nil) (print-level nil)) - (pp save-place-alist (current-buffer))) + (prin1 save-place-alist (current-buffer))) (let ((version-control (cond ((null save-place-version-control) nil) From fb09c11482cd044ff704df92ead7eab2edba4195 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 12 Jan 2026 10:38:29 +0000 Subject: [PATCH 116/325] ; whitespace-global-modes: Replace "automagically". --- lisp/whitespace.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index c93a1e098cb..2e89d2ae977 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -887,7 +887,7 @@ This variable is used when `whitespace-style' includes `tab-mark', (defcustom whitespace-global-modes t - "Modes for which global `whitespace-mode' is automagically turned on. + "Modes for which global `whitespace-mode' is automatically turned on. Global `whitespace-mode' is controlled by the command `global-whitespace-mode'. From eb4c5f009505e62160ec200a4c53619157b6c1e0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 12 Jan 2026 10:39:28 +0000 Subject: [PATCH 117/325] vc--read-branch-to-log: Pass BACKEND to vc-read-revision * lisp/vc/vc.el (vc--read-branch-to-log): When passing FILES to vc-read-revision, also pass BACKEND. Necessary in some cases. --- lisp/vc/vc.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a976c498c13..7048d6de1d8 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -4062,9 +4062,9 @@ that some users might prefer for interactive usage." "Read the name of a branch to log. FILESET, if non-nil, means to pass the current VC fileset to `vc-read-revision'." - (let ((branch (vc-read-revision "Branch to log: " - (and fileset - (cadr (vc-deduce-fileset t)))))) + (let* ((fileset (and fileset (vc-deduce-fileset t))) + (branch (vc-read-revision "Branch to log: " + (cadr fileset) (car fileset)))) (when (string-empty-p branch) (user-error "No branch specified")) branch)) From ec3ade22fcc495cffbe054b1a407f99864ed7c80 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 12 Jan 2026 15:10:59 +0200 Subject: [PATCH 118/325] ; Fix a recent change of tab-bar/line faces * lisp/tab-line.el (tab-line-tab, tab-line-tab-inactive) (tab-line-highlight, tab-line-tab-current): * lisp/tab-bar.el (tab-bar-tab, tab-bar-tab-inactive): * lisp/faces.el (tab-line, tab-bar): Update :version of modified faces. --- lisp/faces.el | 4 ++-- lisp/tab-bar.el | 4 ++-- lisp/tab-line.el | 8 ++++---- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/lisp/faces.el b/lisp/faces.el index f87ef932023..eea1773a3a2 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2976,7 +2976,7 @@ Note: Other faces cannot inherit from the cursor face." (t :inverse-video t)) "Tab bar face." - :version "27.1" + :version "31.1" :group 'basic-faces) (defface tab-line @@ -2995,7 +2995,7 @@ Note: Other faces cannot inherit from the cursor face." (t :inverse-video t)) "Tab line face." - :version "27.1" + :version "31.1" :group 'basic-faces) (defface menu diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 8f70866d99f..6204dd81d7c 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -57,7 +57,7 @@ (t :inverse-video nil)) "Tab bar face for selected tab." - :version "27.1" + :version "31.1" :group 'tab-bar-faces) (defface tab-bar-tab-inactive @@ -70,7 +70,7 @@ (t :inverse-video t)) "Tab bar face for non-selected tab." - :version "27.1" + :version "31.1" :group 'tab-bar-faces) (defface tab-bar-tab-group-current diff --git a/lisp/tab-line.el b/lisp/tab-line.el index aa75f738285..832b2b74437 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -70,7 +70,7 @@ is selected." :foreground "white") (t :inverse-video nil)) "Tab line face for selected tab." - :version "27.1" + :version "31.1" :group 'tab-line-faces) (defface tab-line-tab-inactive @@ -81,7 +81,7 @@ is selected." :background "grey20") (t :inverse-video t)) "Tab line face for non-selected tab." - :version "27.1" + :version "31.1" :group 'tab-line-faces) (defface tab-line-tab-inactive-alternate @@ -126,7 +126,7 @@ function `tab-line-tab-face-group'." (((class color) (min-colors 88) (background dark)) :background "grey40")) "Tab line face for tab with current buffer in selected window." - :version "27.1" + :version "31.1" :group 'tab-line-faces) (defface tab-line-highlight @@ -140,7 +140,7 @@ function `tab-line-tab-face-group'." :foreground "white") (t :inverse-video nil)) "Tab line face for highlighting." - :version "27.1" + :version "31.1" :group 'tab-line-faces) (defface tab-line-close-highlight From 578750c7c81d12a5a55503c5c523ee1b1cb8bc0d Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 13 Jan 2026 09:50:17 +0200 Subject: [PATCH 119/325] * lisp/textmodes/sgml-mode.el: Fix for html-ts-mode. (sgml-electric-tag-pair-before-change-function): Let-bind 'forward-list-function' to nil. (sgml-delete-tag): Let-bind 'forward-sexp-function' and 'forward-list-function' to nil. (sgml-tags-invisible): Let-bind 'forward-list-function' to nil. All this is required to use the default definitions of sexp/list that significantly differ from treesit definitions (bug#80151). --- lisp/textmodes/sgml-mode.el | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 99659edbef7..b24f7eadd14 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -987,7 +987,8 @@ Return non-nil if we skipped over matched tags." (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) (with-syntax-table sgml-tag-syntax-table - (let ((forward-sexp-function nil)) + (let ((forward-sexp-function nil) + (forward-list-function nil)) (up-list -1) (when (sgml-skip-tag-forward 1) (backward-sexp 1) @@ -1089,7 +1090,9 @@ With prefix argument ARG, repeat this ARG times." (interactive "p") (while (>= arg 1) (save-excursion - (let* (close open) + (let* ((forward-sexp-function nil) + (forward-list-function nil) + close open) (if (looking-at "[ \t\n]*<") ;; just before tag (if (eq (char-after (match-end 0)) ?/) @@ -1163,7 +1166,9 @@ With prefix argument ARG, repeat this ARG times." (overlay-put ol 'before-string string) (overlay-put ol 'sgml-tag t))) (put-text-property (point) - (progn (forward-list) (point)) + (let ((forward-list-function nil)) + (forward-list) + (point)) 'category 'sgml-tag)) (let ((pos (point-min))) (while (< (setq pos (next-overlay-change pos)) (point-max)) From 52875b51bf11646fa5f7d5bf6320407b37c767c6 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 13 Jan 2026 09:54:55 +0200 Subject: [PATCH 120/325] * lisp/textmodes/html-ts-mode.el: Special handling of 'show-paren-mode'. (html-ts-mode--show-paren-data): New function to exclude unbalanced tags when the closing tag is missing. (html-ts-mode): Set 'show-paren-data-function' to 'html-ts-mode--show-paren-data' (bug#80151). --- lisp/textmodes/html-ts-mode.el | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el index 25fa74943c8..7061609fb83 100644 --- a/lisp/textmodes/html-ts-mode.el +++ b/lisp/textmodes/html-ts-mode.el @@ -145,6 +145,21 @@ Return nil if there is no name or if NODE is not a defun node." (skip-chars-backward " \t\n") (pos-bol))))) +(defun html-ts-mode--show-paren-data () + ;; Exclude unbalanced tags when the closing tag is missing. + (let ((default (treesit-show-paren-data))) + (when (= (length default) 4) + (let ((pos1 (min (nth 0 default) (nth 2 default))) + (pos2 (max (nth 0 default) (nth 2 default)))) + (when (and (equal (treesit-node-type + (treesit-node-at pos1)) + "<") + (not (equal (treesit-node-type + (treesit-node-at pos2)) + " Date: Tue, 13 Jan 2026 09:29:44 +0100 Subject: [PATCH 121/325] Add frame identifiers (bug#80138) A unique frame id is assigned to a new or cloned frame, and reused on an undeleted frame. The id facilitates unambiguous identification among frames that share identical names or titles, deleted frames where a live frame object no longer exists that we can resurrect by id, for example via 'tab-bar-undo-close-tab'. It also aids debugging at the C level using the frame struct member id. Rewrite 'clone-frame' and 'undelete-frame' to not let bind variables that 'make-frame' uses to avoid conflicts with nested 'make-frame' calls, for example via 'after-make-frame-functions'. * lisp/frame.el (clone-frame, undelete-frame): Use 'frame--purify-parameters' to supply parameters explicitly. (undelete-frame--save-deleted-frame): Save frame id for restoration. (undelete-frame): Restore frame id. (frame--purify-parameters): New defun. (make-frame): Assign a new id for a new or cloned frame, reuse for undeleted frame. * src/frame.h (struct frame): Add id member. (frame_next_id): New extern. * src/frame.c (frame_next_id): New global counter. (frame_set_id, frame_set_id_from_params): New function. (Fframe_id): New DEFUN. (syms_of_frame ): New defsubr. (syms_of_frame ): New DEFSYM. (syms_of_frame ): Add 'Qinternal_id'. * src/androidfns.c (Fx_create_frame): * src/haikufns.c (Fx_create_frame): * src/nsfns.m (Fx_create_frame): * src/pgtkfns.c (Fx_create_frame): * src/w32fns.c (Fx_create_frame): * src/xfns.c (Fx_create_frame): Call 'frame_set_id_from_params'. * doc/lispref/frames.texi: Add documentation. * etc/NEWS: Announce frame id. --- doc/lispref/frames.texi | 18 +++++++++ etc/NEWS | 8 ++++ lisp/frame.el | 60 ++++++++++++++++++++++-------- src/androidfns.c | 2 + src/frame.c | 82 +++++++++++++++++++++++++++++++++++++++++ src/frame.h | 7 ++++ src/haikufns.c | 2 + src/nsfns.m | 2 + src/pgtkfns.c | 2 + src/w32fns.c | 2 + src/xfns.c | 2 + 11 files changed, 171 insertions(+), 16 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 303c047023b..5bf0bfc8c10 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -109,6 +109,24 @@ must be a root frame, which means it cannot be a child frame itself descending from it. @end defun +@defun frame-id &optional frame +This function returns the unique identifier of a frame, an integer, +assigned to @var{frame}. If @var{frame} is @code{nil} or unspecified, +it defaults to the selected frame (@pxref{Input Focus}). This can be +used to unambiguously identify a frame in a context where you do not or +cannot use a frame object. + +A frame undeleted using @command{undelete-frame} will retain its +identifier. A frame cloned using @command{clone-frame} will not retain +its original identifier. @xref{Frame Commands,,,emacs, the Emacs +Manual}. + +Frame identifiers are not persisted using the desktop library +(@pxref{Desktop Save Mode}), @command{frameset-to-register}, or +@code{frameset-save}, and each of their restored frames will bear a new +unique id. +@end defun + @menu * Creating Frames:: Creating additional frames. * Multiple Terminals:: Displaying on several different devices. diff --git a/etc/NEWS b/etc/NEWS index 93d40a9d384..f1f7deec4e7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -500,6 +500,14 @@ These are useful if you need to detect a cloned frame or undeleted frame in hooks like 'after-make-frame-functions' and 'server-after-make-frame-hook'. +--- +*** Frames now have unique ids and the new function 'frame-id'. +Each non-tooltip frame is assigned a unique integer id. This allows you +to unambiguously identify frames even if they share the same name or +title. When 'undelete-frame-mode' is enabled, each deleted frame's id +is stored for resurrection. The function 'frame-id' returns a frame's +id (in C, use the frame struct member id). + ** Mode Line +++ diff --git a/lisp/frame.el b/lisp/frame.el index d1b70a78c66..5ccfac2cadc 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -951,24 +951,24 @@ and lines for the clone. FRAME defaults to the selected frame. The frame is created on the same terminal as FRAME. If the terminal is a text-only terminal then -also select the new frame." +also select the new frame. + +A cloned frame is assigned a new frame ID. See `frame-id'." (interactive (list (selected-frame) current-prefix-arg)) (let* ((frame (or frame (selected-frame))) (windows (unless no-windows (window-state-get (frame-root-window frame)))) - (default-frame-alist + (parameters (append `((cloned-from . ,frame)) - (seq-remove (lambda (elem) - (memq (car elem) frame-internal-parameters)) - (frame-parameters frame)))) + (frame--purify-parameters (frame-parameters frame)))) new-frame) (when (and frame-resize-pixelwise (display-graphic-p frame)) (push (cons 'width (cons 'text-pixels (frame-text-width frame))) - default-frame-alist) + parameters) (push (cons 'height (cons 'text-pixels (frame-text-height frame))) - default-frame-alist)) - (setq new-frame (make-frame)) + parameters)) + (setq new-frame (make-frame parameters)) (when windows (window-state-put windows (frame-root-window new-frame) 'safe)) (unless (display-graphic-p frame) @@ -995,6 +995,24 @@ frame, unless you add them to the hook in your early-init file.") (defvar x-display-name) +(defun frame--purify-parameters (parameters) + "Return PARAMETERS without internals and ignoring unset parameters. +Use this helper function so that `make-frame' does not override any +parameters. + +In the return value, assign nil to each parameter in +`default-frame-alist', `window-system-default-frame-alist', +`frame-inherited-parameters', which is not in PARAMETERS, and remove all +parameters in `frame-internal-parameters' from PARAMETERS." + (dolist (p (append default-frame-alist + window-system-default-frame-alist + frame-inherited-parameters)) + (unless (assq (car p) parameters) + (push (cons (car p) nil) parameters))) + (seq-remove (lambda (elem) + (memq (car elem) frame-internal-parameters)) + parameters)) + (defun make-frame (&optional parameters) "Return a newly created frame displaying the current buffer. Optional argument PARAMETERS is an alist of frame parameters for @@ -1094,6 +1112,12 @@ current buffer even if it is hidden." (setq params (cons '(minibuffer) (delq (assq 'minibuffer params) params)))) + ;; Let the `frame-creation-function' apparatus assign a new frame id + ;; for a new or cloned frame. For an undeleted frame, send the old + ;; id via a frame parameter. + (when-let* ((id (cdr (assq 'undeleted params)))) + (push (cons 'frame-id id) params)) + ;; Now make the frame. (run-hooks 'before-make-frame-hook) @@ -1125,7 +1149,7 @@ current buffer even if it is hidden." ;; buffers for these windows were set (Bug#79606). (let* ((root (frame-root-window frame)) (buffer (window-buffer root))) - (with-current-buffer buffer + (with-current-buffer buffer (set-window-fringes root left-fringe-width right-fringe-width fringes-outside-margins) (set-window-scroll-bars @@ -1135,7 +1159,7 @@ current buffer even if it is hidden." root left-margin-width right-margin-width))) (let* ((mini (minibuffer-window frame)) (buffer (window-buffer mini))) - (when (eq (window-frame mini) frame) + (when (eq (window-frame mini) frame) (with-current-buffer buffer (set-window-fringes mini left-fringe-width right-fringe-width fringes-outside-margins) @@ -3126,7 +3150,8 @@ Only the 16 most recently deleted frames are saved." ;; to restore a graphical frame. (and (eq (car elem) 'display) (not (display-graphic-p))))) (frame-parameters frame)) - (window-state-get (frame-root-window frame))) + (window-state-get (frame-root-window frame)) + (frame-id frame)) undelete-frame--deleted-frames)) (if (> (length undelete-frame--deleted-frames) 16) (setq undelete-frame--deleted-frames @@ -3149,7 +3174,9 @@ Without a prefix argument, undelete the most recently deleted frame. With a numerical prefix argument ARG between 1 and 16, where 1 is most recently deleted frame, undelete the ARGth deleted frame. -When called from Lisp, returns the new frame." +When called from Lisp, returns the new frame. + +An undeleted frame retains its original frame ID. See `frame-id'." (interactive "P") (if (not undelete-frame-mode) (user-error "Undelete-Frame mode is disabled") @@ -3170,10 +3197,11 @@ When called from Lisp, returns the new frame." (if graphic "graphic" "non-graphic")) (setq undelete-frame--deleted-frames (delq frame-data undelete-frame--deleted-frames)) - (let* ((default-frame-alist - (append `((undeleted . t)) - (nth 1 frame-data))) - (frame (make-frame))) + (let* ((parameters + ;; `undeleted' signals to `make-frame' to reuse its id. + (append `((undeleted . ,(nth 3 frame-data))) + (frame--purify-parameters (nth 1 frame-data)))) + (frame (make-frame parameters))) (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe) (select-frame-set-input-focus frame) frame)))))))) diff --git a/src/androidfns.c b/src/androidfns.c index 039fcebd2ff..6d9af385ce7 100644 --- a/src/androidfns.c +++ b/src/androidfns.c @@ -858,6 +858,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, XSETFRAME (frame, f); + frame_set_id_from_params (f, parms); + f->terminal = dpyinfo->terminal; f->output_method = output_android; diff --git a/src/frame.c b/src/frame.c index 5d38f015130..033215a76ec 100644 --- a/src/frame.c +++ b/src/frame.c @@ -337,6 +337,83 @@ return values. */) : Qnil); } + +/* Frame id. */ + +EMACS_UINT frame_next_id = 1; /* 0 indicates no id (yet) set. */ + +DEFUN ("frame-id", Fframe_id, Sframe_id, 0, 1, 0, + doc: /* Return FRAME's id. +If FRAME is nil, use the selected frame. +Return nil if the id has not been set. */) + (Lisp_Object frame) +{ + if (NILP (frame)) + frame = selected_frame; + struct frame *f = decode_live_frame (frame); + if (f->id == 0) + return Qnil; + else + return make_fixnum (f->id); +} + +/** frame_set_id: Set frame F's id to ID. + + If ID is 0 and F's ID is 0, use frame_next_id and increment it, + otherwise, use ID. + + Signal an error if ID >= frame_next_id. + Signal an error if ID is in use on another live frame. + + Return ID if it was used, 0 otherwise. */ +EMACS_UINT +frame_set_id (struct frame *f, EMACS_UINT id) +{ + if (id >= frame_next_id) + error ("Specified frame ID unassigned"); + + if (id > 0) + { + eassume (CONSP (Vframe_list)); + Lisp_Object frame, tail = Qnil; + FOR_EACH_FRAME (tail, frame) + { + if (id == XFRAME (frame)->id) + error ("Specified frame ID already in use"); + } + } + + if (id == 0) + if (f->id != 0) + return 0; + else + f->id = frame_next_id++; + else + f->id = id; + return f->id; +} + +/** frame_set_id_from_params: Set frame F's id from params, if present. + + Call frame_set_id to using the frame parameter 'frame-id, if present + and a valid positive integer greater than 0, otherwise use 0. + + Return frame_set_id's return value. */ +EMACS_UINT +frame_set_id_from_params (struct frame *f, Lisp_Object params) +{ + EMACS_UINT id = 0; + Lisp_Object param_id = Fcdr (Fassq (Qframe_id, params)); + if (TYPE_RANGED_FIXNUMP (int, param_id)) + { + EMACS_INT id_1 = XFIXNUM (param_id); + if (id_1 > 0) + id = (EMACS_UINT) id_1; + } + return frame_set_id (f, id); +} + + DEFUN ("window-system", Fwindow_system, Swindow_system, 0, 1, 0, doc: /* The name of the window system that FRAME is displaying through. The value is a symbol: @@ -1358,6 +1435,7 @@ make_initial_frame (void) f = make_frame (true); XSETFRAME (frame, f); + frame_set_id (f, 0); Vframe_list = Fcons (frame, Vframe_list); @@ -1742,6 +1820,7 @@ affects all frames on the same terminal device. */) frames don't obscure other frames. */ Lisp_Object parent = Fcdr (Fassq (Qparent_frame, parms)); struct frame *f = make_terminal_frame (t, parent, parms); + frame_set_id_from_params (f, parms); if (!noninteractive) init_frame_faces (f); @@ -7195,6 +7274,7 @@ syms_of_frame (void) DEFSYM (Qfont_parameter, "font-parameter"); DEFSYM (Qforce, "force"); DEFSYM (Qinhibit, "inhibit"); + DEFSYM (Qframe_id, "frame-id"); DEFSYM (Qcloned_from, "cloned-from"); DEFSYM (Qundeleted, "undeleted"); @@ -7581,6 +7661,7 @@ allow `make-frame' to show the current buffer even if its hidden. */); #else frame_internal_parameters = list3 (Qname, Qparent_id, Qwindow_id); #endif + frame_internal_parameters = Fcons (Qframe_id, frame_internal_parameters); frame_internal_parameters = Fcons (Qcloned_from, frame_internal_parameters); frame_internal_parameters = Fcons (Qundeleted, frame_internal_parameters); @@ -7607,6 +7688,7 @@ The default is \\+`inhibit' in NS builds and nil everywhere else. */); alter_fullscreen_frames = Qnil; #endif + defsubr (&Sframe_id); defsubr (&Sframep); defsubr (&Sframe_live_p); defsubr (&Swindow_system); diff --git a/src/frame.h b/src/frame.h index 9feadeef0a5..c369a848b7c 100644 --- a/src/frame.h +++ b/src/frame.h @@ -292,6 +292,9 @@ struct frame struct image_cache *image_cache; #endif /* HAVE_WINDOW_SYSTEM */ + /* Unique frame id. */ + EMACS_UINT id; + /* Tab-bar item index of the item on which a mouse button was pressed. */ int last_tab_bar_item; @@ -1415,6 +1418,10 @@ FRAME_PARENT_FRAME (struct frame *f) #define AUTO_FRAME_ARG(name, parameter, value) \ AUTO_LIST1 (name, AUTO_CONS_EXPR (parameter, value)) +extern EMACS_UINT frame_next_id; +extern EMACS_UINT frame_set_id (struct frame *f, EMACS_UINT id); +extern EMACS_UINT frame_set_id_from_params (struct frame *f, Lisp_Object params); + /* False means there are no visible garbaged frames. */ extern bool frame_garbaged; diff --git a/src/haikufns.c b/src/haikufns.c index 21507a43a26..e24dfd2193e 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -750,6 +750,8 @@ haiku_create_frame (Lisp_Object parms) XSETFRAME (frame, f); + frame_set_id_from_params (f, parms); + f->terminal = dpyinfo->terminal; f->output_method = output_haiku; diff --git a/src/nsfns.m b/src/nsfns.m index 4bd488478a8..cf685630ab7 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1262,6 +1262,8 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side. XSETFRAME (frame, f); + frame_set_id_from_params (f, parms); + f->terminal = dpyinfo->terminal; f->output_method = output_ns; diff --git a/src/pgtkfns.c b/src/pgtkfns.c index b7c2d850550..c336ce36d58 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -1283,6 +1283,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, 1, 1, 0, XSETFRAME (frame, f); + frame_set_id_from_params (f, parms); + f->terminal = dpyinfo->terminal; f->output_method = output_pgtk; diff --git a/src/w32fns.c b/src/w32fns.c index d8093e0bd93..b75bce8d1a2 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -6315,6 +6315,8 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, XSETFRAME (frame, f); + frame_set_id_from_params (f, parameters); + parent_frame = gui_display_get_arg (dpyinfo, parameters, Qparent_frame, NULL, NULL, RES_TYPE_SYMBOL); diff --git a/src/xfns.c b/src/xfns.c index 4ab2e40fc3c..70a4b6d5509 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -5020,6 +5020,8 @@ This function is an internal primitive--use `make-frame' instead. */) XSETFRAME (frame, f); + frame_set_id_from_params (f, parms); + f->terminal = dpyinfo->terminal; f->output_method = output_x_window; From 1644463e5bbd9a2d02c22acd769c2b7286e5f781 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Mon, 29 Dec 2025 12:16:50 -0500 Subject: [PATCH 122/325] Inhibit unused variable warning in NSTRACE_WHEN (bug#80096) * src/nsterm.h (NSTRACE_WHEN): Mark 'nstrace_saved_enabled_global' as unused. --- src/nsterm.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/nsterm.h b/src/nsterm.h index e03add9c3f8..7c1ee4cf535 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -279,7 +279,7 @@ char const * nstrace_fullscreen_type_name (int); #define NSTRACE_WHEN(cond, ...) \ __attribute__ ((cleanup (nstrace_restore_global_trace_state))) \ - int nstrace_saved_enabled_global = nstrace_enabled_global; \ + int __attribute__ ((unused)) nstrace_saved_enabled_global = nstrace_enabled_global;\ __attribute__ ((cleanup (nstrace_leave))) \ int nstrace_enabled = nstrace_enabled_global && (cond); \ if (nstrace_enabled) { ++nstrace_depth; } \ From b456ffc994b58009f1b0dfc34153214f613eb18c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 09:11:24 -0500 Subject: [PATCH 123/325] (forward-list-function): Give it a default value * lisp/emacs-lisp/lisp.el (forward-list-function): Give it a default value. (forward-list): Simplify. --- lisp/emacs-lisp/lisp.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 1f1115b2f18..4d4efba76b0 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -147,7 +147,7 @@ This command assumes point is not in a string or comment." "Default function for `forward-list-function'." (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) -(defvar forward-list-function nil +(defvar forward-list-function #'forward-list-default-function "If non-nil, `forward-list' delegates to this function. Should take the same arguments and behave similarly to `forward-list'.") @@ -169,9 +169,9 @@ report errors as appropriate for this kind of usage." "No next group" "No previous group")))) (or arg (setq arg 1)) - (if forward-list-function - (funcall forward-list-function arg) - (forward-list-default-function arg)))) + (funcall (or forward-list-function + #'forward-list-default-function) + arg))) (defun backward-list (&optional arg interactive) "Move backward across one balanced group of parentheses. From cffc4278eb7cbcceaaaaccfd2217b224c0ad6818 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 09:26:20 -0500 Subject: [PATCH 124/325] (forward-sexp-function): Give it a default value * lisp/emacs-lisp/lisp.el (forward-sexp-function): Give it a default value. (forward-sexp): Simplify a bit. (up-list-default-function): Fix for `forward-sexp-default-function`. --- lisp/emacs-lisp/lisp.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4d4efba76b0..797f40ca1ba 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -50,7 +50,7 @@ This affects `insert-parentheses' and `insert-pair'." (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) (if (< arg 0) (backward-prefix-chars))) -(defvar forward-sexp-function nil +(defvar forward-sexp-function #'forward-sexp-default-function ;; FIXME: ;; - for some uses, we may want a "sexp-only" version, which only ;; jumps over a well-formed sexp, rather than some dwimish thing @@ -79,9 +79,9 @@ report errors as appropriate for this kind of usage." "No next sexp" "No previous sexp")))) (or arg (setq arg 1)) - (if forward-sexp-function - (funcall forward-sexp-function arg) - (forward-sexp-default-function arg)))) + (funcall (or forward-sexp-function + #'forward-sexp-default-function) + arg))) (defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). @@ -289,7 +289,9 @@ On error, location of point is unspecified." (scan-error (point-max))) (forward-comment 1) (point))))))) - (if (null forward-sexp-function) + ;; FIXME: Comparing functions is a code smell. + (if (memq forward-sexp-function + '(nil forward-sexp-default-function)) (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) (condition-case err From b2bb3b50ac0709f97bdc5f4d0ec101ddf4f2aecb Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 13 Jan 2026 16:13:18 +0100 Subject: [PATCH 125/325] ; * etc/tutorials/TUTORIAL.fr: fix mistake Reported-by: Ronan Plantec --- etc/tutorials/TUTORIAL.fr | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr index 58bc91198c1..1d94f3b9911 100644 --- a/etc/tutorials/TUTORIAL.fr +++ b/etc/tutorials/TUTORIAL.fr @@ -240,7 +240,7 @@ de M-v. Si vous utilisez un environnement graphique, comme X11 ou MS-Windows, il devrait y avoir une zone rectangulaire appelée barre de défilement, -ou « scrollbar » sur le bord gauche de la fenêtre d'Emacs. Vous pouvez +ou « scrollbar » sur le bord droit de la fenêtre d'Emacs. Vous pouvez faire défiler le texte en cliquant avec la souris dans cette barre de défilement. From 3e2ee9869d238a2171aa0e3c350c96c5c6b12931 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 10:18:46 -0500 Subject: [PATCH 126/325] sgml-mode.el: Prefer `forward-sexp` over `forward-list` They're always called immediately before a `<` char, in which case they do the same anyway. This saves us from having to touch `forward-list-function` in addition to `forward-exp-function`. While at it, change `sgml-tags-invisible` to use `define-minor-mode`. * lisp/textmodes/sgml-mode.el (sgml-delete-tag) (sgml-electric-tag-pair-before-change-function): Prefer `forward-sexp` over `forward-list`. (sgml-tags-invisible): Define with `define-minor-mode`. Don't disable `cursor-sensor-mode` when we don't need it any more, since some other package may be using it. Remove redundant binding of `inhibit-read-only`. --- lisp/textmodes/sgml-mode.el | 61 +++++++++++++++---------------------- 1 file changed, 25 insertions(+), 36 deletions(-) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index b24f7eadd14..2170fcea6e9 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -452,9 +452,6 @@ When more these are fontified together with `sgml-font-lock-keywords'.") (defvar sgml-display-text () "Tag names as lowercase symbols, and display string when invisible.") -;; internal -(defvar sgml-tags-invisible nil) - (defcustom sgml-tag-alist '(("![" ("ignore" t) ("include" t)) ("!attlist") @@ -987,8 +984,7 @@ Return non-nil if we skipped over matched tags." (if endp (when (sgml-skip-tag-backward 1) (forward-char 1) t) (with-syntax-table sgml-tag-syntax-table - (let ((forward-sexp-function nil) - (forward-list-function nil)) + (let ((forward-sexp-function nil)) (up-list -1) (when (sgml-skip-tag-forward 1) (backward-sexp 1) @@ -1060,7 +1056,7 @@ Return t if after a closing tag." ;; Ignore empty tags like . "\\([^>]*[^/>]\\)?>")) point close) - (forward-list 1) + (forward-sexp 1) (setq point (point)) ;; FIXME: This re-search-forward will mistakenly match ;; tag-like text inside attributes. @@ -1073,7 +1069,7 @@ Return t if after a closing tag." (unless close (goto-char point) (setq return nil))) - (forward-list 1)) + (forward-sexp 1)) (setq arg (1- arg))) return))) @@ -1091,7 +1087,6 @@ With prefix argument ARG, repeat this ARG times." (while (>= arg 1) (save-excursion (let* ((forward-sexp-function nil) - (forward-list-function nil) close open) (if (looking-at "[ \t\n]*<") ;; just before tag @@ -1110,7 +1105,7 @@ With prefix argument ARG, repeat this ARG times." (sgml-skip-tag-backward 1) (if (or (not (eq (following-char) ?<)) (save-excursion - (forward-list 1) + (forward-sexp 1) (<= (point) point))) (error "Not on or before tag"))))) (if close @@ -1143,22 +1138,17 @@ With prefix argument ARG, repeat this ARG times." read-only t) (symbol-plist 'sgml-tag)))) -(defun sgml-tags-invisible (arg) +(define-minor-mode sgml-tags-invisible "Toggle visibility of existing tags." - (interactive "P") - (let ((inhibit-read-only t) - string) - (with-silent-modifications - (save-excursion - (goto-char (point-min)) - (if (setq-local sgml-tags-invisible - (if arg - (>= (prefix-numeric-value arg) 0) - (not sgml-tags-invisible))) - (while (re-search-forward sgml-tag-name-re nil t) - (setq string - (cdr (assq (intern-soft (downcase (match-string 1))) - sgml-display-text))) + :global nil + (with-silent-modifications + (save-excursion + (goto-char (point-min)) + (if sgml-tags-invisible + (while (re-search-forward sgml-tag-name-re nil t) + (let ((string + (cdr (assq (intern-soft (downcase (match-string 1))) + sgml-display-text)))) (goto-char (match-beginning 0)) (and (stringp string) (not (overlays-at (point))) @@ -1166,19 +1156,18 @@ With prefix argument ARG, repeat this ARG times." (overlay-put ol 'before-string string) (overlay-put ol 'sgml-tag t))) (put-text-property (point) - (let ((forward-list-function nil)) - (forward-list) + (let ((forward-sexp-function nil)) + (forward-sexp 1) (point)) - 'category 'sgml-tag)) - (let ((pos (point-min))) - (while (< (setq pos (next-overlay-change pos)) (point-max)) - (dolist (ol (overlays-at pos)) - (if (overlay-get ol 'sgml-tag) - (delete-overlay ol))))) - (remove-text-properties (point-min) (point-max) '(category nil))))) - (cursor-sensor-mode (if sgml-tags-invisible 1 -1)) - (run-hooks 'sgml-tags-invisible-hook) - (message ""))) + 'category 'sgml-tag))) + (let ((pos (point-min))) + (while (< (setq pos (next-overlay-change pos)) (point-max)) + (dolist (ol (overlays-at pos)) + (if (overlay-get ol 'sgml-tag) + (delete-overlay ol))))) + (remove-text-properties (point-min) (point-max) '(category nil))))) + (when sgml-tags-invisible + (cursor-sensor-mode 1))) (defun sgml-cursor-sensor (window x dir) ;; Show preceding or following hidden tag, depending of cursor direction (and From 66ff6064f57f3b3307c3d7cb3bb75922805c3745 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Thu, 8 Jan 2026 08:45:04 +0100 Subject: [PATCH 127/325] Fix buffer menu unmark (bug#80082) Now when calling 'Buffer-menu-unmark-all-buffers', only the selected mark is removed. * lisp/buff-menu.el (Buffer-menu--unmark): Add a mark parameter to correctly select it in the entry. (Buffer-menu-unmark, Buffer-menu-unmark-all-buffers) (Buffer-menu-backup-unmark): Usage. --- lisp/buff-menu.el | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 2f1a0251183..972448fe545 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -465,7 +465,7 @@ When `outline-minor-mode' is enabled and point is on the outline heading line, this command will unmark all entries in the outline." (interactive "P" Buffer-menu-mode) (cond ((tabulated-list-get-id) - (Buffer-menu--unmark) + (Buffer-menu--unmark ?\r) (forward-line (if backup -1 1))) ((and (bound-and-true-p outline-minor-mode) (outline-on-heading-p)) (let ((old-pos (point)) @@ -488,11 +488,7 @@ When called interactively prompt for MARK; RET remove all marks." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (when-let* ((entry (tabulated-list-get-entry))) - (let ((xmarks (list (aref entry 0) (aref entry 2)))) - (when (or (char-equal mark ?\r) - (member (char-to-string mark) xmarks)) - (Buffer-menu--unmark)))) + (Buffer-menu--unmark mark) (forward-line)))) (defun Buffer-menu-unmark-all () @@ -506,15 +502,22 @@ When called interactively prompt for MARK; RET remove all marks." (forward-line -1) (while (and (not (tabulated-list-get-id)) (not (bobp))) (forward-line -1)) - (if (tabulated-list-get-id) (Buffer-menu--unmark))) + (if (tabulated-list-get-id) (Buffer-menu--unmark ?\r))) -(defun Buffer-menu--unmark () - (tabulated-list-set-col 0 " " t) - (let ((buf (Buffer-menu-buffer))) - (when buf - (if (buffer-modified-p buf) - (tabulated-list-set-col 2 "*" t) - (tabulated-list-set-col 2 " " t))))) +(defun Buffer-menu--unmark (mark) + "Remove MARK in current entry. +If MARK is \\`RET' remove all marks." + (when-let* ((entry (tabulated-list-get-entry))) + ;; A mark could appear in column 0 or 2. + (dolist (col '(0 2)) + (when (or (char-equal mark ?\r) + (char-equal mark (string-to-char (aref entry col)))) + (tabulated-list-set-col col " " t))) + ;; Reset modified mark in column 2. + (let ((buf (Buffer-menu-buffer))) + (when (and buf (buffer-modified-p buf) + (string-equal (aref entry 2) " ")) + (tabulated-list-set-col 2 "*" t))))) (defun Buffer-menu-delete (&optional arg) "Mark the buffer on this Buffer Menu buffer line for deletion. From a9bf57155b7b7ea6622a66f69275ece8799adf74 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 15:23:19 -0500 Subject: [PATCH 128/325] package.el: Fix bug#80172 * lisp/emacs-lisp/package-activate.el: Move defvar of `Info-directory-list` to when we know it should exist. * lisp/emacs-lisp/package.el (Info-directory-list): Defvar before we `let-bind it. --- lisp/emacs-lisp/package-activate.el | 2 +- lisp/emacs-lisp/package.el | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package-activate.el b/lisp/emacs-lisp/package-activate.el index 48eccb2e50a..e130304be5c 100644 --- a/lisp/emacs-lisp/package-activate.el +++ b/lisp/emacs-lisp/package-activate.el @@ -329,7 +329,6 @@ PKG-DESC is a `package-desc' object." (format "%s-autoloads" (package-desc-name pkg-desc)) (package-desc-dir pkg-desc))) -(defvar Info-directory-list) (declare-function info-initialize "info" ()) (defvar package--quickstart-pkgs t @@ -340,6 +339,7 @@ PKG-DESC is a `package-desc' object." (when (file-exists-p (expand-file-name "dir" pkg-dir)) ;; FIXME: not the friendliest, but simple. (require 'info) + (defvar Info-directory-list) (info-initialize) (add-to-list 'Info-directory-list pkg-dir))) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index c928aeb0ed3..f1bdeefc226 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4524,6 +4524,8 @@ The list is displayed in a buffer named `*Packages*'." ;;;; Quickstart: precompute activation actions for faster start up. +(defvar Info-directory-list) + ;; Activating packages via `package-initialize' is costly: for N installed ;; packages, it needs to read all N -pkg.el files first to decide ;; which packages to activate, and then again N -autoloads.el files. From ab8b0528884ffcc305e478d7bda5362acbef1b2e Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli Date: Tue, 13 Jan 2026 22:19:51 +0100 Subject: [PATCH 129/325] * lisp/icomplete.el (icomplete--render-vertical): Avoid trailing whitespace When a completion candidate has no suffix, then there is no need to add whitespace "between" the candidate and suffix, since there is no need to align suffixes if there are none. In this case the trailing whitespace only serves to needlessly make all candidates the same length, with the result that if one candidate does not fit one a single line, then all other candidates are made to not fit either. --- lisp/icomplete.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 975b9d5404e..6de3dd0b50a 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -1025,7 +1025,9 @@ away from the bottom. Counts wrapped lines as real lines." collect (concat prefix (make-string (max 0 (- max-prefix-len (length prefix))) ? ) (completion-lazy-hilit comp) - (make-string (max 0 (- max-comp-len (length comp))) ? ) + (and suffix + (make-string (max 0 (- max-comp-len (length comp))) + ? )) suffix) into lines-aux finally (setq lines lines-aux From 986aaf06cda0bd1de0c20e3079d824a83e977b69 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 16:53:45 -0500 Subject: [PATCH 130/325] (loaddefs-generate--make-autoload): Fix bug#80180 * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Avoid accidentally loading the `.elc` file. --- lisp/emacs-lisp/loaddefs-gen.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 550c6d8e0c2..ede9a9fe8a0 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -228,7 +228,11 @@ expand)' among their `declare' forms." (member file loaddefs--load-error-files)) (let ((load-path (cons (file-name-directory file) load-path))) (message "loaddefs-gen: loading file %s (for %s)" file car) - (condition-case e (load file) + (condition-case e + ;; Don't load the `.elc' file, in case the file wraps + ;; the macro-definition in `eval-when-compile' (bug#80180). + (let ((load-suffixes '(".el"))) + (load file)) (error (push file loaddefs--load-error-files) ; do not attempt again (warn "loaddefs-gen: load error\n\t%s" e))))) From 5a1ced4b243f60918508edace80e6ce5a4f7d09d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 14 Jan 2026 10:41:41 +0100 Subject: [PATCH 131/325] Call all registered D-Bus signal handlers * doc/misc/dbus.texi (Signals): All registered signal handlers are called. (Synchronous Methods, Signals, Monitoring Messages): Add function result in examples. * src/dbusbind.c (xd_store_event): New function. (xd_read_message_1): Use it. Call all registered handlers per signal. (Bug#80168) * test/lisp/net/dbus-tests.el (dbus--test-signal-handler): Adapt defun. (dbus--test-signal-handler1, dbus--test-signal-handler2): New defuns. (dbus-test05-register-signal-several-handlers): New test. (dbus-test04-register-method) (dbus-test04-call-method-authorizable) (dbus-test05-register-signal) (dbus-test05-register-signal-with-nils) (dbus-test06-register-property-emits-signal): Adapt tests. --- doc/misc/dbus.texi | 13 +++- src/dbusbind.c | 128 +++++++++++++++--------------------- test/lisp/net/dbus-tests.el | 94 ++++++++++++++++++++++++-- 3 files changed, 152 insertions(+), 83 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index f3e42f3060c..7fad406520c 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -1240,6 +1240,8 @@ running): "org.freedesktop.systemd1.Manager" "RestartUnit" :authorizable t "bluetooth.service" "replace") + +@result{} "/org/freedesktop/systemd1/job/17508" @end lisp The remaining arguments @var{args} are passed to @var{method} as @@ -1752,6 +1754,8 @@ arguments. They are converted into D-Bus types as described in :session nil dbus-path-emacs (concat dbus-interface-emacs ".FileManager") "FileModified" "/home/albinus/.emacs") + +@result{} nil @end lisp @end defun @@ -1779,7 +1783,10 @@ argument. @var{handler} is a Lisp function to be called when the @var{signal} is received. It must accept as arguments the output parameters -@var{signal} is sending. +@var{signal} is sending.@footnote{It is possible to register different +handlers for the same signal. All registered handlers will be called +when the signal arrives. This is useful for example if different Lisp +packages are interested in the same signal.} The remaining arguments @var{args} can be keywords or keyword string pairs.@footnote{For backward compatibility, the arguments @var{args} @@ -2178,12 +2185,16 @@ The following form shows all D-Bus events on the session bus in buffer @lisp (dbus-register-monitor :session) + +@result{} ((:monitor :session-private) (nil nil dbus-monitor-handler)) @end lisp And this form restricts the monitoring on D-Bus errors: @lisp (dbus-register-monitor :session nil :type "error") + +@result{} ((:monitor :session-private) (nil nil dbus-monitor-handler)) @end lisp @end defun diff --git a/src/dbusbind.c b/src/dbusbind.c index b79715232fb..a2936011610 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1617,14 +1617,32 @@ usage: (dbus-message-internal &rest REST) */) return result; } +/* Construct a D-Bus event, and store it into the input event queue. */ +static void +xd_store_event (Lisp_Object handler, Lisp_Object handler_args, + Lisp_Object event_args) +{ + struct input_event event; + EVENT_INIT (event); + event.kind = DBUS_EVENT; + event.frame_or_window = Qnil; + /* Handler and handler args. */ + event.arg = Fcons (handler, handler_args); + /* Event args. */ + event.arg = CALLN (Fappend, event_args, event.arg); + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + + XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg)); +} + /* Read one queued incoming message of the D-Bus BUS. BUS is either a Lisp symbol, :system, :session, :system-private or :session-private, or a string denoting the bus address. */ static void xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) { - Lisp_Object args, key, value; - struct input_event event; + Lisp_Object args, event_args, key, value; DBusMessage *dmessage; DBusMessageIter iter; int dtype; @@ -1676,6 +1694,27 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) mtype == DBUS_MESSAGE_TYPE_ERROR ? error_name : member, XD_OBJECT_TO_STRING (args)); + /* Add type, serial, uname, destination, path, interface and member + or error_name to the event_args. */ + event_args + = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR + ? error_name == NULL ? Qnil : build_string (error_name) + : member == NULL ? Qnil : build_string (member), + Qnil); + event_args = Fcons ((interface == NULL ? Qnil : build_string (interface)), + event_args); + event_args = Fcons ((path == NULL ? Qnil : build_string (path)), + event_args); + event_args = Fcons ((destination == NULL ? Qnil : build_string (destination)), + event_args); + event_args = Fcons ((uname == NULL ? Qnil : build_string (uname)), + event_args); + event_args = Fcons (INT_TO_INTEGER (serial), event_args); + event_args = Fcons (make_fixnum (mtype), event_args); + + /* Add the bus symbol to the event. */ + event_args = Fcons (bus, event_args); + if (mtype == DBUS_MESSAGE_TYPE_INVALID) goto cleanup; @@ -1693,12 +1732,8 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) /* Remove the entry. */ Fremhash (key, Vdbus_registered_objects_table); - /* Construct an event. */ - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - /* Handler. */ - event.arg = Fcons (value, args); + /* Store the event. */ + xd_store_event (value, args, event_args); } else /* DBUS_MESSAGE_TYPE_METHOD_CALL, DBUS_MESSAGE_TYPE_SIGNAL. */ @@ -1729,6 +1764,7 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) Fgethash (key, Vdbus_registered_objects_table, Qnil)); } + Lisp_Object called_handlers = Qnil; /* Loop over the registered functions. Construct an event. */ for (; !NILP (value); value = CDR_SAFE (value)) { @@ -1747,45 +1783,15 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) Lisp_Object handler = CAR_SAFE (CDR_SAFE (key_path_etc)); if (NILP (handler)) continue; + if (!NILP (memq_no_quit (handler, called_handlers))) + continue; + called_handlers = Fcons (handler, called_handlers); - /* Construct an event and exit the loop. */ - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - event.arg = Fcons (handler, args); - break; + /* Store the event. */ + xd_store_event (handler, args, event_args); } - - if (NILP (value)) - goto monitor; } - /* Add type, serial, uname, destination, path, interface and member - or error_name to the event. */ - event.arg - = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR - ? error_name == NULL ? Qnil : build_string (error_name) - : member == NULL ? Qnil : build_string (member), - event.arg); - event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), - event.arg); - event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), - event.arg); - event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), - event.arg); - event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), - event.arg); - event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); - event.arg = Fcons (make_fixnum (mtype), event.arg); - - /* Add the bus symbol to the event. */ - event.arg = Fcons (bus, event.arg); - - /* Store it into the input event queue. */ - kbd_buffer_store_event (&event); - - XD_DEBUG_MESSAGE ("Event stored: %s", XD_OBJECT_TO_STRING (event.arg)); - /* Monitor. */ monitor: /* Search for a registered function of the message. */ @@ -1796,39 +1802,9 @@ xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) if (NILP (value)) goto cleanup; - /* Construct an event. */ - EVENT_INIT (event); - event.kind = DBUS_EVENT; - event.frame_or_window = Qnil; - - /* Add type, serial, uname, destination, path, interface, member - or error_name and handler to the event. */ - event.arg - = Fcons (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))), - args); - event.arg - = Fcons (mtype == DBUS_MESSAGE_TYPE_ERROR - ? error_name == NULL ? Qnil : build_string (error_name) - : member == NULL ? Qnil : build_string (member), - event.arg); - event.arg = Fcons ((interface == NULL ? Qnil : build_string (interface)), - event.arg); - event.arg = Fcons ((path == NULL ? Qnil : build_string (path)), - event.arg); - event.arg = Fcons ((destination == NULL ? Qnil : build_string (destination)), - event.arg); - event.arg = Fcons ((uname == NULL ? Qnil : build_string (uname)), - event.arg); - event.arg = Fcons (INT_TO_INTEGER (serial), event.arg); - event.arg = Fcons (make_fixnum (mtype), event.arg); - - /* Add the bus symbol to the event. */ - event.arg = Fcons (bus, event.arg); - - /* Store it into the input event queue. */ - kbd_buffer_store_event (&event); - - XD_DEBUG_MESSAGE ("Monitor event stored: %s", XD_OBJECT_TO_STRING (event.arg)); + /* Store the event. */ + xd_store_event (CAR_SAFE (CDR_SAFE (CDR_SAFE (CDR_SAFE (CAR_SAFE (value))))), + args, event_args); /* Cleanup. */ cleanup: diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 3490bebd8d6..e529e02ed9b 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -607,6 +607,7 @@ This includes initialization and closing the bus." (let ((method1 "Method1") (method2 "Method2") (handler #'dbus--test-method-handler) + dbus-debug ; There would be errors otherwise. registered) ;; The service is not registered yet. @@ -759,6 +760,7 @@ Returns the respective error." (unwind-protect (let ((method "Method") (handler #'dbus--test-method-authorizable-handler) + dbus-debug ; There would be errors otherwise. registered) ;; Register. @@ -850,7 +852,7 @@ Returns the respective error." (dbus-event-path-name dbus--test-event-expected)) (equal (dbus-event-member-name last-input-event) (dbus-event-member-name dbus--test-event-expected)))) - (setq dbus--test-signal-received args))))) + (push args dbus--test-signal-received))))) (defun dbus--test-timeout-handler (&rest _ignore) "Timeout handler, reporting a failed test." @@ -885,7 +887,7 @@ Returns the respective error." (with-timeout (1 (dbus--test-timeout-handler)) (while (null dbus--test-signal-received) (read-event nil nil 0.1))) - (should (equal dbus--test-signal-received '("foo"))) + (should (equal dbus--test-signal-received '(("foo")))) ;; Send two arguments, compound types. (setq dbus--test-signal-received nil) @@ -896,7 +898,7 @@ Returns the respective error." (with-timeout (1 (dbus--test-timeout-handler)) (while (null dbus--test-signal-received) (read-event nil nil 0.1))) - (should (equal dbus--test-signal-received '((1 2 3) ("bar")))) + (should (equal dbus--test-signal-received '(((1 2 3) ("bar"))))) ;; Unregister signal. (should (dbus-unregister-object registered)) @@ -905,6 +907,86 @@ Returns the respective error." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(defun dbus--test-signal-handler1 (&rest args) + "Signal handler for `dbus-test05-register-signal-several-handlers'." + ;; (message "dbus--test-signal-handler1 %S" last-input-event) + (dbus--test-signal-handler (cons "dbus--test-signal-handler1" args))) + +(defun dbus--test-signal-handler2 (&rest args) + "Signal handler for `dbus-test05-register-signal-several-handlers'." + ;; (message "dbus--test-signal-handler2 %S" last-input-event) + (dbus--test-signal-handler (cons "dbus--test-signal-handler2" args))) + +(ert-deftest dbus-test05-register-signal-several-handlers () + "Check signal registration for an own service. +It shall call several handlers per received signal." + (skip-unless dbus--test-enabled-session-bus) + (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) + + (unwind-protect + (let ((member "Member") + (handler1 #'dbus--test-signal-handler1) + (handler2 #'dbus--test-signal-handler2) + registered1 registered2) + + ;; Register signal handlers. + (should + (equal + (setq + registered1 + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member handler1)) + `((:signal :session ,dbus--test-interface ,member) + (,dbus--test-service ,dbus--test-path ,handler1)))) + (should + (equal + (setq + registered2 + (dbus-register-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member handler2)) + `((:signal :session ,dbus--test-interface ,member) + (,dbus--test-service ,dbus--test-path ,handler2)))) + + ;; Send one argument, basic type. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (length< dbus--test-signal-received 2) + (read-event nil nil 0.1))) + (should + (member + '(("dbus--test-signal-handler1" "foo")) dbus--test-signal-received)) + (should + (member + '(("dbus--test-signal-handler2" "foo")) dbus--test-signal-received)) + + ;; Unregister one signal. + (should (dbus-unregister-object registered1)) + (should-not (dbus-unregister-object registered1)) + + ;; Send one argument, basic type. + (setq dbus--test-signal-received nil) + (dbus-send-signal + :session dbus--test-service dbus--test-path + dbus--test-interface member "foo") + (with-timeout (1 (dbus--test-timeout-handler)) + (while (null dbus--test-signal-received) + (read-event nil nil 0.1))) + (should + (equal + dbus--test-signal-received '((("dbus--test-signal-handler2" "foo"))))) + + ;; Unregister the other signal. + (should (dbus-unregister-object registered2)) + (should-not (dbus-unregister-object registered2))) + + ;; Cleanup. + (dbus-unregister-service :session dbus--test-service))) + (ert-deftest dbus-test05-register-signal-with-nils () "Check signal registration for an own service. SERVICE, PATH, INTERFACE and SIGNAL are ‘nil’. This is interpreted as a @@ -956,7 +1038,7 @@ wildcard for the respective argument." (with-timeout (1 (dbus--test-timeout-handler)) (while (null dbus--test-signal-received) (read-event nil nil 0.1))) - (should (equal dbus--test-signal-received '("foo"))) + (should (equal dbus--test-signal-received '(("foo")))) ;; Unregister signal. (should (dbus-unregister-object registered)) @@ -1317,7 +1399,7 @@ wildcard for the respective argument." ;; "invalidated_properties" (an array of strings). (should (equal dbus--test-signal-received - `(,dbus--test-interface ((,property ("foo"))) ()))) + `((,dbus--test-interface ((,property ("foo"))) ())))) (should (equal @@ -1341,7 +1423,7 @@ wildcard for the respective argument." (should (equal dbus--test-signal-received - `(,dbus--test-interface ((,property ((1 2 3)))) ()))) + `((,dbus--test-interface ((,property ((1 2 3)))) ())))) (should (equal From 9618ac339d22a00ec31666dcccd6458730f13111 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Tue, 13 Jan 2026 23:05:02 -0800 Subject: [PATCH 132/325] Reset Xterm cursor color to default when face is unspecified * lisp/term/xterm.el (xterm-update-cursor): Mention OSC 112 in doc string. (xterm--reset-cursor-color-escape-sequence): New constant. (xterm--init-update-cursor, xterm--update-cursor-color): Use it (bug#80091). --- lisp/term/xterm.el | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index a91608b0f56..7b3e674d997 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -88,13 +88,18 @@ If set to t all supported attributes of the cursor are updated. If set to `type' only the cursor type is updated. This uses the CSI DECSCUSR escape sequence. If set to `color' only the cursor color is updated. This uses the OSC -12 escape sequence." +12 and OSC 112 escape sequences." :version "31.1" :type '(radio (const :tag "Do not update" nil) (const :tag "Update" t) (const :tag "Update type only" type) (const :tag "Update color only" color))) +;; MacOS Terminal.app does not handle OSC 112 if it is terminated with +;; \e\\. It only handles OSC 112 if it is terminated by \a. +(defconst xterm--reset-cursor-color-escape-sequence "\e]112\a" + "OSC 112 escape sequence to reset cursor color to terminal default.") + (defconst xterm-paste-ending-sequence "\e[201~" "Characters sent by the terminal to end a bracketed paste.") @@ -1330,15 +1335,8 @@ versions of xterm." (defun xterm--init-update-cursor () "Register hooks to run `xterm--update-cursor-type' appropriately." (when (memq xterm-update-cursor '(color t)) - (xterm--query - "\e]12;?\e\\" - `(("\e]12;" . ,(lambda () - (let ((str (xterm--read-string ?\e ?\\))) - ;; The response is specifically formatted to set - ;; the color. - (push - (concat "\e]12;" str "\e\\") - (terminal-parameter nil 'tty-mode-reset-strings))))))) + (push xterm--reset-cursor-color-escape-sequence + (terminal-parameter nil 'tty-mode-reset-strings)) ;; No need to set `tty-mode-set-strings' because ;; `xterm--post-command-hook' handles restoring the cursor color. @@ -1395,11 +1393,15 @@ This updates the selected frame's terminal based on `cursor-type'." (defun xterm--update-cursor-color () "Update the cursor color for Xterm-compatible terminals. This updates the selected frame's terminal based on the face `cursor'." - (let* ((color (color-values (face-background 'cursor))) - (r (nth 0 color)) - (g (nth 1 color)) - (b (nth 2 color))) - (send-string-to-terminal (format "\e]12;rgb:%04x/%04x/%04x\e\\" r g b)))) + (if-let* ((color (color-values (face-background 'cursor))) + (r (nth 0 color)) + (g (nth 1 color)) + (b (nth 2 color))) + (send-string-to-terminal (format "\e]12;rgb:%04x/%04x/%04x\e\\" r g b)) + ;; The background is `unspecified' or one of its variants. We don't + ;; know the right cursor color to use, so fall back to the terminal + ;; default. + (send-string-to-terminal xterm--reset-cursor-color-escape-sequence))) (provide 'xterm) ;Backward compatibility. (provide 'term/xterm) From 65655ccfae281233dd112df4fc2d7abb8842a61c Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 14 Jan 2026 12:18:41 +0000 Subject: [PATCH 133/325] ; * lisp/vc/vc.el (vc-diff-outgoing-base): Document FILESET param. --- lisp/vc/vc.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 7048d6de1d8..5400e97685c 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3179,6 +3179,8 @@ When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. +When called from Lisp, optional argument FILESET overrides the fileset. + This command is like to `vc-diff-outgoing' except that it includes uncommitted changes." (interactive (list (vc--maybe-read-upstream-location) nil)) From aa6e42f18b70bba8db8776878dd9b72e8a8315ba Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 14 Jan 2026 12:48:02 +0000 Subject: [PATCH 134/325] Rename VC outgoing and incoming log commands to include "-root-" * lisp/vc/vc.el (vc-log-incoming, vc-log-outgoing): Rename ... (vc-root-log-incoming, vc-root-log-outgoing): ... to these. All uses changed. Leave behind obsolete function aliases. * lisp/emacs-lisp/package-vc.el (package-vc-log-incoming): Rename ... (package-vc-root-log-incoming): ... to this. All uses changed. Leave behind obsolete function alias. --- doc/emacs/maintaining.texi | 54 ++++++++++++------------ etc/NEWS | 8 ++-- lisp/emacs-lisp/package-vc.el | 10 +++-- lisp/vc/vc-dir.el | 12 +++--- lisp/vc/vc-hooks.el | 23 +++++----- lisp/vc/vc.el | 12 +++++- test/lisp/emacs-lisp/package-vc-tests.el | 2 +- 7 files changed, 67 insertions(+), 54 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 37a475be668..532d06fa835 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1066,12 +1066,12 @@ Display the change history for the current repository on another branch @item C-x v I Display log entries for the changes that a ``pull'' operation will -retrieve (@code{vc-log-incoming}). +retrieve (@code{vc-root-log-incoming}). @vindex vc-use-incoming-outgoing-prefixes If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, @kbd{C-x v I} becomes a prefix key, and -@code{vc-log-incoming} becomes bound to @kbd{C-x v I L}. +@code{vc-root-log-incoming} becomes bound to @kbd{C-x v I L}. @item M-x vc-root-diff-incoming Display a diff of all changes that a pull operation will retrieve. @@ -1088,11 +1088,11 @@ non-@code{nil}, this command becomes available on @kbd{C-x v I =}. @item C-x v O Display log entries for the changes that will be sent by the next -``push'' operation (@code{vc-log-outgoing}). +``push'' operation (@code{vc-root-log-outgoing}). If you customize @code{vc-use-incoming-outgoing-prefixes} to non-@code{nil}, @kbd{C-x v O} becomes a prefix key, and -@code{vc-log-outgoing} becomes bound to @kbd{C-x v O L}. +@code{vc-root-log-outgoing} becomes bound to @kbd{C-x v O L}. @item M-x vc-root-diff-outgoing Display a diff of all changes that will be sent by the next push @@ -1188,31 +1188,31 @@ or the remote branch references supported by Git. @kindex C-x v I @kindex C-x v O -@findex vc-log-incoming -@findex vc-log-outgoing +@findex vc-root-log-incoming +@findex vc-root-log-outgoing On a decentralized version control system, the @kbd{C-x v I} -(@code{vc-log-incoming}) command displays a log buffer showing the +(@code{vc-root-log-incoming}) command displays a log buffer showing the changes that will be applied the next time you run the version control system's pull command to get new revisions from another remote location (@pxref{Pulling / Pushing}). This other remote location is the default one from which changes are pulled, as defined by the version control -system; with a prefix argument, @code{vc-log-incoming} prompts for a -particular remote location. Similarly, @kbd{C-x v O} -(@code{vc-log-outgoing}) shows the changes that will be sent to another -remote location, the next time you run the push command; with a prefix -argument, it prompts for a particular destination that in case of some -version control system can be a branch name. +system; with a prefix argument, @code{vc-root-log-incoming} prompts for +a particular remote location. Similarly, @kbd{C-x v O} +(@code{vc-root-log-outgoing}) shows the changes that will be sent to +another remote location, the next time you run the push command; with a +prefix argument, it prompts for a particular destination that in case of +some version control system can be a branch name. @findex vc-root-diff-incoming @findex vc-root-diff-outgoing The closely related commands @code{vc-root-diff-incoming} and @code{vc-root-diff-outgoing} are the diff analogues of -@code{vc-log-incoming} and @code{vc-log-outgoing}. These display diff -buffers reporting the changes that would be pulled or pushed. You can -use a prefix argument here too to specify a particular remote location. -@code{vc-root-diff-outgoing} is useful as a way to preview your push and -quickly check that all and only the changes you intended to include were -committed and will be pushed. +@code{vc-root-log-incoming} and @code{vc-root-log-outgoing}. These +display diff buffers reporting the changes that would be pulled or +pushed. You can use a prefix argument here too to specify a particular +remote location. @code{vc-root-diff-outgoing} is useful as a way to +preview your push and quickly check that all and only the changes you +intended to include were committed and will be pushed. @findex vc-diff-incoming @findex vc-diff-outgoing @@ -1562,8 +1562,8 @@ repository, such as the name of the backend in use and the working directory. In addition, for decentralized VCS, if you have outgoing commits (@pxref{VC Change Log}), Emacs displays a line @w{"Outgoing : N unpushed revisions"} where @var{N} is a number. You can click on this -text to execute the @code{vc-log-outgoing} command (@pxref{VC Change -Log}). +text to execute the @code{vc-root-log-outgoing} command (@pxref{VC +Change Log}). @vindex vc-dir-show-outgoing-count Emacs tries to use cached information to determine the number of @@ -1840,9 +1840,9 @@ with Git, and @kbd{hg push} with Mercurial. The default commands always push to the repository in the default location determined by the version control system from your branch configuration. -Prior to pushing, you can use @kbd{C-x v O} (@code{vc-log-outgoing}) -to view a log buffer of the changes to be sent upstream. @xref{VC -Change Log}. +Prior to pushing, you can use @kbd{C-x v O} +(@code{vc-root-log-outgoing}) to view a log buffer of the changes to be +sent upstream. @xref{VC Change Log}. @cindex bound branch (Bazaar VCS) This command is currently supported only by Bazaar, Git, and Mercurial. @@ -1876,9 +1876,9 @@ it into the current branch. With Mercurial, it calls @kbd{hg pull -u} to fetch changesets from the default remote repository and update the working directory. - Prior to pulling, you can use @kbd{C-x v I} (@code{vc-log-incoming}) -to view a log buffer of the changes to be applied. @xref{VC Change -Log}. + Prior to pulling, you can use @kbd{C-x v I} +(@code{vc-root-log-incoming}) to view a log buffer of the changes to be +applied. @xref{VC Change Log}. With a centralized version control system like CVS, @kbd{C-x v +} updates the current VC fileset from the repository. diff --git a/etc/NEWS b/etc/NEWS index f1f7deec4e7..9e5c070fd8c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2668,8 +2668,8 @@ relevant buffers before generating the contents of a VC Directory buffer *** New commands to report incoming and outgoing diffs. 'vc-root-diff-incoming' and 'vc-root-diff-outgoing' report diffs of all the changes that would be pulled and would be pushed, respectively. -They are the diff analogues of the existing commands 'vc-log-incoming' -and 'vc-log-outgoing'. +They are the diff analogues of the existing commands +'vc-root-log-incoming' and 'vc-root-log-outgoing'. In particular, 'vc-root-diff-outgoing' is useful as a way to preview your push and ensure that all and only the changes you intended to @@ -2692,9 +2692,9 @@ If this is customized to non-nil, 'C-x v I' and 'C-x v O' become prefix commands, such that the new incoming and outgoing commands have global bindings: -- 'C-x v I L' is bound to 'vc-log-incoming' +- 'C-x v I L' is bound to 'vc-root-log-incoming' - 'C-x v I D' is bound to 'vc-root-diff-incoming' -- 'C-x v O L' is bound to 'vc-log-outgoing' +- 'C-x v O L' is bound to 'vc-root-log-outgoing' - 'C-x v O D' is bound to 'vc-root-diff-outgoing'. +++ diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index c5e94c90e9b..11ea9d2850f 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -1086,13 +1086,17 @@ See also `vc-prepare-patch'." (vc-prepare-patch (package-maintainers pkg-desc t) subject revisions))) -(defun package-vc-log-incoming (pkg-desc) - "Call `vc-log-incoming' for the package PKG-DESC." +(defun package-vc-root-log-incoming (pkg-desc) + "Call `vc-root-log-incoming' for the package PKG-DESC." (interactive (list (package-vc--read-package-desc "Incoming log for package: " t))) (let ((default-directory (package-vc--checkout-dir pkg-desc)) (vc-deduce-backend-nonvc-modes t)) - (call-interactively #'vc-log-incoming))) + (call-interactively #'vc-root-log-incoming))) +(define-obsolete-function-alias + 'package-vc-log-incoming + #'package-vc-root-log-incoming + "31.1") (provide 'package-vc) ;;; package-vc.el ends here diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 6cb162a96f5..1c6b6a4cba4 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -294,10 +294,10 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) (define-key map [logo] - '(menu-item "Show Outgoing Log" vc-log-outgoing + '(menu-item "Show Outgoing Log" vc-root-log-outgoing :help "Show a log of changes that will be sent with a push operation")) (define-key map [logi] - '(menu-item "Show Incoming Log" vc-log-incoming + '(menu-item "Show Incoming Log" vc-root-log-incoming :help "Show a log of changes that will be received with a pull operation")) (define-key map [log] '(menu-item "Show History" vc-print-log @@ -354,8 +354,8 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and (define-key map "P" #'vc-push) ;; C-x v P (define-key map "l" #'vc-print-log) ;; C-x v l (define-key map "L" #'vc-print-root-log) ;; C-x v L - (define-key map "I" #'vc-log-incoming) ;; C-x v I - (define-key map "O" #'vc-log-outgoing) ;; C-x v O + (define-key map "I" #'vc-root-log-incoming) ;; C-x v I + (define-key map "O" #'vc-root-log-outgoing) ;; C-x v O ;; More confusing than helpful, probably ;;(define-key map "R" #'vc-revert) ;; u is taken by vc-dir-unmark. ;;(define-key map "A" #'vc-annotate) ;; g is taken by revert-buffer @@ -1335,7 +1335,7 @@ the *vc-dir* buffer. (defvar-keymap vc-dir-outgoing-revisions-map :doc "Local keymap for viewing outgoing revisions." - "" #'vc-log-outgoing) + "" #'vc-root-log-outgoing) (defcustom vc-dir-show-outgoing-count t "Whether to display the number of unpushed revisions in VC-Dir. @@ -1386,7 +1386,7 @@ specific headers." 'mouse-face 'highlight 'keymap vc-dir-outgoing-revisions-map 'help-echo "\\\ -\\[vc-log-outgoing]: List outgoing revisions") +\\[vc-root-log-outgoing]: List outgoing revisions") "\n")))) (defun vc-dir-refresh-files (files) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index ef80fc084ab..cab05c20db1 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1014,8 +1014,8 @@ In the latter case, VC mode is deactivated for this buffer." "i" #'vc-register "l" #'vc-print-log "L" #'vc-print-root-log - "I" #'vc-log-incoming - "O" #'vc-log-outgoing + "I" #'vc-root-log-incoming + "O" #'vc-root-log-outgoing "M L" #'vc-log-mergebase "M D" #'vc-diff-mergebase "o =" #'vc-diff-outgoing-base @@ -1044,11 +1044,11 @@ In the latter case, VC mode is deactivated for this buffer." (define-key ctl-x-map "v" 'vc-prefix-map) (defvar-keymap vc-incoming-prefix-map - "L" #'vc-log-incoming + "L" #'vc-root-log-incoming "=" #'vc-diff-incoming "D" #'vc-root-diff-incoming) (defvar-keymap vc-outgoing-prefix-map - "L" #'vc-log-outgoing + "L" #'vc-root-log-outgoing "=" #'vc-diff-outgoing "D" #'vc-root-diff-outgoing) @@ -1056,9 +1056,10 @@ In the latter case, VC mode is deactivated for this buffer." "Whether \\`C-x v I' and \\`C-x v O' are prefix commands. Historically Emacs bound \\`C-x v I' and \\`C-x v O' directly to commands. That is still the default. If this option is customized to -non-nil, these key sequences becomes prefix commands. `vc-log-incoming' -moves to \\`C-x v I L', `vc-log-outgoing' moves to \\`C-x v O L', and -other commands receive global bindings where they had none before." +non-nil, these key sequences becomes prefix commands. +`vc-root-log-incoming' moves to \\`C-x v I L', `vc-root-log-outgoing' +moves to \\`C-x v O L', and other commands receive global bindings where +they had none before." :type 'boolean :version "31.1" :set (lambda (symbol value) @@ -1070,8 +1071,8 @@ other commands receive global bindings where they had none before." (keymap-set map "I" vc-incoming-prefix-map) (keymap-set map "O" vc-outgoing-prefix-map)) (dolist (map maps) - (keymap-set map "I" #'vc-log-incoming) - (keymap-set map "O" #'vc-log-outgoing)))) + (keymap-set map "I" #'vc-root-log-incoming) + (keymap-set map "O" #'vc-root-log-outgoing)))) (set-default symbol value))) (defvar vc-menu-map @@ -1122,10 +1123,10 @@ other commands receive global bindings where they had none before." '(menu-item "Update ChangeLog" vc-update-change-log :help "Find change log file and add entries from recent version control logs")) (define-key map [vc-log-out] - '(menu-item "Show Outgoing Log" vc-log-outgoing + '(menu-item "Show Outgoing Log" vc-root-log-outgoing :help "Show a log of changes that will be sent with a push operation")) (define-key map [vc-log-in] - '(menu-item "Show Incoming Log" vc-log-incoming + '(menu-item "Show Incoming Log" vc-root-log-incoming :help "Show a log of changes that will be received with a pull operation")) (define-key map [vc-print-log] '(menu-item "Show History" vc-print-log diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 5400e97685c..fc4a8b2d991 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -4150,7 +4150,7 @@ starting at that revision. Tags and remote references also work." (user-error "No incoming revision -- local-only branch?"))))) ;;;###autoload -(defun vc-log-incoming (&optional upstream-location) +(defun vc-root-log-incoming (&optional upstream-location) "Show log of changes that will be received with pull from UPSTREAM-LOCATION. When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull from. When called interactively with a prefix argument, prompt for @@ -4160,6 +4160,10 @@ can be a remote branch name." (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend upstream-location "*vc-incoming*" 'log-incoming))) +;; We plan to reuse the name `vc-log-incoming' for the fileset-specific +;; command in Emacs 32.1. --spwhitton +(define-obsolete-function-alias 'vc-log-incoming #'vc-root-log-incoming + "31.1") (defun vc-default-log-incoming (backend buffer upstream-location) (let ((incoming (vc--incoming-revision backend upstream-location @@ -4170,7 +4174,7 @@ can be a remote branch name." (vc-call-backend backend 'mergebase incoming)))) ;;;###autoload -(defun vc-log-outgoing (&optional upstream-location) +(defun vc-root-log-outgoing (&optional upstream-location) "Show log of changes that will be sent with a push to UPSTREAM-LOCATION. When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for @@ -4180,6 +4184,10 @@ can be a remote branch name." (vc--with-backend-in-rootdir "VC root-log" (vc-incoming-outgoing-internal backend upstream-location "*vc-outgoing*" 'log-outgoing))) +;; We plan to reuse the name `vc-log-outgoing' for the fileset-specific +;; command in Emacs 32.1. --spwhitton +(define-obsolete-function-alias 'vc-log-outgoing #'vc-root-log-outgoing + "31.1") (defun vc-default-log-outgoing (backend buffer upstream-location) (let ((incoming (vc--incoming-revision backend upstream-location)) diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 5c7930f12af..150d5c4a6e0 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -984,7 +984,7 @@ contains key `:tags' use its value as tests tags." (should (package-vc-tests-package-vc-async-wait 5 1 '("log" "--decorate") - (package-vc-log-incoming (package-vc-tests-package-desc pkg t)) + (package-vc-root-log-incoming (package-vc-tests-package-desc pkg t)) t)) (let ((incoming-buffer (get-buffer "*vc-incoming*")) (pattern (rx (literal From ad14c8d084f97aae42f439529ea80cfb15c0c0a3 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 14 Jan 2026 14:33:46 +0000 Subject: [PATCH 135/325] ; * test/lisp/vc/vc-tests/vc-tests.el: Fix authorship metadata. --- test/lisp/vc/vc-tests/vc-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/vc/vc-tests/vc-tests.el b/test/lisp/vc/vc-tests/vc-tests.el index 153c48d7bdf..ca79a340a46 100644 --- a/test/lisp/vc/vc-tests/vc-tests.el +++ b/test/lisp/vc/vc-tests/vc-tests.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2014-2026 Free Software Foundation, Inc. ;; Author: Michael Albinus -;; Author: Sean Whitton +;; Sean Whitton ;; This file is part of GNU Emacs. ;; From 1e6d8e675025d703ff56bf2dd02264c78c0c7331 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 14 Jan 2026 20:07:23 +0200 Subject: [PATCH 136/325] * lisp/progmodes/project.el: Improve performance of 'project-mode-line'. (project-name-cache-timeout): New variable. (project-name-cached): New function (bug#78545). (project-mode-line): New value 'non-remote'. (project-mode-line-format): Don't show the remote project's name when 'project-mode-line' is 'non-remote'. Use 'project-name-cached'. --- lisp/progmodes/project.el | 38 ++++++++++++++++++++++++++++++++------ 1 file changed, 32 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4f3e19bd981..4a01f3bc4a1 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -591,7 +591,7 @@ See `project-vc-extra-root-markers' for the marker value format.") ;; FIXME: Learn to invalidate when the value changes: ;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'. (or (vc-file-getprop dir 'project-vc) - ;; FIXME: Cache for a shorter time. + ;; FIXME: Cache for a shorter time (bug#78545). (let ((res (project-try-vc--search dir))) (and res (vc-file-setprop dir 'project-vc res)) res))) @@ -2627,13 +2627,37 @@ would otherwise have the same name." ;;; Project mode-line +(defvar project-name-cache-timeout 300 + "Number of seconds to cache the project name. +Used by `project-name-cached'.") + +(defun project-name-cached (dir) + "Return the cached project name for the directory DIR. +Until it's cached, retrieve the project name using `project-current' +and `project-name', then put the name to the cache for the time defined +by the variable `project-name-cache-timeout'. This function is useful +for project indicators such as on the mode line." + (let ((cached (vc-file-getprop dir 'project-name)) + (current-time (float-time))) + (if (and cached (< (- current-time (cdr cached)) + project-name-cache-timeout)) + (let ((value (car cached))) + (if (eq value 'none) nil value)) + (let ((res (when-let* ((project (project-current nil dir))) + (project-name project)))) + (vc-file-setprop dir 'project-name (cons (or res 'none) current-time)) + res)))) + ;;;###autoload (defcustom project-mode-line nil "Whether to show current project name and Project menu on the mode line. This feature requires the presence of the following item in `mode-line-format': `(project-mode-line project-mode-line-format)'; it -is part of the default mode line beginning with Emacs 30." - :type 'boolean +is part of the default mode line beginning with Emacs 30. When the +value is `non-remote', show the project name only for local files." + :type '(choice (const :tag "Don't show" nil) + (const :tag "Show only on non-remote files" non-remote) + (const :tag "Show always" t)) :group 'project :version "30.1") @@ -2651,18 +2675,20 @@ is part of the default mode line beginning with Emacs 30." (defun project-mode-line-format () "Compose the project mode-line." - (when-let* ((project (project-current))) + (unless (and (eq project-mode-line 'non-remote) + (file-remote-p default-directory)) ;; Preserve the global value of 'last-coding-system-used' ;; that 'write-region' needs to set for 'basic-save-buffer', ;; but updating the mode line might occur at the same time ;; during saving the buffer and 'project-name' can change ;; 'last-coding-system-used' when reading the project name ;; from .dir-locals.el also enables flyspell-mode (bug#66825). - (let ((last-coding-system-used last-coding-system-used)) + (when-let* ((last-coding-system-used last-coding-system-used) + (project-name (project-name-cached default-directory))) (concat " " (propertize - (project-name project) + project-name 'face project-mode-line-face 'mouse-face 'mode-line-highlight 'help-echo "mouse-1: Project menu" From 72cd956564259e53d0c4e670c278a97536a9a281 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Tue, 13 Jan 2026 14:28:05 -0500 Subject: [PATCH 137/325] Add new up-down option for minibuffer-visible-completions * lisp/emacs-lisp/crm.el (completing-read-multiple): Call 'minibuffer-visible-completions--maybe-compose-map'. * lisp/minibuffer.el (completion-in-region-mode): Call 'minibuffer-visible-completions--maybe-compose-map'. (minibuffer-visible-completions): Add new value 'up-down' (bug#80024). (minibuffer-visible-completions-up-down-map): Add. (minibuffer-visible-completions--maybe-compose-map): Add helper function. (completing-read-default): Call 'minibuffer-visible-completions--maybe-compose-map'. * lisp/simple.el (completion-setup-function): Check 'minibuffer-visible-completions' is t, not just non-nil. --- lisp/emacs-lisp/crm.el | 6 +----- lisp/minibuffer.el | 30 +++++++++++++++++++----------- lisp/simple.el | 2 +- 3 files changed, 21 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index b91fa165986..6bd763d2ea2 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -254,11 +254,7 @@ with empty strings removed." (let* ((map (if require-match crm-local-must-match-map crm-local-completion-map)) - (map (if minibuffer-visible-completions - (make-composed-keymap - (list minibuffer-visible-completions-map - map)) - map)) + (map (minibuffer-visible-completions--maybe-compose-map map)) (buffer (current-buffer)) input) (minibuffer-with-setup-hook diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1c888e4012a..30b1ee781c8 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3181,11 +3181,7 @@ Also respects the obsolete wrapper hook `completion-in-region-functions'. (setq-local minibuffer-completion-auto-choose nil) (add-hook 'post-command-hook #'completion-in-region--postch) (let* ((keymap completion-in-region-mode-map) - (keymap (if minibuffer-visible-completions - (make-composed-keymap - (list minibuffer-visible-completions-map - keymap)) - keymap))) + (keymap (minibuffer-visible-completions--maybe-compose-map keymap))) (push `(completion-in-region-mode . ,keymap) minor-mode-overriding-map-alist)))) @@ -3458,7 +3454,9 @@ the highlighted completion candidate. If the *Completions* buffer is not displayed on the screen, or this variable is nil, the arrow keys move point in the minibuffer as usual, and `RET' accepts the input typed into the minibuffer." - :type 'boolean + :type '(choice (const :tag "Disable completions navigation" nil) + (const :tag "Enable up/down/left/right" t) + (const :tag "Enable only up/down" up-down)) :version "30.1") (defvar minibuffer-visible-completions--always-bind nil @@ -3503,6 +3501,20 @@ displaying the *Completions* buffer exists." "" (minibuffer-visible-completions--bind #'minibuffer-previous-line-completion) "" (minibuffer-visible-completions--bind #'minibuffer-next-line-completion) "C-g" (minibuffer-visible-completions--bind #'minibuffer-hide-completions)) + +(defvar-keymap minibuffer-visible-completions-up-down-map + :doc "Local keymap for minibuffer input with visible completions, only for up/down." + "" (minibuffer-visible-completions--bind #'minibuffer-previous-completion) + "" (minibuffer-visible-completions--bind #'minibuffer-next-completion)) + +(defun minibuffer-visible-completions--maybe-compose-map (map) + (cond + ((eq minibuffer-visible-completions 'up-down) + (make-composed-keymap (list minibuffer-visible-completions-up-down-map map))) + ((eq minibuffer-visible-completions t) + (make-composed-keymap (list minibuffer-visible-completions-map map))) + (t map))) + ;;; Completion tables. @@ -5158,11 +5170,7 @@ See `completing-read' for the meaning of the arguments." ;; in minibuffer-local-filename-completion-map can ;; override bindings in base-keymap. base-keymap))) - (keymap (if minibuffer-visible-completions - (make-composed-keymap - (list minibuffer-visible-completions-map - keymap)) - keymap)) + (keymap (minibuffer-visible-completions--maybe-compose-map keymap)) (buffer (current-buffer)) (c-i-c completion-ignore-case) (result diff --git a/lisp/simple.el b/lisp/simple.el index d79aa2d3046..f06e473d383 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -10730,7 +10730,7 @@ Called from `temp-buffer-show-hook'." (if (display-mouse-p) "Click or type \\[minibuffer-choose-completion] on a completion to select it.\n" "Type \\[minibuffer-choose-completion] on a completion to select it.\n")) - (if minibuffer-visible-completions + (if (eq minibuffer-visible-completions t) (substitute-command-keys "Type \\[minibuffer-next-completion], \\[minibuffer-previous-completion], \ \\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \ From ea5d079e262837c302467c6656b82aed98097f94 Mon Sep 17 00:00:00 2001 From: Paul Nelson Date: Mon, 15 Dec 2025 17:25:47 +0100 Subject: [PATCH 138/325] Allow Ispell to save corrections as abbrevs * lisp/textmodes/ispell.el (ispell-save-corrections-as-abbrevs): New user option. (ispell--abbrev-saving-allowed) (ispell--save-correction-as-abbrev): New variables. (ispell--maybe-save-correction-abbrev): New function. (ispell-word, ispell-process-line): Use them to save corrections as abbrevs when appropriate (bug#79985). (ispell-command-loop): Add C-u as command character to toggle abbrev saving for an immediately following replacement command. (ispell-help): Document C-u binding. * doc/emacs/fixit.texi (Spelling): Document new feature. --- doc/emacs/fixit.texi | 13 ++++ etc/NEWS | 8 +++ lisp/textmodes/ispell.el | 152 ++++++++++++++++++++++++++++----------- 3 files changed, 133 insertions(+), 40 deletions(-) diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 131fcd1d6ae..3c72e5fad43 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -343,6 +343,19 @@ numbered @dfn{near-misses}---words that are close to the incorrect word. Then you must type a single-character response. Here are the valid responses: +@vindex ispell-save-corrections-as-abbrevs + You can have Ispell remember your spelling corrections so that they +are applied automatically when Abbrev mode is enabled (@pxref{Abbrevs}). +The user option @code{ispell-save-corrections-as-abbrevs} determines +whether Ispell does so by default. With that option enabled, each time +you correct a misspelled word, Emacs saves the correction as a global +abbrev expansion. Then, whenever you type the misspelling and then a +word-separator (@key{SPC}, comma, etc.) in a buffer with Abbrev mode +enabled, Emacs will expand the misspelling to its correction. +Regardless of this option's value, you can toggle abbrev saving for a +single correction by typing @kbd{C-u} immediately before selecting a +replacement in the command loop. + @table @kbd @item @var{digit} Replace the word, just this time, with one of the displayed diff --git a/etc/NEWS b/etc/NEWS index 9e5c070fd8c..cc853c0c1e3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2077,6 +2077,14 @@ option 'doc-view-djvused-program'. The default value is now 30 seconds, as the old value was too short to allow reading the help text. ++++ +*** Ispell can now save spelling corrections as abbrevs. +In the Ispell command loop, type 'C-u' immediately before selecting a +replacement to toggle whether that correction will be saved as a global +abbrev expansion for its misspelling. The new user option +'ispell-save-corrections-as-abbrevs' determines whether abbrev saving +is enabled by default. + ** Flyspell --- diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index e74064a3833..94447ad551b 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -164,6 +164,16 @@ may produce undesired results." Uses `query-replace' (\\[query-replace]) for corrections." :type 'boolean) +(defcustom ispell-save-corrections-as-abbrevs nil + "Whether to save spelling corrections as abbrevs by default. +Determines the default behavior of Ispell after correcting a misspelled +word. Non-nil means to save a global abbrev that expands the misspelled +word to its correction. This behavior may be toggled on a per-word +basis by typing \\`C-u' immediately before selecting a replacement in +the Ispell command loop." + :type 'boolean + :version "31.1") + (defcustom ispell-skip-tib nil "Does not spell check `tib' bibliography references when non-nil. Skips any text between strings matching regular expressions @@ -1821,6 +1831,28 @@ Only works for Aspell and Enchant." (and (or ispell-really-aspell ispell-really-enchant) (ispell-send-string (concat "$$ra " misspelled "," replacement "\n")))) +(defvar ispell--abbrev-saving-allowed nil + "Non-nil means the current `ispell-command-loop' supports abbrev saving. +Dynamically bound around calls to `ispell-command-loop' for which it +makes sense to allow abbrev saving. This includes calls from functions +like `ispell-word' and `ispell-region', but excludes calls from +functions like `ispell-complete-word'.") + +(defvar ispell--save-correction-as-abbrev nil + "Non-nil means save the current correction as an abbrev. +Dynamically bound to the value of `ispell-save-corrections-as-abbrevs' +around calls to `ispell-command-loop'. The command loop can toggle +this, via `C-u', to control abbrev saving for the immediately following +replacement command (a selection from the suggestion list, or +\\`r'/\\`R').") + +(defun ispell--maybe-save-correction-abbrev (misspelled replacement) + "Save MISSPELLED -> REPLACEMENT as an abbrev, if enabled. +This is controlled by the variable `ispell--save-correction-as-abbrev'." + (require 'abbrev) + (when ispell--save-correction-as-abbrev + (define-abbrev global-abbrev-table misspelled replacement) + (message "\"%s\" now expands to \"%s\" globally" misspelled replacement))) (defun ispell-send-string (string) "Send the string STRING to the Ispell process." @@ -1971,38 +2003,42 @@ quit spell session exited." (message "%s is incorrect" (funcall ispell-format-word-function word)))) (t ; prompt for correct word. - (save-window-excursion - (setq replace (ispell-command-loop - (car (cdr (cdr poss))) - (car (cdr (cdr (cdr poss)))) - (car poss) start end))) - (cond ((equal 0 replace) - (ispell-add-per-file-word-list (car poss))) - (replace - (setq new-word (if (atom replace) replace (car replace)) - cursor-location (+ (- (length word) (- end start)) - cursor-location)) - (if (not (equal new-word (car poss))) - (progn - (goto-char start) - ;; Insert first and then delete, - ;; to avoid collapsing markers before and after - ;; into a single place. - (insert new-word) - (delete-region (point) end) - ;; It is meaningless to preserve the cursor position - ;; inside a word that has changed. - (setq cursor-location (point)) - (setq end (point)))) - (if (not (atom replace)) ;recheck spelling of replacement - (progn - (if (car (cdr replace)) ; query replace requested - (save-window-excursion - (query-replace word new-word t))) - (goto-char start) - ;; single word could be split into multiple words - (setq ispell-quit (not (ispell-region start end))) - )))) + (let ((ispell--abbrev-saving-allowed t) + (ispell--save-correction-as-abbrev + ispell-save-corrections-as-abbrevs)) + (save-window-excursion + (setq replace (ispell-command-loop + (car (cdr (cdr poss))) + (car (cdr (cdr (cdr poss)))) + (car poss) start end))) + (cond ((equal 0 replace) + (ispell-add-per-file-word-list (car poss))) + (replace + (setq new-word (if (atom replace) replace (car replace)) + cursor-location (+ (- (length word) (- end start)) + cursor-location)) + (ispell--maybe-save-correction-abbrev (car poss) new-word) + (if (not (equal new-word (car poss))) + (progn + (goto-char start) + ;; Insert first and then delete, + ;; to avoid collapsing markers before and after + ;; into a single place. + (insert new-word) + (delete-region (point) end) + ;; It is meaningless to preserve the cursor position + ;; inside a word that has changed. + (setq cursor-location (point)) + (setq end (point)))) + (if (not (atom replace)) ;recheck spelling of replacement + (progn + (if (car (cdr replace)) ; query replace requested + (save-window-excursion + (query-replace word new-word t))) + (goto-char start) + ;; single word could be split into multiple words + (setq ispell-quit (not (ispell-region start end))) + ))))) ;; keep if rechecking word and we keep choices win. (if (get-buffer ispell-choices-buffer) (kill-buffer ispell-choices-buffer)))) @@ -2167,9 +2203,12 @@ Global `ispell-quit' is set to start location to continue spell session." (choices miss) (window-min-height (min window-min-height ispell-choices-win-default-height)) - (command-characters '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m )) + (command-characters + (append '( ? ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ) + (and ispell--abbrev-saving-allowed + '(?\C-u)))) (skipped 0) - char num result textwin) + char num result textwin abbrev-prefix) ;; setup the *Choices* buffer with valid data. (with-current-buffer (get-buffer-create ispell-choices-buffer) @@ -2235,8 +2274,14 @@ Global `ispell-quit' is set to start location to continue spell session." (progn (undo-boundary) (let (message-log-max) - (message (concat "C-h or ? for more options; SPC to leave " - "unchanged, Character to replace word"))) + (message + (concat + "C-h or ? for more options; SPC to leave " + "unchanged, Character to replace word" + (and ispell--abbrev-saving-allowed abbrev-prefix + (if ispell--save-correction-as-abbrev + " [won't save as abbrev]" + " [will save as abbrev]"))))) (let ((inhibit-quit t) (input-valid t)) (setq char nil skipped 0) @@ -2262,6 +2307,22 @@ Global `ispell-quit' is set to start location to continue spell session." (setq com-chars (cdr com-chars))) (setq num (- char ?0 skipped))) + (if (and abbrev-prefix + (or (memq char '(?r ?R)) + (and (>= num 0) (< num count)))) + ;; If the user typed `C-u' before this replacement + ;; command, then toggle abbrev saving for this + ;; correction. + (setq ispell--save-correction-as-abbrev + (not ispell--save-correction-as-abbrev) + abbrev-prefix nil) + ;; If the user typed `C-u' but not before a + ;; replacement command, then nullify the effect of + ;; `C-u' for subsequent commands. + (when (and abbrev-prefix + (not (= char ?\C-u))) + (setq abbrev-prefix nil))) + (cond ((= char ? ) nil) ; accept word this time only ((= char ?i) ; accept and insert word into pers dict @@ -2419,6 +2480,9 @@ Global `ispell-quit' is set to start location to continue spell session." ((= char ?\C-z) (funcall (key-binding "\C-z")) t) + ((and (= char ?\C-u) ispell--abbrev-saving-allowed) + (setq abbrev-prefix (not abbrev-prefix)) + t) (t (ding) t)))))) result) ;; protected @@ -2463,6 +2527,7 @@ Selections are: \\`m' Place typed-in value in personal dictionary, then recheck current word. \\`C-l' Redraw screen. \\`C-r' Recursive edit. +\\`C-u' Toggle abbrev saving for the immediately following replacement command. \\`C-z' Suspend Emacs or iconify frame." (if (equal ispell-help-in-bufferp 'electric) @@ -2497,6 +2562,7 @@ Selections are: \\`m' Place typed-in value in personal dictionary, then recheck current word. \\`C-l' Redraw screen. \\`C-r' Recursive edit. +\\`C-u' Toggle abbrev saving for the immediately following replacement command. \\`C-z' Suspend Emacs or iconify frame.")) nil))) @@ -2506,12 +2572,14 @@ Selections are: (help-2 (concat "[l]ook a word up in alternate dictionary; " "e[x/X]it; [q]uit session")) (help-3 (concat "[u]ncapitalized insert into dict. " - "Type `x C-h f ispell-help' for more help"))) + (and ispell--abbrev-saving-allowed + "C-u toggles abbrev saving (next replacement)."))) + (help-4 (concat "Type `x C-h f ispell-help' for more help"))) (save-window-excursion (if ispell-help-in-bufferp (let ((buffer (get-buffer-create "*Ispell Help*"))) (with-current-buffer buffer - (insert (concat help-1 "\n" help-2 "\n" help-3))) + (insert (concat help-1 "\n" help-2 "\n" help-3 "\n" help-4))) (ispell-display-buffer buffer) (sit-for (max 0.5 ispell-help-timeout)) (kill-buffer "*Ispell Help*")) @@ -2522,7 +2590,7 @@ Selections are: (message nil) ;;(set-minibuffer-window (selected-window)) (enlarge-window 2) - (insert (concat help-1 "\n" help-2 "\n" help-3)) + (insert (concat help-1 "\n" help-2 "\n" help-3 "\n" help-4)) (sit-for (max 0.5 ispell-help-timeout))) (erase-buffer))))))) @@ -3505,7 +3573,9 @@ word that was queried about." (word-len (length (car poss))) (line-end (copy-marker ispell-end)) (line-start (copy-marker ispell-start)) - recheck-region replace) + recheck-region replace + (ispell--abbrev-saving-allowed t) + (ispell--save-correction-as-abbrev ispell-save-corrections-as-abbrevs)) (goto-char word-start) ;; Adjust the horizontal scroll & point (ispell-horiz-scroll) @@ -3573,11 +3643,13 @@ word that was queried about." (progn (insert replace) ; Insert dictionary word. (ispell-send-replacement (car poss) replace) + (ispell--maybe-save-correction-abbrev (car poss) replace) (setq accept-list (cons replace accept-list))) (let ((replace-word (car replace))) ;; Recheck hand entered replacement word. (insert replace-word) (ispell-send-replacement (car poss) replace-word) + (ispell--maybe-save-correction-abbrev (car poss) replace-word) (if (car (cdr replace)) (save-window-excursion (delete-other-windows) ; to correctly show help. From 02966c8db5df5d779da36dada1645d7ae384064e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 14 Jan 2026 18:48:36 +0000 Subject: [PATCH 139/325] ; Improve docs for last change. --- doc/emacs/fixit.texi | 27 ++++++++++++++------------- lisp/textmodes/ispell.el | 6 +++--- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 3c72e5fad43..36a27a78dda 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -343,19 +343,6 @@ numbered @dfn{near-misses}---words that are close to the incorrect word. Then you must type a single-character response. Here are the valid responses: -@vindex ispell-save-corrections-as-abbrevs - You can have Ispell remember your spelling corrections so that they -are applied automatically when Abbrev mode is enabled (@pxref{Abbrevs}). -The user option @code{ispell-save-corrections-as-abbrevs} determines -whether Ispell does so by default. With that option enabled, each time -you correct a misspelled word, Emacs saves the correction as a global -abbrev expansion. Then, whenever you type the misspelling and then a -word-separator (@key{SPC}, comma, etc.) in a buffer with Abbrev mode -enabled, Emacs will expand the misspelling to its correction. -Regardless of this option's value, you can toggle abbrev saving for a -single correction by typing @kbd{C-u} immediately before selecting a -replacement in the command loop. - @table @kbd @item @var{digit} Replace the word, just this time, with one of the displayed @@ -431,6 +418,20 @@ Suspend Emacs or iconify the selected frame. Show the list of options. @end table +@vindex ispell-save-corrections-as-abbrevs + You can have Ispell remember your spelling corrections so that they +are applied automatically when Abbrev mode is enabled (@pxref{Abbrevs}). +If you customize @code{ispell-save-corrections-as-abbrevs} to a non-nil +value, then each time you correct a misspelled word, Emacs saves the +correction as a global abbrev. Then, whenever you type the misspelling +and then a word-separator (@key{SPC}, comma, etc.) in a buffer with +Abbrev mode enabled, Emacs expands the misspelling to its correction. +You can override this and disable saving a particular correction by +supplying a @kbd{C-u} prefix argument when selecting a replacement. If +@code{ispell-save-corrections-as-abbrevs} has its default value of nil, +the meaning of a prefix argument is inverted, in that typing @kbd{C-u} +before selecting a replacement @emph{does} save a global abbrev. + Use the command @kbd{M-@key{TAB}} (@code{completion-at-point}) to complete the word at point. Insert the beginning of a word, and then type @kbd{M-@key{TAB}} to select from a list of completions. (If your diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 94447ad551b..cef9e03ca49 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1842,7 +1842,7 @@ functions like `ispell-complete-word'.") "Non-nil means save the current correction as an abbrev. Dynamically bound to the value of `ispell-save-corrections-as-abbrevs' around calls to `ispell-command-loop'. The command loop can toggle -this, via `C-u', to control abbrev saving for the immediately following +this, via `C-u', to control abbrev saving for an immediately subsequent replacement command (a selection from the suggestion list, or \\`r'/\\`R').") @@ -2527,7 +2527,7 @@ Selections are: \\`m' Place typed-in value in personal dictionary, then recheck current word. \\`C-l' Redraw screen. \\`C-r' Recursive edit. -\\`C-u' Toggle abbrev saving for the immediately following replacement command. +\\`C-u' Toggle abbrev saving for an immediately subsequent replacement command. \\`C-z' Suspend Emacs or iconify frame." (if (equal ispell-help-in-bufferp 'electric) @@ -2562,7 +2562,7 @@ Selections are: \\`m' Place typed-in value in personal dictionary, then recheck current word. \\`C-l' Redraw screen. \\`C-r' Recursive edit. -\\`C-u' Toggle abbrev saving for the immediately following replacement command. +\\`C-u' Toggle abbrev saving for an immediately subsequent replacement command. \\`C-z' Suspend Emacs or iconify frame.")) nil))) From e7c5ab20154458d5cfaa002d7887f8f6f111153b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 14 Jan 2026 17:39:53 +0100 Subject: [PATCH 140/325] ; * lisp/emacs-lisp/regexp-opt.el (regexp-opt-group): Clarify intent. --- lisp/emacs-lisp/regexp-opt.el | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 68bd93422ae..27c558ae349 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -209,10 +209,7 @@ Merges keywords to avoid backtracking in Emacs's regexp matcher." ;; ;; If there are several one-char strings, use charsets ((and (= (length (car strings)) 1) - (let ((strs (cdr strings))) - (while (and strs (/= (length (car strs)) 1)) - (pop strs)) - strs)) + (any (lambda (s) (= (length s) 1)) (cdr strings))) (let (letters rest) ;; Collect one-char strings (dolist (s strings) From 256210477dd301331a6e9d55504d8e28ec74ba39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 14 Jan 2026 19:56:14 +0100 Subject: [PATCH 141/325] ; * test/lisp/progmodes/eglot-tests.el (eglot--wait-for): escape $ --- test/lisp/progmodes/eglot-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el index 0924058121f..7267754dc7d 100644 --- a/test/lisp/progmodes/eglot-tests.el +++ b/test/lisp/progmodes/eglot-tests.el @@ -259,7 +259,7 @@ directory hierarchy." do (unless ;; $/progress is *truly* uninteresting and spammy - (and (string-match "$/progress" (format "%s" method))) + (string-match "\\$/progress" (format "%s" method)) (eglot--test-message "skip uninteresting event %s[%s]" (plist-get json :method) From 4af7b4ce04559dc2ee60777e56f09cb0eb63984e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Jan 2026 15:27:51 -0500 Subject: [PATCH 142/325] (package-install): Fix accidental regression * lisp/emacs-lisp/package.el (package-install): Remove code re-added probably by erroneous merge. --- lisp/emacs-lisp/package.el | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f1bdeefc226..4e0bbdd514c 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2033,10 +2033,6 @@ had been enabled." nil 'interactive))) (cl-check-type pkg (or symbol package-desc)) - (when (or (and package-install-upgrade-built-in - (package--active-built-in-p pkg)) - (package-installed-p pkg)) - (user-error "Package is already installed")) (package--archives-initialize) (add-hook 'post-command-hook #'package-menu--post-refresh) (let ((name (if (package-desc-p pkg) From 9c1da99a850065bc5740ee9ae3466844dc47ab11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Mon, 12 Jan 2026 13:36:21 -0500 Subject: [PATCH 143/325] Optionally inhibit echo area progress reporting (bug#80198) Add an optional 'context' argument to 'make-progress-reporter' which 'progress-reporter-echo-area' consults to inhibit updates if the context is 'async' and the echo area is busy. * lisp/subr.el (make-progress-reporter): Add the optional 'context' argument. (progress-reporter-context): New defun accessor. (progress-reporter-echo-area): Consult 'progress-reporter-context'. * doc/lispref/display.texi: Document context. * etc/NEWS: Announce context. --- doc/lispref/display.texi | 20 +++++++++------- etc/NEWS | 8 +++++++ lisp/subr.el | 49 +++++++++++++++++++++++++++------------- 3 files changed, 53 insertions(+), 24 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 892ed241cfe..bb9268c7efd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -486,7 +486,7 @@ A convenient way to do this is to use a @dfn{progress reporter}. (progress-reporter-done progress-reporter)) @end smallexample -@defun make-progress-reporter message &optional min-value max-value current-value min-change min-time +@defun make-progress-reporter message &optional min-value max-value current-value min-change min-time context This function creates and returns a progress reporter object, which you will use as an argument for the other functions listed below. The idea is to precompute as much data as possible to make progress @@ -513,13 +513,17 @@ If @var{min-value} and @var{max-value} are numbers, you can give the argument @var{current-value} a numerical value specifying the initial progress; if omitted, this defaults to @var{min-value}. -The remaining arguments control the rate of echo area updates. The -progress reporter will wait for at least @var{min-change} more -percents of the operation to be completed before printing next -message; the default is one percent. @var{min-time} specifies the -minimum time in seconds to pass between successive prints; the default -is 0.2 seconds. (On some operating systems, the progress reporter may -handle fractions of seconds with varying precision). +The arguments @var{min-change} and @var{min-time} control the rate of +echo area updates. The progress reporter will wait for at least +@var{min-change} more percents of the operation to be completed before +printing next message; the default is one percent. @var{min-time} +specifies the minimum time in seconds to pass between successive prints; +the default is 0.2 seconds. (On some operating systems, the progress +reporter may handle fractions of seconds with varying precision). + +If @var{context} is the symbol @code{async}, updates in the echo area +are inhibited when it is busy, i.e., if the function 'current-message' +returns non-nil. This function calls @code{progress-reporter-update}, so the first message is printed immediately. diff --git a/etc/NEWS b/etc/NEWS index cc853c0c1e3..d9904b7de7b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3912,6 +3912,14 @@ called on progress steps, and DONE-CALLBACK, called when the progress reporter is done. See the 'make-progress-reporter' docstring for a full specification of these new optional arguments. ++++ +** Progress reporter context. +'make-progress-reporter' now accepts the optional argument CONTEXT, +which if it is the symbol 'async', inhibits updates in the echo area +when it is busy, i.e., if the function 'current-message' returns +non-nil. This is useful, for example, if you want to monitor progress +of an inherently asynchronous command such as 'compile'. + ** Binary format specifications '%b' and '%B' added. These produce the binary representation of a number. '%#b' and '%#B' prefix the bits with '0b' and '0B', respectively. diff --git a/lisp/subr.el b/lisp/subr.el index 63c3e8b8684..4c8518ec68c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7007,7 +7007,8 @@ nothing." (progress-reporter-do-update reporter value suffix))) (defun make-progress-reporter (message &optional min-value max-value - current-value min-change min-time) + current-value min-change min-time + context) "Return progress reporter object for use with `progress-reporter-update'. MESSAGE is shown in the echo area, with a status indicator @@ -7034,7 +7035,11 @@ and/or MAX-VALUE are nil. Optional MIN-TIME specifies the minimum interval time between echo area updates (default is 0.2 seconds.) If the OS is not capable of measuring fractions of seconds, this parameter is -effectively rounded up." +effectively rounded up. + +Optional CONTEXT is consulted by back ends before showing progress +updates. If the symbol `async', echo area progress reports may be +inhibited if the echo area is busy." (when (string-match "[[:alnum:]]\\'" message) (setq message (concat message "..."))) (unless min-time @@ -7049,7 +7054,9 @@ effectively rounded up." (if min-change (max (min min-change 50) 1) 1) min-time ;; SUFFIX - nil)))) + nil + ;; + context)))) ;; Force a call to `message' now. (progress-reporter-update reporter (or current-value min-value)) reporter)) @@ -7060,6 +7067,10 @@ effectively rounded up." "Return REPORTER's text." (aref (cdr reporter) 3)) +(defun progress-reporter-context (reporter) + "Return REPORTER's context." + (aref (cdr reporter) 7)) + (defun progress-reporter-force-update (reporter &optional value new-message suffix) "Report progress of an operation in the echo area unconditionally. @@ -7078,20 +7089,26 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter." (defun progress-reporter-echo-area (reporter state) "Progress reporter echo area update function. REPORTER and STATE are the same as in -`progress-reporter-update-functions'." +`progress-reporter-update-functions'. + +Do not emit a message if the reporter context is `async' and the echo +area is busy with something else." (let ((text (progress-reporter-text reporter))) - (pcase state - ((pred floatp) - (if (plusp state) - (message "%s%d%%" text (* state 100.0)) - (message "%s" text))) - ((pred integerp) - (let ((message-log-max nil) - (pulse-char (aref progress-reporter--pulse-characters - state))) - (message "%s %s" text pulse-char))) - ('done - (message "%sdone" text))))) + (unless (and (eq (progress-reporter-context reporter) 'async) + (current-message) + (not (string-prefix-p text (current-message)))) + (pcase state + ((pred floatp) + (if (plusp state) + (message "%s%d%%" text (* state 100.0)) + (message "%s" text))) + ((pred integerp) + (let ((message-log-max nil) + (pulse-char (aref progress-reporter--pulse-characters + state))) + (message "%s %s" text pulse-char))) + ('done + (message "%sdone" text)))))) (defun progress-reporter-do-update (reporter value &optional suffix) (let* ((parameters (cdr reporter)) From c6b62b42e01d273131114239618b2a3f8f182c1e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Jan 2026 16:25:57 -0500 Subject: [PATCH 144/325] (make-progress-reporter): Tweak wording of CONTEXT doc --- doc/lispref/display.texi | 8 +++++--- etc/NEWS | 3 +-- lisp/subr.el | 7 ++++--- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index bb9268c7efd..a163aa9f97c 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -521,9 +521,11 @@ specifies the minimum time in seconds to pass between successive prints; the default is 0.2 seconds. (On some operating systems, the progress reporter may handle fractions of seconds with varying precision). -If @var{context} is the symbol @code{async}, updates in the echo area -are inhibited when it is busy, i.e., if the function 'current-message' -returns non-nil. +If @var{context} is the symbol @code{async}, it announces that the updates +will occur asynchronously. Backends can use that info to prevent the +progress updates from interfering with other data. For example the +backend that displays the progress in the echo area will not display +those async updates when the echo area is in use. This function calls @code{progress-reporter-update}, so the first message is printed immediately. diff --git a/etc/NEWS b/etc/NEWS index d9904b7de7b..d4c4c5c6174 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3916,8 +3916,7 @@ specification of these new optional arguments. ** Progress reporter context. 'make-progress-reporter' now accepts the optional argument CONTEXT, which if it is the symbol 'async', inhibits updates in the echo area -when it is busy, i.e., if the function 'current-message' returns -non-nil. This is useful, for example, if you want to monitor progress +when it is busy. This is useful, for example, if you want to monitor progress of an inherently asynchronous command such as 'compile'. ** Binary format specifications '%b' and '%B' added. diff --git a/lisp/subr.el b/lisp/subr.el index 4c8518ec68c..d307a07f05b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7037,15 +7037,16 @@ echo area updates (default is 0.2 seconds.) If the OS is not capable of measuring fractions of seconds, this parameter is effectively rounded up. -Optional CONTEXT is consulted by back ends before showing progress -updates. If the symbol `async', echo area progress reports may be -inhibited if the echo area is busy." +Optional CONTEXT can be nil or `async'. It is consulted by back ends before +showing progress updates. For example, when CONTEXT is `async', +the echo area progress reports may be muted if the echo area is busy." (when (string-match "[[:alnum:]]\\'" message) (setq message (concat message "..."))) (unless min-time (setq min-time 0.2)) (let ((reporter (cons (or min-value 0) + ;; FIXME: Use defstruct. (vector (if (>= min-time 0.02) (float-time) nil) min-value From 4d9abf0bdf5c50bd10ff159d23c77ba9b0e8a3ab Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 14 Jan 2026 16:52:09 -0500 Subject: [PATCH 145/325] (define-ibuffer-column): Fix corner case miscompilations (bug#80180) * lisp/ibuf-macs.el (define-ibuffer-column): Don't quote the SUMMARIZER functions as data. --- lisp/ibuf-macs.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 835a8b9aa15..d9cb1e7f88f 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -72,7 +72,8 @@ During evaluation of body, bind `it' to the value returned by TEST." ;;;###autoload (cl-defmacro define-ibuffer-column (symbol (&key name inline props summarizer - header-mouse-map) &rest body) + header-mouse-map) + &rest body) "Define a column SYMBOL for use with `ibuffer-formats'. BODY will be called with `buffer' bound to the buffer object, and @@ -112,19 +113,18 @@ change its definition, you should explicitly call `(defun ,sym (buffer mark) (ignore mark) ;Silence byte-compiler if mark is unused. ,bod)) - (put (quote ,sym) 'ibuffer-column-name + (put ',sym 'ibuffer-column-name ,(if (stringp name) name (capitalize (symbol-name symbol)))) - ,(if header-mouse-map `(put (quote ,sym) 'header-mouse-map ,header-mouse-map)) + ,(if header-mouse-map `(put ',sym 'header-mouse-map ,header-mouse-map)) ,(if summarizer ;; Store the name of the summarizing function. - `(put (quote ,sym) 'ibuffer-column-summarizer - (quote ,summarizer))) + `(put ',sym 'ibuffer-column-summarizer #',summarizer)) ,(if summarizer ;; This will store the actual values of the column ;; summary. - `(put (quote ,sym) 'ibuffer-column-summary nil)) + `(put ',sym 'ibuffer-column-summary nil)) :autoload-end))) ;;;###autoload From 0bae6d0e7b02aafba255801a655b4ec086a161fe Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Jan 2026 08:07:59 +0200 Subject: [PATCH 146/325] ; * doc/lispref/display.texi (Progress): Fix wording and punctuation. --- doc/lispref/display.texi | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index a163aa9f97c..458f2e51992 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -523,9 +523,10 @@ reporter may handle fractions of seconds with varying precision). If @var{context} is the symbol @code{async}, it announces that the updates will occur asynchronously. Backends can use that info to prevent the -progress updates from interfering with other data. For example the +progress updates from interfering with other data. For example, the backend that displays the progress in the echo area will not display -those async updates when the echo area is in use. +those async updates when the echo area or the minibuffer window are in +use. This function calls @code{progress-reporter-update}, so the first message is printed immediately. From b3870cba7704f0cc09ce91eb6cd19360cd9c190c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Jan 2026 08:10:48 +0200 Subject: [PATCH 147/325] ; * doc/lispref/display.texi (Progress): Revert inaccurate text. --- doc/lispref/display.texi | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 458f2e51992..5f92f23c694 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -525,8 +525,7 @@ If @var{context} is the symbol @code{async}, it announces that the updates will occur asynchronously. Backends can use that info to prevent the progress updates from interfering with other data. For example, the backend that displays the progress in the echo area will not display -those async updates when the echo area or the minibuffer window are in -use. +those async updates when the echo area is in use. This function calls @code{progress-reporter-update}, so the first message is printed immediately. From cd9ff47ba8071e722c28a89350730d5a9b0cc819 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Jan 2026 08:36:46 +0200 Subject: [PATCH 148/325] ; Update documentation due to a recent change * etc/NEWS: * doc/emacs/mini.texi (Completion Commands): * lisp/minibuffer.el (minibuffer-visible-completions): Update doc string, user manual, and NEWS to reflect changes for bug#80024. --- doc/emacs/mini.texi | 8 ++++++-- etc/NEWS | 7 +++++++ lisp/minibuffer.el | 20 ++++++++++++++------ 3 files changed, 27 insertions(+), 8 deletions(-) diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index bd39fe550d8..7936712d31c 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -500,7 +500,7 @@ completion buffer and delete the window showing it @vindex minibuffer-visible-completions If the variable @code{minibuffer-visible-completions} is customized to -a non-@code{nil} value, it changes the commands bound to the arrow keys: +the value @code{t}, it changes the commands bound to the arrow keys: instead of moving in the minibuffer, they move between completion candidates, like meta-arrow keys do by default (but note that, just as when the window showing the completion list is selected, here too, @@ -509,7 +509,11 @@ when the window showing the completion list is selected, here too, regardless of the completion list format). Similarly, @kbd{@key{RET}} selects the current candidate, like @kbd{M-@key{RET}} does normally. @code{C-g} hides the completion window, but leaves the minibuffer -active, so you can continue typing at the prompt. +active, so you can continue typing at the prompt. If the value of this +variable is @code{up-down}, only the @kbd{@key{UP}} and @kbd{@key{DOWN}} +arrow keys move point between completion candidates, while +@kbd{@key{RIGHT}} and @kbd{@key{LEFT}} move point in the minibuffer +window. @node Completion Exit @subsection Completion Exit diff --git a/etc/NEWS b/etc/NEWS index d4c4c5c6174..af8eb6da3fa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -199,6 +199,13 @@ different completion categories by customizing be updated as you type, or nil to suppress this always. Note that for large or inefficient completion tables this can slow down typing. ++++ +*** New optional value of 'minibuffer-visible-completions'. +If the value of this option is 'up-down', only the and arrow +keys move point between candidates shown in the *Completions* buffer +display, while and arrows move point in the minibuffer +window. + --- *** 'RET' chooses the completion selected with 'M-/M-'. If a completion candidate is selected with 'M-' or 'M-', diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 30b1ee781c8..1742421939e 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3446,17 +3446,25 @@ the mode hook of this mode." (setq-local minibuffer-completion-auto-choose nil))) (defcustom minibuffer-visible-completions nil - "Whether candidates shown in *Completions* can be navigated from minibuffer. + "Whether to enable navigation of candidates in *Completions* from minibuffer. When non-nil, if the *Completions* buffer is displayed in a window, -you can use the arrow keys in the minibuffer to move the cursor in +you can use the arrow keys in the minibuffer to move point in the window showing the *Completions* buffer. Typing `RET' selects the highlighted completion candidate. If the *Completions* buffer is not displayed on the screen, or this variable is nil, the arrow keys move point in the minibuffer as usual, -and `RET' accepts the input typed into the minibuffer." - :type '(choice (const :tag "Disable completions navigation" nil) - (const :tag "Enable up/down/left/right" t) - (const :tag "Enable only up/down" up-down)) +and `RET' accepts the input typed into the minibuffer. +If the value is t, both up/down and right/left arrow keys move point +in *Completions*; if the value is \\+`up-down', only up/down arrow +keys move point in *Completions*, while left/right arrows move point +in the minibuffer window." + :type '(choice (const :tag + "Disable completions navigation with arrow keys" nil) + (const :tag + "Enable completions navigation with arrow keys" t) + (const :tag + "Enable completions navigation with up/down arrows" + up-down)) :version "30.1") (defvar minibuffer-visible-completions--always-bind nil From 18f9f0bdc98c65f4ca3dd3f1f404cafd75a0150b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 15 Jan 2026 08:52:20 +0200 Subject: [PATCH 149/325] ; Update Project documentation due to recent changes * etc/NEWS: * doc/emacs/maintaining.texi (Projects): * lisp/progmodes/project.el (project-mode-line): Update documentation due to changes in bug#78545. --- doc/emacs/maintaining.texi | 5 ++++- etc/NEWS | 6 ++++++ lisp/progmodes/project.el | 6 +++--- 3 files changed, 13 insertions(+), 4 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 532d06fa835..0c6e5c820e7 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -2049,7 +2049,10 @@ project. See its entry below for description and related options. If this user option is non-@code{nil}, Emacs displays the name of the current project (if any) on the mode line; clicking @kbd{mouse-1} on the project name pops up the menu with the project-related commands. -The default value is @code{nil}. +The default value is @code{nil}. If the value is @code{non-remote}, +Emacs will show the name of the project only for local files; this comes +in handy when updating the mode line for projects on remote systems is +slow due to network latencies. @end defopt @menu diff --git a/etc/NEWS b/etc/NEWS index af8eb6da3fa..2e110b19c31 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -699,6 +699,12 @@ project, during completion. That makes some items shorter. The category defaults are the same as for 'buffer' but any user customizations would need to be re-added. ++++ +*** 'project-mode-line' can now show project name only for local files. +If the value of 'project-mode-line' is 'non-remote', project name and +the Project menu will be shown on the mode line only for projects with +local files. + ** Help +++ diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 4a01f3bc4a1..bea41c55760 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -2655,9 +2655,9 @@ This feature requires the presence of the following item in `mode-line-format': `(project-mode-line project-mode-line-format)'; it is part of the default mode line beginning with Emacs 30. When the value is `non-remote', show the project name only for local files." - :type '(choice (const :tag "Don't show" nil) - (const :tag "Show only on non-remote files" non-remote) - (const :tag "Show always" t)) + :type '(choice (const :tag "Don't show project on mode line" nil) + (const :tag "Show project only for local files" non-remote) + (const :tag "Always show project on mode line" t)) :group 'project :version "30.1") From a44c736c268ecd66bcbe6509af639dd87d310e04 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Thu, 15 Jan 2026 10:50:53 +0100 Subject: [PATCH 150/325] * Fix 'message' function signature * lisp/emacs-lisp/comp-common.el(comp-primitive-type-specifiers): Fix 'message' entry. --- lisp/emacs-lisp/comp-common.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el index bf86fc2e3cd..d81e800cc36 100644 --- a/lisp/emacs-lisp/comp-common.el +++ b/lisp/emacs-lisp/comp-common.el @@ -272,7 +272,7 @@ Used to modify the compiler environment." (member (function (t list) list)) (memq (function (t list) list)) (memql (function (t list) list)) - (message (function (string &rest t) string)) + (message (function ((or string null) &rest t) (or string null))) (min (function ((or number marker) &rest (or number marker)) number)) (minibuffer-selected-window (function () (or window null))) (minibuffer-window (function (&optional frame) window)) From c86067778b1978706a6bb4e15e4d324d192bbbb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rudolf=20Adamkovi=C4=8D?= Date: Fri, 2 Jan 2026 14:02:32 +0100 Subject: [PATCH 151/325] Update SQLite font-lock rules * lisp/progmodes/sql.el (sql-mode-sqlite-font-lock-keywords): Synchronize all SQLite keywords with the official documentation. --- lisp/progmodes/sql.el | 93 +++++++++++++++++++++++++++++-------------- 1 file changed, 64 insertions(+), 29 deletions(-) diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 31cbe274f47..a82a7884e40 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -2599,45 +2599,80 @@ you define your own `sql-mode-mysql-font-lock-keywords'.") '("^[.].*$" . font-lock-doc-face) ;; SQLite Keyword + ;; https://sqlite.org/lang_keywords.html (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" -"asc" "attach" "autoincrement" "before" "begin" "between" "by" -"cascade" "case" "cast" "check" "collate" "column" "commit" "conflict" -"constraint" "create" "cross" "database" "default" "deferrable" -"deferred" "delete" "desc" "detach" "distinct" "drop" "each" "else" -"end" "escape" "except" "exclusive" "exists" "explain" "fail" "for" -"foreign" "from" "full" "glob" "group" "having" "if" "ignore" -"immediate" "in" "index" "indexed" "initially" "inner" "insert" -"instead" "intersect" "into" "is" "isnull" "join" "key" "left" "like" -"limit" "match" "natural" "no" "not" "notnull" "null" "of" "offset" -"on" "or" "order" "outer" "plan" "pragma" "primary" "query" "raise" -"references" "regexp" "reindex" "release" "rename" "replace" -"restrict" "right" "rollback" "row" "savepoint" "select" "set" "table" -"temp" "temporary" "then" "to" "transaction" "trigger" "union" -"unique" "update" "using" "vacuum" "values" "view" "virtual" "when" -"where" +"abort" "action" "add" "after" "all" "alter" "always" "analyze" "and" "as" +"asc" "attach" "autoincrement" "before" "begin" "between" "by" "cascade" "case" +"cast" "check" "collate" "column" "commit" "conflict" "constraint" "create" +"cross" "current" "current_date" "current_time" "current_timestamp" "database" +"default" "deferrable" "deferred" "delete" "desc" "detach" "distinct" "do" +"drop" "each" "else" "end" "escape" "except" "exclude" "exclusive" "exists" +"explain" "fail" "filter" "first" "following" "for" "foreign" "from" "full" +"generated" "glob" "group" "groups" "having" "if" "ignore" "immediate" "in" +"index" "indexed" "initially" "inner" "insert" "instead" "intersect" "into" +"is" "isnull" "join" "key" "last" "left" "like" "limit" "match" "materialized" +"natural" "no" "not" "nothing" "notnull" "null" "nulls" "of" "offset" "on" "or" +"order" "others" "outer" "over" "partition" "plan" "pragma" "preceding" +"primary" "query" "raise" "range" "recursive" "references" "regexp" "reindex" +"release" "rename" "replace" "restrict" "returning" "right" "rollback" "row" +"rows" "savepoint" "select" "set" "table" "temp" "temporary" "then" "ties" "to" +"transaction" "trigger" "unbounded" "union" "unique" "update" "using" "vacuum" +"values" "view" "virtual" "when" "where" "window" "with" "without" ) ;; SQLite Data types + ;; https://sqlite.org/datatype3.html (sql-font-lock-keywords-builder 'font-lock-type-face nil -"int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned" -"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native" -"nvarchar" "text" "clob" "blob" "real" "double" "precision" "float" -"numeric" "number" "decimal" "boolean" "date" "datetime" +"int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned big int" +"int2" "int8" "character" "varchar" "varying character" "nchar" +"native character" "nvarchar" "text" "clob" "blob" "real" "double" +"double precision" "float" "umeric" "decimal" "boolean" "date" "datetime" + ) ;; SQLite Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil + ;; Core functions -"abs" "changes" "coalesce" "glob" "ifnull" "hex" "last_insert_rowid" -"length" "like" "load_extension" "lower" "ltrim" "max" "min" "nullif" -"quote" "random" "randomblob" "replace" "round" "rtrim" "soundex" -"sqlite_compileoption_get" "sqlite_compileoption_used" -"sqlite_source_id" "sqlite_version" "substr" "total_changes" "trim" -"typeof" "upper" "zeroblob" +;; https://sqlite.org/lang_corefunc.html +"abs" "changes" "char" "coalesce" "concat" "concat_ws" "format" "glob" "hex" +"if" "ifnull" "iif" "instr" "last_insert_rowid" "length" "like" "like" +"likelihood" "likely" "load_extension" "load_extension" "lower" "ltrim" "ltrim" +"max" "min" "nullif" "octet_length" "printf" "quote" "random" "randomblob" +"replace" "round" "round" "rtrim" "rtrim" "sign" "soundex" +"sqlite_compileoption_get" "sqlite_compileoption_used" "sqlite_offset" +"sqlite_source_id" "sqlite_version" "substr" "substr" "substring" "substring" +"total_changes" "trim" "trim" "typeof" "unhex" "unhex" "unicode" "unistr" +"unistr_quote" "unlikely" "upper" "zeroblob" + ;; Date/time functions -"time" "julianday" "strftime" -"current_date" "current_time" "current_timestamp" +;; https://sqlite.org/lang_datefunc.html +"date" "time" "datetime" "julianday" "unixepoch" "strftime" "timediff" + ;; Aggregate functions -"avg" "count" "group_concat" "max" "min" "sum" "total" +;; https://sqlite.org/lang_aggfunc.html +"avg" "count" "count" "group_concat" "group_concat" "max" "median" "min" +"percentile" "percentile_cont" "percentile_disc" "string_agg" "sum" "total" + +;; Window functions +;; https://sqlite.org/windowfunctions.html +"row_number" "rank" "dense_rank" "percent_rank" "cume_dist" "ntile" "lag" +"lead" "first_value" "last_value" "nth_value" + +;; Math functions +;; https://sqlite.org/lang_mathfunc.html +"acos" "acosh" "asin" "asinh" "atan" "atan2" "atanh" "ceil" "ceiling" "cos" +"cosh" "degrees" "exp" "floor" "ln" "log" "log" "log10" "log2" "mod" "pi" "pow" +"power" "radians" "sin" "sinh" "sqrt" "tan" "tanh" "trunc" + +;; JSON functions +;; https://sqlite.org/json1.html +"json" "jsonb" "json_array" "jsonb_array" "json_array_length" +"json_error_position" "json_extract" "jsonb_extract" "->" "->>" "json_insert" +"jsonb_insert" "json_object" "jsonb_object" "json_patch" "jsonb_patch" +"json_pretty" "json_remove" "jsonb_remove" "json_replace" "jsonb_replace" +"json_set" "jsonb_set" "json_type" "json_valid" "json_quote" "json_group_array" +"jsonb_group_array" "json_group_object" "jsonb_group_object" "json_each" +"json_tree" "jsonb_each" "jsonb_tree" + ))) "SQLite SQL keywords used by font-lock. From 6d0d71de68c064aaa61633945deb24bfc973e1e2 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 3 Jan 2026 07:31:53 -0800 Subject: [PATCH 152/325] New IELM option to insert newline when inside sexp (bug#80123) * lisp/ielm.el (ielm-dynamic-return): Add new value `point' to user option. (ielm-return): Implement it (bug#80123). --- etc/NEWS | 7 +++++++ lisp/ielm.el | 27 +++++++++++++++++++++++---- 2 files changed, 30 insertions(+), 4 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2e110b19c31..fd73f26033e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2060,6 +2060,13 @@ When you kill the IELM process with 'C-c C-c', the input history is now saved to the file specified by 'ielm-history-file-name', just like when you exit the Emacs session or kill the IELM buffer. +--- +*** New value 'point' for user option 'ielm-dynamic-return' +When 'ielm-dynamic-return' is set to 'point', typing RET has dynamic +behavior based on if point is inside an sexp. While the point is inside +an sexp typing RET inserts a newline, otherwise the sexp is evaluated. +This is useful when the mode 'electric-pair-mode' is enabled. + ** DocView --- diff --git a/lisp/ielm.el b/lisp/ielm.el index 78c5ad31d3d..09a92f3f74a 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -97,9 +97,27 @@ customizes `ielm-prompt'.") (defcustom ielm-dynamic-return t "Controls whether \\\\[ielm-return] has intelligent behavior in IELM. -If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline -and indents for incomplete sexps. If nil, always inserts newlines." - :type 'boolean) + +If nil, always insert newlines. + +If `point', insert newline if the point is in the middle of an sexp, +otherwise evaluate input. This is useful if you have +`electric-pair-mode' enabled. + +If any other non-nil value, insert newline for incomplete sexp input and +evaluate input for complete sexps. This is similar to the behavior in +text shells." + :type + '(radio + (const :tag "Always insert newline" nil) + (const + :tag + "Insert newline if point is in middle of sexp, otherwise evaluate input" + point) + (const + :tag + "Insert newline for incomplete sexp, otherwise evaluate input" + t))) (defcustom ielm-dynamic-multiline-inputs t "Force multiline inputs to start from column zero? @@ -248,7 +266,8 @@ simply inserts a newline." (if ielm-dynamic-return (let ((state (save-excursion - (end-of-line) + (unless (eq ielm-dynamic-return 'point) + (end-of-line)) (parse-partial-sexp (ielm-pm) (point))))) (if (and (< (car state) 1) (not (nth 3 state))) From f41a594bf35e9403852f042b5c716f1cba188734 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 15 Jan 2026 11:12:07 +0000 Subject: [PATCH 153/325] ; Improve docs for last change. --- etc/NEWS | 9 +++++---- lisp/ielm.el | 2 +- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index fd73f26033e..17a6a6c68b0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2061,11 +2061,12 @@ saved to the file specified by 'ielm-history-file-name', just like when you exit the Emacs session or kill the IELM buffer. --- -*** New value 'point' for user option 'ielm-dynamic-return' +*** New value 'point' for user option 'ielm-dynamic-return'. When 'ielm-dynamic-return' is set to 'point', typing RET has dynamic -behavior based on if point is inside an sexp. While the point is inside -an sexp typing RET inserts a newline, otherwise the sexp is evaluated. -This is useful when the mode 'electric-pair-mode' is enabled. +behavior based on whether point is inside an sexp. While point is +inside an sexp typing RET inserts a newline, and otherwise Emacs +proceeds with evaluating the expression. This is useful when +'electric-pair-mode', or a similar automatic pairing mode, is enabled. ** DocView diff --git a/lisp/ielm.el b/lisp/ielm.el index 09a92f3f74a..67d01e8217b 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -102,7 +102,7 @@ If nil, always insert newlines. If `point', insert newline if the point is in the middle of an sexp, otherwise evaluate input. This is useful if you have -`electric-pair-mode' enabled. +`electric-pair-mode', or a similar mode, enabled. If any other non-nil value, insert newline for incomplete sexp input and evaluate input for complete sexps. This is similar to the behavior in From 8e4f96cffbadc7aac02b4934703bdb715d517992 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Sat, 3 Jan 2026 07:36:54 -0800 Subject: [PATCH 154/325] Fix behavior for ielm-dynamic-multiline-inputs (bug#80123) * lisp/ielm.el (ielm-return): Navigate to before the prompt when looking for prompt (bug#80123). --- lisp/ielm.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ielm.el b/lisp/ielm.el index 67d01e8217b..0f6ba30ec00 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -274,7 +274,8 @@ simply inserts a newline." (ielm-send-input for-effect) (when (and ielm-dynamic-multiline-inputs (save-excursion - (beginning-of-line) + (let ((inhibit-field-text-motion t)) + (beginning-of-line)) (looking-at-p comint-prompt-regexp))) (save-excursion (goto-char (ielm-pm)) From 8b2780225696ae42f4b9eeb1ac8151291f53ba5c Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 15 Jan 2026 14:00:19 +0100 Subject: [PATCH 155/325] Fix off-by-one error in native_image_p * src/image.c (native_image_format): Make array size explicit, to help keep it consistent with its later fmt descriptor copy. (native_image_p): Parse the correct number of keywords (bug#80191). --- src/image.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/image.c b/src/image.c index 4fdee9bbd9c..3dad672515c 100644 --- a/src/image.c +++ b/src/image.c @@ -7867,7 +7867,7 @@ enum native_image_keyword_index /* Vector of image_keyword structures describing the format of valid user-defined image specifications. */ -static const struct image_keyword native_image_format[] = +static const struct image_keyword native_image_format[NATIVE_IMAGE_LAST] = { {":type", IMAGE_SYMBOL_VALUE, 1}, {":data", IMAGE_STRING_VALUE, 0}, @@ -7890,8 +7890,8 @@ native_image_p (Lisp_Object object) struct image_keyword fmt[NATIVE_IMAGE_LAST]; memcpy (fmt, native_image_format, sizeof fmt); - if (!parse_image_spec (object, fmt, 10, Qnative_image)) - return 0; + if (!parse_image_spec (object, fmt, NATIVE_IMAGE_LAST, Qnative_image)) + return false; /* Must specify either the :data or :file keyword. */ return fmt[NATIVE_IMAGE_FILE].count + fmt[NATIVE_IMAGE_DATA].count == 1; From 6287637ccd9f66a219844231380ab9873d049c6e Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Thu, 15 Jan 2026 20:24:29 +0100 Subject: [PATCH 156/325] Various housekeeping in image.c * doc/lispref/display.texi (Customizing Bitmaps): Fix grammar. (XBM Images): Fix reference to incorrect number of properties. (Multi-Frame Images, Other Image Types): Mention multi-frame WebP support. * src/image.c: Don't include pdumper.h; it hasn't been needed since commit of 2019-05-17 "Clean up and simplify image-type setup". Fix some commentary. (image_pix_container_create_from_bitmap_data): Remove no longer used frame parameter (bug#80191); this continues from commit of 2022-11-25 "Remove unused parameter from image_create_pix_container". All callers updated. (x_create_xrender_picture, initialize_image_type): Simplify. (xbm_image_p): Remove redundant conditional branch. Update commentary. --- doc/lispref/display.texi | 11 +++++---- src/image.c | 49 +++++++++++++++------------------------- 2 files changed, 24 insertions(+), 36 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 5f92f23c694..b74e4b9632f 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4911,7 +4911,7 @@ either a string or a vector of integers, where each element (an integer) corresponds to one row of the bitmap. Each bit of an integer corresponds to one pixel of the bitmap, where the low bit corresponds to the rightmost pixel of the bitmap. (Note that this order of bits -is opposite of the order in XBM images; @pxref{XBM Images}.) +is the opposite of the order in XBM images; @pxref{XBM Images}.) The height is normally the length of @var{bits}. However, you can specify a different height with non-@code{nil} @var{height}. The width @@ -6367,8 +6367,8 @@ used for each pixel in the XBM that is 0. The default is the frame's background color. @end table - If you specify an XBM image using data within Emacs instead of an -external file, use the following three properties: + To specify an XBM image using data within Emacs instead of an +external file, use the following properties: @table @code @item :data @var{data} @@ -6999,6 +6999,7 @@ Supports the @code{:index} property. @xref{Multi-Frame Images}. @item WebP Image type @code{webp}. +Supports the @code{:index} property. @xref{Multi-Frame Images}. @end table @node Defining Images @@ -7320,8 +7321,8 @@ about these image-specific key bindings. @cindex image frames Some image files can contain more than one image. We say that there are multiple ``frames'' in the image. At present, Emacs supports -multiple frames for GIF, TIFF, and certain ImageMagick formats such as -DJVM@. +multiple frames for GIF, TIFF, WebP, and certain ImageMagick formats +such as DJVM@. The frames can be used either to represent multiple pages (this is usually the case with multi-frame TIFF files, for example), or to diff --git a/src/image.c b/src/image.c index 3dad672515c..ac6e76f10a7 100644 --- a/src/image.c +++ b/src/image.c @@ -51,7 +51,6 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "termhooks.h" #include "font.h" -#include "pdumper.h" #ifdef HAVE_SYS_STAT_H #include @@ -270,8 +269,7 @@ image_pix_context_get_pixel (Emacs_Pix_Context image, int x, int y) } static Emacs_Pix_Container -image_pix_container_create_from_bitmap_data (struct frame *f, - char *data, unsigned int width, +image_pix_container_create_from_bitmap_data (char *data, unsigned int width, unsigned int height, unsigned long fg, unsigned long bg) @@ -1471,7 +1469,8 @@ struct image_keyword /* True means key must be present. */ bool mandatory_p; - /* Used to recognize duplicate keywords in a property list. */ + /* True means key is present. + Also used to recognize duplicate keywords in a property list. */ bool count; /* The value that was found. */ @@ -3931,7 +3930,7 @@ x_destroy_x_image (XImage *ximg) static Picture x_create_xrender_picture (struct frame *f, Emacs_Pixmap pixmap, int depth) { - Picture p; + Picture p = None; Display *display = FRAME_X_DISPLAY (f); if (FRAME_DISPLAY_INFO (f)->xrender_supported_p) @@ -3966,15 +3965,7 @@ x_create_xrender_picture (struct frame *f, Emacs_Pixmap pixmap, int depth) p = XRenderCreatePicture (display, pixmap, format, attr_mask, &attr); } else - { - image_error ("Specified image bit depth is not supported by XRender"); - return 0; - } - } - else - { - /* XRender not supported on this display. */ - return 0; + image_error ("Specified image bit depth is not supported by XRender"); } return p; @@ -4607,7 +4598,7 @@ enum xbm_token /* Return true if OBJECT is a valid XBM-type image specification. - A valid specification is a list starting with the symbol `image' + A valid specification is a list starting with the symbol `image'. The rest of the list is a property list which must contain an entry `:type xbm'. @@ -4630,8 +4621,8 @@ enum xbm_token Both the file and data forms may contain the additional entries `:background COLOR' and `:foreground COLOR'. If not present, - foreground and background of the frame on which the image is - displayed is used. */ + the foreground and background of the frame on which the image is + displayed are used. */ static bool xbm_image_p (Lisp_Object object) @@ -4649,18 +4640,14 @@ xbm_image_p (Lisp_Object object) if (kw[XBM_DATA].count) return 0; } - else if (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value)) - { - /* In-memory XBM file. */ - if (kw[XBM_FILE].count) - return 0; - } - else + else if (! (kw[XBM_DATA].count && xbm_file_p (kw[XBM_DATA].value))) + /* Not an in-memory XBM file. */ { Lisp_Object data; int width, height, stride; - /* Entries for `:width', `:height' and `:data' must be present. */ + /* Entries for `:data-width', `:data-height', and `:data' must be + present. */ if (!kw[XBM_DATA_WIDTH].count || !kw[XBM_DATA_HEIGHT].count || !kw[XBM_DATA].count) @@ -4944,7 +4931,7 @@ Create_Pixmap_From_Bitmap_Data (struct frame *f, struct image *img, char *data, fg = lookup_rgb_color (f, fgbg[0].red, fgbg[0].green, fgbg[0].blue); bg = lookup_rgb_color (f, fgbg[1].red, fgbg[1].green, fgbg[1].blue); img->pixmap - = image_pix_container_create_from_bitmap_data (f, data, img->width, + = image_pix_container_create_from_bitmap_data (data, img->width, img->height, fg, bg); #elif defined HAVE_X_WINDOWS img->pixmap @@ -7447,7 +7434,7 @@ image_build_heuristic_mask (struct frame *f, struct image *img, PBM (mono, gray, color) ***********************************************************************/ -/* Indices of image specification fields in gs_format, below. */ +/* Indices of image specification fields in pbm_format, below. */ enum pbm_keyword_index { @@ -8592,7 +8579,7 @@ png_load (struct frame *f, struct image *img) #if defined (HAVE_JPEG) -/* Indices of image specification fields in gs_format, below. */ +/* Indices of image specification fields in jpeg_format, below. */ enum jpeg_keyword_index { @@ -12827,7 +12814,7 @@ initialize_image_type (struct image_type const *type) Lisp_Object tested = Fassq (typesym, Vlibrary_cache); /* If we failed to load the library before, don't try again. */ if (CONSP (tested)) - return !NILP (XCDR (tested)) ? true : false; + return !NILP (XCDR (tested)); bool (*init) (void) = type->init; if (init) @@ -12891,8 +12878,8 @@ static struct image_type native_image_type = image_clear_image }; #endif -/* Look up image type TYPE, and return a pointer to its image_type - structure. Return 0 if TYPE is not a known image type. */ +/* Look up image TYPE, and return a pointer to its image_type structure. + Return a null pointer if TYPE is not a known image type. */ static struct image_type const * lookup_image_type (Lisp_Object type) From ab77b4b60ca1837e2da5147e6604cd2020567b80 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 17 Jan 2026 11:40:31 +0100 Subject: [PATCH 157/325] New D-Bus functions to support systemd inhibitor locks * doc/misc/dbus.texi (Top): Add "Inhibitor Locks" submenu. Remove trailing period from chapter and section titles. (Inhibitor Locks): New node. * etc/NEWS: New D-Bus functions to support systemd inhibitor locks. Presentational fixes and improvements. * src/dbusbind.c (xd_registered_inhibitor_locks): New variable. (Fdbus_make_inhibitor_lock, Fdbus_close_inhibitor_lock) (Fdbus_registered_inhibitor_locks): New DEFUNs. (Bug#79963) (syms_of_dbusbind_for_pdumper): Initialize `xd_registered_inhibitor_locks'. (syms_of_dbusbind): Declare subroutines `Sdbus_make_inhibitor_lock', `Sdbus_close_inhibitor_lock' and `Sdbus_registered_inhibitor_locks'. Declare symbol `Qdbus_call_method'. staticpro `xd_registered_inhibitor_locks'. * test/lisp/net/dbus-tests.el (dbus--test-systemd-service) (dbus--test-systemd-path, dbus--test-systemd-manager-interface): New defconsts. (dbus-test10-inhibitor-locks): New test. --- doc/misc/dbus.texi | 142 +++++++++++++++++++++++++++++++----- etc/NEWS | 33 ++++++--- src/dbusbind.c | 109 +++++++++++++++++++++++++++ test/lisp/net/dbus-tests.el | 93 +++++++++++++++++++++++ 4 files changed, 348 insertions(+), 29 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 7fad406520c..946e7666629 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -64,6 +64,7 @@ another. An overview of D-Bus can be found at * Alternative Buses:: Alternative buses and environments. * Errors and Events:: Errors and events. * Monitoring Messages:: Monitoring messages. +* Inhibitor Locks:: Inhibit system shutdowns and sleep states. * Index:: Index including concepts, functions, variables. * GNU Free Documentation License:: The license for this documentation. @@ -124,7 +125,7 @@ name could be @samp{org.gnu.Emacs.TextEditor} or @node Inspection -@chapter Inspection of D-Bus services. +@chapter Inspection of D-Bus services @cindex inspection @menu @@ -139,7 +140,7 @@ name could be @samp{org.gnu.Emacs.TextEditor} or @node Version -@section D-Bus version. +@section D-Bus version D-Bus has evolved over the years. New features have been added with new D-Bus versions. There are two variables, which allow the determination @@ -158,7 +159,7 @@ It is also @code{nil}, if it cannot be determined at runtime. @node Bus names -@section Bus names. +@section Bus names There are several basic functions which inspect the buses for registered names. Internally they use the basic interface @@ -267,7 +268,7 @@ at D-Bus @var{bus}, as a string. @node Introspection -@section Knowing the details of D-Bus services. +@section Knowing the details of D-Bus services D-Bus services publish their interfaces. This can be retrieved and analyzed during runtime, in order to understand the used @@ -483,7 +484,7 @@ If @var{object} has no @var{attribute}, the function returns @node Nodes and Interfaces -@section Detecting object paths and interfaces. +@section Detecting object paths and interfaces The first elements, to be introspected for a D-Bus object, are further object paths and interfaces. @@ -593,7 +594,7 @@ data from a running system: @node Methods and Signal -@section Applying the functionality. +@section Applying the functionality Methods and signals are the communication means to D-Bus. The following functions return their specifications. @@ -673,7 +674,7 @@ Example: @node Properties and Annotations -@section What else to know about interfaces. +@section What else to know about interfaces Interfaces can have properties. These can be exposed via the @samp{org.freedesktop.DBus.Properties} interface@footnote{See @@ -894,7 +895,7 @@ An attribute value can be retrieved by @node Arguments and Signatures -@section The final details. +@section The final details Methods and signals have arguments. They are described in the @code{arg} XML elements. @@ -962,7 +963,7 @@ non-@code{nil}, @var{direction} must be @samp{out}. Example: @node Type Conversion -@chapter Mapping Lisp types and D-Bus types. +@chapter Mapping Lisp types and D-Bus types @cindex type conversion D-Bus method calls and signals accept usually several arguments as @@ -975,7 +976,7 @@ applied Lisp object @expansion{} D-Bus type for input parameters, and D-Bus type @expansion{} Lisp object for output parameters. -@section Input parameters. +@section Input parameters Input parameters for D-Bus methods and signals occur as arguments of a Lisp function call. The following mapping to D-Bus types is @@ -1116,7 +1117,7 @@ lower-case hex digits. As a special case, "" is escaped to @end defun -@section Output parameters. +@section Output parameters Output parameters of D-Bus methods and signals are mapped to Lisp objects. @@ -1199,7 +1200,7 @@ that string: @node Synchronous Methods -@chapter Calling methods in a blocking way. +@chapter Calling methods in a blocking way @cindex method calls, synchronous @cindex synchronous method calls @@ -1319,7 +1320,7 @@ emulate the @code{lshal} command on GNU/Linux systems: @node Asynchronous Methods -@chapter Calling methods non-blocking. +@chapter Calling methods non-blocking @cindex method calls, asynchronous @cindex asynchronous method calls @@ -1371,7 +1372,7 @@ message arrives, and @var{handler} is called. Example: @node Register Objects -@chapter Offering own services. +@chapter Offering own services @cindex method calls, returning @cindex returning method calls @@ -1722,7 +1723,7 @@ to the service from D-Bus. @node Signals -@chapter Sending and receiving signals. +@chapter Sending and receiving signals @cindex signals Signals are one way messages. They carry input parameters, which are @@ -1859,7 +1860,7 @@ for a dummy signal, and check the result: @node Alternative Buses -@chapter Alternative buses and environments. +@chapter Alternative buses and environments @cindex bus names @cindex UNIX domain socket @cindex TCP/IP socket @@ -1986,7 +1987,7 @@ running. This could be achieved by @node Errors and Events -@chapter Errors and events. +@chapter Errors and events @cindex debugging @cindex errors @cindex events @@ -2145,7 +2146,7 @@ whether a given D-Bus error is related to them. @node Monitoring Messages -@chapter Monitoring messages. +@chapter Monitoring messages @cindex monitoring @defun dbus-register-monitor bus &optional handler &key type sender destination path interface member @@ -2204,6 +2205,111 @@ switches to the monitor buffer. @end deffn +@node Inhibitor Locks +@chapter Inhibit system shutdowns and sleep states + +@uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd} includes a logic to +inhibit system shutdowns and sleep states. It can be controlled by a +D-Bus API@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}. +Because this API includes handling of file descriptors, not all +functions can be implemented by simple D-Bus method calls. Therefore, +the following functions are provided. + +@defun dbus-make-inhibitor-lock what why &optional block +This function creates an inhibitor for system shutdowns and sleep states. + +@var{what} is a colon-separated string of lock types: @samp{shutdown}, +@samp{sleep}, @samp{idle}, @samp{handle-power-key}, +@samp{handle-suspend-key}, @samp{handle-hibernate-key}, +@samp{handle-lid-switch}. Example: @samp{shutdown:idle}. + +@c@var{who} is a descriptive string of who is taking the lock. If it is +@c@code{nil}, it defaults to @samp{Emacs}. + +@var{why} is a descriptive string of why the lock is taken. Example: +@samp{Package Update in Progress}. + +The optional @var{block} is the mode of the inhibitor lock, either +@samp{block} (@var{block} is non-@code{nil}), or @samp{delay}. + +Note, that the @code{who} argument of the inhibitor lock object of the +systemd manager is always set to the string @samp{Emacs}. + +It returns a file descriptor or @code{nil}, if the lock cannot be +acquired. If there is already an inhibitor lock for the triple +@code{(WHAT WHY BLOCK)}, this lock is returned. Example: + +@lisp +(dbus-make-inhibitor-lock "sleep" "Test") + +@result{} 25 +@end lisp +@end defun + +@defun dbus-registered-inhibitor-locks +Return registered inhibitor locks, an alist. +This allows to check, whether other packages of the running Emacs +instance have acquired an inhibitor lock as well. + +An entry in this list is a list @code{(@var{fd} @var{what} @var{why} +@var{block})}. The car of the list is the file descriptor retrieved +from a @code{dbus-make-inhibitor-lock} call. The cdr of the list +represents the three arguments @code{dbus-make-inhibitor-lock} was +called with. Example: + +@lisp +(dbus-registered-inhibitor-locks) + +@result{} ((25 "sleep" "Test" nil)) +@end lisp +@end defun + +@defun dbus-close-inhibitor-lock lock +Close inhibitor lock file descriptor. + +@var{lock}, a file descriptor, must be the result of a +@code{dbus-make-inhibitor-lock} call. It returns @code{t} in case of +success, or @code{nil} if it isn't be possible to close the lock, or if +the lock is closed already. Example: + +@lisp +(dbus-close-inhibitor-lock 25) + +@result{} t + +@end lisp +@end defun + +A typical scenario for these functions is to register for the +D-Bus signal @samp{org.freedesktop.login1.Manager.PrepareForSleep}: + +@lisp +(defvar my-inhibitor-lock + (dbus-make-inhibitor-lock "sleep" "Test")) + +(defun my-dbus-PrepareForSleep-handler (start) + (if start ;; The system goes down for sleep + (progn + @dots{} + ;; Release inhibitor lock. + (when (natnump my-inhibitor-lock) + (dbus-close-inhibitor-lock my-inhibitor-lock) + (setq my-inhibitor-lock nil))) + ;; Reacquire inhibitor lock. + (setq my-inhibitor-lock + (dbus-make-inhibitor-lock "sleep" "Test")))) + +(dbus-register-signal + :system "org.freedesktop.login1" "/org/freedesktop/login1/Manager" + "org.freedesktop.login1.Manager" "PrepareForSleep" + #'my-dbus-PrepareForSleep-handler) + +@result{} ((:signal :system "org.freedesktop.login1.Manager" "PrepareForSleep") + ("org.freedesktop.login1" "/org/freedesktop/login1/Manager" + my-dbus-PrepareForSleep-handler)) +@end lisp + + @node Index @unnumbered Index diff --git a/etc/NEWS b/etc/NEWS index 17a6a6c68b0..0b4fcadb620 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -201,10 +201,10 @@ large or inefficient completion tables this can slow down typing. +++ *** New optional value of 'minibuffer-visible-completions'. -If the value of this option is 'up-down', only the and arrow -keys move point between candidates shown in the *Completions* buffer -display, while and arrows move point in the minibuffer -window. +If the value of this option is 'up-down', only the '' and '' +arrow keys move point between candidates shown in the "*Completions*" +buffer display, while '' and '' arrows move point in the +minibuffer window. --- *** 'RET' chooses the completion selected with 'M-/M-'. @@ -513,7 +513,7 @@ Each non-tooltip frame is assigned a unique integer id. This allows you to unambiguously identify frames even if they share the same name or title. When 'undelete-frame-mode' is enabled, each deleted frame's id is stored for resurrection. The function 'frame-id' returns a frame's -id (in C, use the frame struct member id). +id (in C, use the frame struct member 'id'). ** Mode Line @@ -2062,9 +2062,9 @@ you exit the Emacs session or kill the IELM buffer. --- *** New value 'point' for user option 'ielm-dynamic-return'. -When 'ielm-dynamic-return' is set to 'point', typing RET has dynamic +When 'ielm-dynamic-return' is set to 'point', typing 'RET' has dynamic behavior based on whether point is inside an sexp. While point is -inside an sexp typing RET inserts a newline, and otherwise Emacs +inside an sexp typing 'RET' inserts a newline, and otherwise Emacs proceeds with evaluating the expression. This is useful when 'electric-pair-mode', or a similar automatic pairing mode, is enabled. @@ -2889,7 +2889,7 @@ The user option 'package-review-policy' can configure which packages the user should be allowed to review before any processing takes place. The package review can include reading the downloaded source code, presenting a diff between the downloaded code and a previous -installation or displaying a changelog. +installation or displaying a ChangeLog. ** Rcirc @@ -3750,12 +3750,21 @@ without marking it as automatically buffer-local. ** The obsolete face attribute ':reverse-video' has been removed. Use ':inverse-video' instead. +** D-Bus + +++ -** Support interactive D-Bus authorization. +*** Support interactive D-Bus authorization. A new ':authorizable t' parameter has been added to 'dbus-call-method' and 'dbus-call-method-asynchronously' to allow the user to interactively authorize the invoked D-Bus method (for example via polkit). ++++ +*** New D-Bus functions to support systemd inhibitor locks. +The functions 'dbus-make-inhibitor-lock', 'dbus-close-inhibitor-lock' +and 'dbus-registered-inhibitor-locks' implement acquiring and releasing +systemd inhibitor locks. See the Info node "(dbus) Inhibitor Locks" for +details. + ** The customization group 'wp' has been removed. It has been obsolete since Emacs 26.1. Use the group 'text' instead. @@ -3926,15 +3935,17 @@ When the theme is set on PGTK, Android, or MS-Windows systems, variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be extended to encompass other toolkit-specific symbols in the future. +** Progress reporter + +++ -** Progress reporter callbacks. +*** Progress reporter callbacks. 'make-progress-reporter' now accepts optional arguments UPDATE-CALLBACK, called on progress steps, and DONE-CALLBACK, called when the progress reporter is done. See the 'make-progress-reporter' docstring for a full specification of these new optional arguments. +++ -** Progress reporter context. +*** Progress reporter context. 'make-progress-reporter' now accepts the optional argument CONTEXT, which if it is the symbol 'async', inhibits updates in the echo area when it is busy. This is useful, for example, if you want to monitor progress diff --git a/src/dbusbind.c b/src/dbusbind.c index a2936011610..a416e6c918a 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1617,6 +1617,109 @@ usage: (dbus-message-internal &rest REST) */) return result; } +/* Alist of registered inhibitor locks for D-Bus. + An entry in this list is a list (FD WHAT WHY BLOCK). + The car of the list is a file descriptor retrieved from a + 'dbus-make-inhibitor-lock` call. The cdr of the list represents the + three arguments 'dbus-make-inhibitor-lock` was called with. */ +static Lisp_Object xd_registered_inhibitor_locks; + +DEFUN ("dbus-make-inhibitor-lock", Fdbus_make_inhibitor_lock, + Sdbus_make_inhibitor_lock, + 2, 3, 0, + doc: /* Inhibit system shutdowns and sleep states. + +WHAT is a colon-separated string of lock types, i.e. "shutdown", +"sleep", "idle", "handle-power-key", "handle-suspend-key", +"handle-hibernate-key", "handle-lid-switch". Example: "shutdown:idle". + +WHY is a descriptive string of why the lock is taken. Example: "Package +Update in Progress". + +The optional BLOCK is the mode of the inhibitor lock, either "block" +(BLOCK is non-nil), or "delay". + +It returns a file descriptor or nil, if the lock cannot be acquired. If +there is already an inhibitor lock for the triple (WHAT WHY BLOCK), this +lock is returned. + +For details of the arguments, see Info node `(dbus)Inhibitor Locks'. */) + (Lisp_Object what, Lisp_Object why, Lisp_Object block) +{ + CHECK_STRING (what); + CHECK_STRING (why); + if (!NILP (block)) + block = Qt; + Lisp_Object who = build_string ("Emacs"); + Lisp_Object mode = + (NILP (block)) ? build_string ("delay") : build_string ("block"); + + /* Check, whether it is registered already. */ + Lisp_Object triple = list3 (what, why, block); + Lisp_Object registered = Frassoc (triple, xd_registered_inhibitor_locks); + if (!NILP (registered)) + return CAR_SAFE (registered); + + /* Register lock. */ + Lisp_Object lock = + calln (Qdbus_call_method, QCsystem, + build_string ("org.freedesktop.login1"), + build_string ("/org/freedesktop/login1"), + build_string ("org.freedesktop.login1.Manager"), + build_string ("Inhibit"), what, who, why, mode); + + xd_registered_inhibitor_locks = + Fcons (Fcons (lock, triple), xd_registered_inhibitor_locks); + return lock; +} + +DEFUN ("dbus-close-inhibitor-lock", Fdbus_close_inhibitor_lock, + Sdbus_close_inhibitor_lock, + 1, 1, 0, + doc: /* Close inhibitor lock file descriptor. + +LOCK, a file descriptor, must be the result of a `dbus-make-inhibitor-lock' +call. It returns t in case of success, or nil if it isn't be possible +to close the lock, or if the lock is closed already. + +For details, see Info node `(dbus)Inhibitor Locks'. */) + (Lisp_Object lock) +{ + CHECK_FIXNUM (lock); + + /* Check, whether it is registered. */ + Lisp_Object registered = assoc_no_quit (lock, xd_registered_inhibitor_locks); + if (NILP (registered)) + return Qnil; + else + { + xd_registered_inhibitor_locks = + Fdelete (registered, xd_registered_inhibitor_locks); + return (emacs_close (XFIXNAT (lock)) == 0) ? Qt : Qnil; + } +} + +DEFUN ("dbus-registered-inhibitor-locks", Fdbus_registered_inhibitor_locks, + Sdbus_registered_inhibitor_locks, + 0, 0, 0, + doc: /* Return registered inhibitor locks, an alist. +This allows to check, whether other packages of the running Emacs +instance have acquired an inhibitor lock as well. +An entry in this list is a list (FD WHAT WHY BLOCK). +The car of the list is the file descriptor retrieved from a +'dbus-make-inhibitor-lock` call. The cdr of the list represents the +three arguments 'dbus-make-inhibitor-lock` was called with. */) + () +{ + /* We return a copy of xd_registered_inhibitor_locks, in order to + protect it against malicious manipulation. */ + Lisp_Object registered = xd_registered_inhibitor_locks; + Lisp_Object result = Qnil; + for (; !NILP (registered); registered = CDR_SAFE (registered)) + result = Fcons (Fcopy_sequence (CAR_SAFE (registered)), result); + return Fnreverse (result); +} + /* Construct a D-Bus event, and store it into the input event queue. */ static void xd_store_event (Lisp_Object handler, Lisp_Object handler_args, @@ -1869,6 +1972,7 @@ static void syms_of_dbusbind_for_pdumper (void) { xd_registered_buses = Qnil; + xd_registered_inhibitor_locks = Qnil; } void @@ -1876,6 +1980,9 @@ syms_of_dbusbind (void) { defsubr (&Sdbus__init_bus); defsubr (&Sdbus_get_unique_name); + defsubr (&Sdbus_make_inhibitor_lock); + defsubr (&Sdbus_close_inhibitor_lock); + defsubr (&Sdbus_registered_inhibitor_locks); DEFSYM (Qdbus_message_internal, "dbus-message-internal"); defsubr (&Sdbus_message_internal); @@ -1930,6 +2037,7 @@ syms_of_dbusbind (void) /* Miscellaneous Lisp symbols. */ DEFSYM (Qdbus_get_name_owner, "dbus-get-name-owner"); + DEFSYM (Qdbus_call_method, "dbus-call-method"); DEFVAR_LISP ("dbus-compiled-version", Vdbus_compiled_version, @@ -2035,6 +2143,7 @@ be called when the D-Bus reply message arrives. */); /* Initialize internal objects. */ pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper); staticpro (&xd_registered_buses); + staticpro (&xd_registered_inhibitor_locks); Fprovide (intern_c_string ("dbusbind"), Qnil); } diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index e529e02ed9b..b34ce3381c7 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -48,6 +48,15 @@ (defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface" "Test interface.") +(defconst dbus--test-systemd-service "org.freedesktop.login1" + "Systemd service.") + +(defconst dbus--test-systemd-path "/org/freedesktop/login1" + "Systemd object path.") + +(defconst dbus--test-systemd-manager-interface "org.freedesktop.login1.Manager" + "Systemd Manager interface.") + (defun dbus--test-availability (bus) "Test availability of D-Bus BUS." (should (dbus-list-names bus)) @@ -2295,6 +2304,90 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method." ;; Cleanup. (dbus-unregister-service :session dbus--test-service))) +(ert-deftest dbus-test10-inhibitor-locks () + "Check `dbus-*-inhibitor-locks'." + :tags '(:expensive-test) + (skip-unless dbus--test-enabled-system-bus) + (skip-unless (dbus-ping :system dbus--test-systemd-service 1000)) + + (let (lock1 lock2) + ;; Create inhibitor lock. + (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay")) + (should (natnump lock1)) + ;; The lock is reported by systemd. + (should + (member + (list "sleep" "Emacs" "Test delay" "delay" (user-uid) (emacs-pid)) + (dbus-call-method + :system dbus--test-systemd-service dbus--test-systemd-path + dbus--test-systemd-manager-interface "ListInhibitors"))) + ;; The lock is registered internally. + (should + (member + (list lock1 "sleep" "Test delay" nil) + (dbus-registered-inhibitor-locks))) + ;; There exist a file descriptor. + (when (file-directory-p (format "/proc/%d/fd" (emacs-pid))) + (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1)))) + + ;; It is not possible to modify registered inhibitor locks on Lisp level. + (setcar (assoc lock1 (dbus-registered-inhibitor-locks)) 'malicious) + (should (assoc lock1 (dbus-registered-inhibitor-locks))) + (should-not (assoc 'malicious (dbus-registered-inhibitor-locks))) + + ;; Creating it again returns the same inhibitor lock. + (should (= lock1 (dbus-make-inhibitor-lock "sleep" "Test delay"))) + + ;; Create another inhibitor lock. + (setq lock2 (dbus-make-inhibitor-lock "sleep" "Test block" 'block)) + (should (natnump lock2)) + (should-not (= lock1 lock2)) + ;; The lock is reported by systemd. + (should + (member + (list "sleep" "Emacs" "Test block" "block" (user-uid) (emacs-pid)) + (dbus-call-method + :system dbus--test-systemd-service dbus--test-systemd-path + dbus--test-systemd-manager-interface "ListInhibitors"))) + ;; The lock is registered internally. + (should + (member + (list lock2 "sleep" "Test block" t) + (dbus-registered-inhibitor-locks))) + ;; There exist a file descriptor. + (when (file-directory-p (format "/proc/%d/fd" (emacs-pid))) + (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock2)))) + + ;; Close the first inhibitor lock. + (should (dbus-close-inhibitor-lock lock1)) + ;; The internal registration has gone. + (should-not + (member + (list lock1 "sleep" "Test delay" nil) + (dbus-registered-inhibitor-locks))) + ;; The file descriptor has been deleted. + (when (file-directory-p (format "/proc/%d/fd" (emacs-pid))) + (should-not (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1)))) + + ;; Closing it again is a noop. + (should-not (dbus-close-inhibitor-lock lock1)) + + ;; Creating it again returns (another?) inhibitor lock. + (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay")) + (should (natnump lock1)) + ;; The lock is registered internally. + (should + (member + (list lock1 "sleep" "Test delay" nil) + (dbus-registered-inhibitor-locks))) + ;; There exist a file descriptor. + (when (file-directory-p (format "/proc/%d/fd" (emacs-pid))) + (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1)))) + + ;; Close the inhibitor locks. + (should (dbus-close-inhibitor-lock lock1)) + (should (dbus-close-inhibitor-lock lock2)))) + (defun dbus-test-all (&optional interactive) "Run all tests for \\[dbus]." (interactive "p") From 709983fb085dc2bfe8e78e18abad0c119b18a6e3 Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Sun, 28 Dec 2025 19:05:51 +0200 Subject: [PATCH 158/325] NS: Fix Meta key on GNUstep * src/nsterm.m (syms_of_nsterm): On GNUstep, set ns-command-modifier to "meta" to match the backend default setting. (Bug#80090) --- src/nsterm.m | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/nsterm.m b/src/nsterm.m index 0e8738d7c1b..07f397b1c5d 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -11379,7 +11379,11 @@ Convert an X font name (XLFD) to an NS font name. Each SYMBOL is `control', `meta', `alt', `super', `hyper' or `none'. If `none', the key is ignored by Emacs and retains its standard meaning. */); +#ifdef NS_IMPL_COCOA ns_command_modifier = Qsuper; +#else + ns_command_modifier = Qmeta; +#endif DEFVAR_LISP ("ns-right-command-modifier", ns_right_command_modifier, doc: /* This variable describes the behavior of the right command key. From cc3e6f368fe73dc0b7784e11b083dd240261de7d Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Wed, 31 Dec 2025 08:06:06 +0200 Subject: [PATCH 159/325] NS: Add native image support for HEIF, SVG and WEBP on GNUstep * src/nsimage.m (ns_can_use_native_image_api): Handle HEIF, SVG and WEBP image types on GNUstep. * src/image.c (syms_of_image): Add conditional native image support for HEIF, SVG and WEBP on GNUstep. (Bug#80101) --- src/image.c | 26 +++++++++++++++++++++----- src/nsimage.m | 10 ++++++++++ 2 files changed, 31 insertions(+), 5 deletions(-) diff --git a/src/image.c b/src/image.c index ac6e76f10a7..71a091ea498 100644 --- a/src/image.c +++ b/src/image.c @@ -13054,11 +13054,18 @@ non-numeric, there is no explicit limit on the size of images. */); #if defined (HAVE_WEBP) \ || (defined (HAVE_NATIVE_IMAGE_API) \ - && ((defined (HAVE_NS) && defined (NS_IMPL_COCOA)) \ - || defined (HAVE_HAIKU))) + && (defined (HAVE_NS) || defined (HAVE_HAIKU))) DEFSYM (Qwebp, "webp"); DEFSYM (Qwebpdemux, "webpdemux"); +#if !defined (NS_IMPL_GNUSTEP) || defined (HAVE_WEBP) add_image_type (Qwebp); +#else + + /* On GNUstep, WEBP support is provided via ImageMagick only if + gnustep-gui is built with --enable-imagemagick. */ + if (image_can_use_native_api (Qwebp)) + add_image_type (Qwebp); +#endif /* NS_IMPL_GNUSTEP && !HAVE_WEBP */ #endif #if defined (HAVE_IMAGEMAGICK) @@ -13081,18 +13088,27 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (Qgobject, "gobject"); #endif /* HAVE_NTGUI */ #elif defined HAVE_NATIVE_IMAGE_API \ - && ((defined HAVE_NS && defined NS_IMPL_COCOA) \ - || defined HAVE_HAIKU) + && (defined HAVE_NS || defined HAVE_HAIKU) DEFSYM (Qsvg, "svg"); - /* On Haiku, the SVG translator may not be installed. */ + /* On Haiku, the SVG translator may not be installed. On GNUstep, SVG + support is provided by ImageMagick so not guaranteed. Furthermore, + some distros (e.g., Debian) ship ImageMagick's SVG module in a + separate binary package which may not be installed. */ if (image_can_use_native_api (Qsvg)) add_image_type (Qsvg); #endif #ifdef HAVE_NS DEFSYM (Qheic, "heic"); +#ifdef NS_IMPL_COCOA add_image_type (Qheic); +#else + + /* HEIC support in gnustep-gui is provided by ImageMagick. */ + if (image_can_use_native_api (Qheic)) + add_image_type (Qheic); +#endif /* NS_IMPL_GNUSTEP */ #endif #if HAVE_NATIVE_IMAGE_API diff --git a/src/nsimage.m b/src/nsimage.m index 3c318c37cfd..426ce20eb05 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -102,6 +102,16 @@ Updated by Christian Limpach (chris@nice.ch) imageType = @"gif"; else if (EQ (type, Qtiff)) imageType = @"tiff"; +#ifndef HAVE_RSVG + else if (EQ (type, Qsvg)) + imageType = @"svg"; +#endif +#ifndef HAVE_WEBP + else if (EQ (type, Qwebp)) + imageType = @"webp"; +#endif + else if (EQ (type, Qheic)) + imageType = @"heic"; types = [NSImage imageFileTypes]; #endif From 5020d89104dfc25601ca595bca9124a27ea8b1cb Mon Sep 17 00:00:00 2001 From: Amin Bandali Date: Sun, 4 Jan 2026 23:50:51 -0500 Subject: [PATCH 160/325] New minor mode center-line-mode * lisp/textmodes/text-mode.el (center-line-mode--track-changes): New local variable for storing the id of the change tracker registered for the current buffer. (center-line-mode--track-changes-signal): New function to be called by the track-changes library whenever there is a change in the current buffer. (center-line-mode--track-changes-function): New function called from the above signal function, iterates over the lines of the modified region, calling 'center-line' for each non-empty line. (center-line-mode): New minor mode. * etc/NEWS: Document the new minor mode. --- etc/NEWS | 5 ++++ lisp/textmodes/text-mode.el | 50 +++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 0b4fcadb620..b3b9a84680e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -949,6 +949,11 @@ These commands did not previously accept a prefix argument. Now a numeric prefix argument specifies a repeat count, just like it already did for 'undo'. +** New minor mode 'center-line-mode'. +This mode keeps modified lines centered horizontally according to the +value of 'fill-column', by calling 'center-line' on each non-empty line +of the modified region. + * Changes in Specialized Modes and Packages in Emacs 31.1 diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 5c9449a2238..b5b496a30dc 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -269,6 +269,56 @@ The argument NLINES says how many lines to center." (setq nlines (1+ nlines)) (forward-line -1))))) +;; Actually defined in track-changes.el. +(defvar track-changes-undo-only) +(declare-function track-changes-register "track-changes" + ( signal &optional &key nobefore disjoint immediate)) +(declare-function track-changes-unregister "track-changes" (id)) +(declare-function track-changes-fetch "track-changes" (id func)) + +(defvar-local center-line-mode--track-changes nil) + +(defun center-line-mode--track-changes-signal (tracker) + (track-changes-fetch + tracker + #'center-line-mode--track-changes-function)) + +(defun center-line-mode--track-changes-function (beg end _before) + (unless track-changes-undo-only + (save-excursion + (let ((beg-line (line-number-at-pos beg)) + (end-line (line-number-at-pos end)) + (should-center-last-line-p + (progn + (goto-char end) + (null + (or (bolp) + (and (eolp) + (looking-back "[\r\n\t ]" (1- (point))))))))) + (goto-char beg) + (dotimes (_ (- end-line beg-line)) ; all but last line + (unless (and (bolp) (eolp)) + (center-line)) + (forward-line 1)) + (when should-center-last-line-p + (center-line))))) + ;; Disregard our own changes. + (track-changes-fetch center-line-mode--track-changes #'ignore)) + +(define-minor-mode center-line-mode + "Minor mode for keeping modified lines centered horizontally. +Calls `center-line' on each line of the modified region to center the +text within the width specified by `fill-column'." + :lighter " Center-Line" + (require 'track-changes) + (if center-line-mode + (setq center-line-mode--track-changes + (track-changes-register + #'center-line-mode--track-changes-signal + :nobefore t)) + (when center-line-mode--track-changes + (track-changes-unregister center-line-mode--track-changes)))) + (define-obsolete-function-alias 'indented-text-mode #'text-mode "29.1") From bd96450a09fc268fed35c0e8e8e181bed346c770 Mon Sep 17 00:00:00 2001 From: "Jacob S. Gordon" Date: Fri, 9 Jan 2026 16:20:00 -0500 Subject: [PATCH 161/325] calc: Improve handling of invalid 'calc-string-maximum-character' Previously, if 'calc-string-maximum-character' wasn't a valid character 'math-vector-is-string' would throw an error in the comparison, leading to an incomplete display of the stack and a cryptic error message. Instead, have 'math-vector-is-string' return nil, which effectively disables the display of strings. Refines feature introduced in bug#78528. * doc/misc/calc.texi (Customizing Calc): Update description of behavior for invalid 'calc-string-maximum-character'. * lisp/calc/calccomp.el (math-vector-is-string): Return nil when 'calc-string-maximum-character' doesn't represent a character. * test/lisp/calc/calc-tests.el (calc-math-vector-is-string): Correct and simplify tests. --- doc/misc/calc.texi | 7 ++-- lisp/calc/calccomp.el | 24 ++++++------ test/lisp/calc/calc-tests.el | 72 ++++++++---------------------------- 3 files changed, 32 insertions(+), 71 deletions(-) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 5e80b39c3fd..deddcd7a7ad 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35694,10 +35694,9 @@ The variable @code{calc-string-maximum-character} is the maximum value of a vector's elements for @code{calc-display-strings}, @code{string}, and @code{bstring} to display the vector as a string. This maximum @emph{must} represent a character, i.e. it's a non-negative integer less -than or equal to @code{(max-char)} or @code{0x3FFFFF}. Any negative -value effectively disables the display of strings, and for values larger -than @code{0x3FFFFF} the display acts as if the maximum were -@code{0x3FFFFF}. Some natural choices (and their resulting ranges) are: +than or equal to @code{(max-char)} or @code{0x3FFFFF}. Any value not +representing a character effectively disables the display of strings. +Some natural choices (and their resulting ranges) are: @itemize @item diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index bb8dbe6c52c..a59ad82aa57 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -911,17 +911,19 @@ Elements of A must either be a character (see `characterp') or a complex number with only a real character part, each with a value less than or -equal to the custom variable `calc-string-maximum-character'." - (while (and (setq a (cdr a)) - (or (and (characterp (car a)) - (<= (car a) - calc-string-maximum-character)) - (and (eq (car-safe (car a)) 'cplx) - (characterp (nth 1 (car a))) - (eq (nth 2 (car a)) 0) - (<= (nth 1 (car a)) - calc-string-maximum-character))))) - (null a)) +equal to the value of `calc-string-maximum-character'. Return nil if +`calc-string-maximum-character' is not a character." + (when (characterp calc-string-maximum-character) + (while (and (setq a (cdr a)) + (or (and (characterp (car a)) + (<= (car a) + calc-string-maximum-character)) + (and (eq (car-safe (car a)) 'cplx) + (characterp (nth 1 (car a))) + (eq (nth 2 (car a)) 0) + (<= (nth 1 (car a)) + calc-string-maximum-character))))) + (null a))) (defconst math-vector-to-string-chars '( ( ?\" . "\\\"" ) ( ?\\ . "\\\\" ) diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index d12b8a8d371..886f3f16f9e 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -882,18 +882,8 @@ An existing calc stack is reused, otherwise a new one is created." (ert-deftest calc-math-vector-is-string () "Test `math-vector-is-string' with varying `calc-string-maximum-character'. - -All tests operate on both an integer vector and the corresponding -complex vector. The sets covered are: - -1. `calc-string-maximum-character' is a valid character. The last case -with `0x3FFFFF' is borderline, as integers above it will not make it -past the `characterp' test. -2. `calc-string-maximum-character' is negative, so the test always fails. -3. `calc-string-maximum-character' is above `(max-char)', so only the -first `characterp' test is active. -4. `calc-string-maximum-character' has an invalid type, which triggers -an error in the comparison." +When `calc-string-maximum-character' isn’t a valid character, +`math-vector-is-string' should return nil for all vectors." (cl-flet* ((make-vec (lambda (contents) (append (list 'vec) contents))) (make-cplx (lambda (x) (list 'cplx x 0))) (make-cplx-vec (lambda (contents) @@ -902,50 +892,20 @@ an error in the comparison." (dolist (maxchar '(#x7F #xFF #x10FFFF #x3FFFFD #x3FFFFF)) (let* ((calc-string-maximum-character maxchar) (small-chars (number-sequence (- maxchar 2) maxchar)) - (large-chars (number-sequence maxchar (+ maxchar 2))) - (small-real-vec (make-vec small-chars)) - (large-real-vec (make-vec large-chars)) - (small-cplx-vec (make-cplx-vec small-chars)) - (large-cplx-vec (make-cplx-vec large-chars))) - (should (math-vector-is-string small-real-vec)) - (should-not (math-vector-is-string large-real-vec)) - (should (math-vector-is-string small-cplx-vec)) - (should-not (math-vector-is-string large-cplx-vec)))) - ;; 2: calc-string-maximum-character is negative - (let* ((maxchar -1) - (calc-string-maximum-character maxchar) - (valid-contents (number-sequence 0 2)) - (invalid-contents (number-sequence (- maxchar 2) maxchar)) - (valid-real-vec (make-vec valid-contents)) - (invalid-real-vec (make-vec invalid-contents)) - (valid-cplx-vec (make-cplx-vec valid-contents)) - (invalid-cplx-vec (make-cplx-vec invalid-contents))) - (should-not (math-vector-is-string valid-real-vec)) - (should-not (math-vector-is-string invalid-real-vec)) - (should-not (math-vector-is-string valid-cplx-vec)) - (should-not (math-vector-is-string invalid-cplx-vec))) - ;; 3: calc-string-maximum-character is larger than (max-char) - (let* ((maxchar (+ (max-char) 3)) - (calc-string-maximum-character maxchar) - (valid-chars (number-sequence (- (max-char) 2) (max-char))) - (invalid-chars (number-sequence (1+ (max-char)) maxchar)) - (valid-real-vec (make-vec valid-chars)) - (invalid-real-vec (make-vec invalid-chars)) - (valid-cplx-vec (make-cplx-vec valid-chars)) - (invalid-cplx-vec (make-cplx-vec invalid-chars))) - (should (math-vector-is-string valid-real-vec)) - (should-not (math-vector-is-string invalid-real-vec)) - (should (math-vector-is-string valid-cplx-vec)) - (should-not (math-vector-is-string invalid-cplx-vec))) - ;; 4: calc-string-maximum-character has the wrong type - (let* ((calc-string-maximum-character "wrong type") - (contents (number-sequence 0 2)) - (real-vec (make-vec contents)) - (cplx-vec (make-cplx-vec contents))) - (should-error (math-vector-is-string real-vec) - :type 'wrong-type-argument) - (should-error (math-vector-is-string cplx-vec) - :type 'wrong-type-argument)))) + (large-chars (number-sequence maxchar (+ maxchar 2)))) + (should (math-vector-is-string (make-vec small-chars))) + (should-not (math-vector-is-string (make-vec large-chars))) + (should (math-vector-is-string (make-cplx-vec small-chars))) + (should-not (math-vector-is-string (make-cplx-vec large-chars))))) + ;; 2: calc-string-maximum-character is not a valid character + (dolist (maxchar (list -1 (1+ (max-char)) "wrong type")) + (let ((calc-string-maximum-character maxchar) + (valid-chars (number-sequence 0 2)) + (invalid-chars (number-sequence -2 -1))) + (should-not (math-vector-is-string (make-vec valid-chars))) + (should-not (math-vector-is-string (make-vec invalid-chars))) + (should-not (math-vector-is-string (make-cplx-vec valid-chars))) + (should-not (math-vector-is-string (make-cplx-vec invalid-chars))))))) (ert-deftest calc-inhibit-startup-message () "Test user option `calc-inhibit-startup-message'." From b233ca80e939c939633b37c41398eb1bb12cb4e9 Mon Sep 17 00:00:00 2001 From: "Jacob S. Gordon" Date: Fri, 9 Jan 2026 16:21:00 -0500 Subject: [PATCH 162/325] ; calc: Improve alignment for Unicode strings With higher values of 'calc-string-maximum-character' the string length can differ from the displayed width. Calculate alignment offsets based on the the display width, rounded up to the nearest integer. Refines feature introduced in bug#78528. * lisp/calc/calccomp.el (math-comp-width): Replace 'length' with a ratio of 'string-pixel-width's. --- lisp/calc/calccomp.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index a59ad82aa57..73a627f178c 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1656,7 +1656,11 @@ Not all brackets have midpieces.") ((memq (car c) '(set break)) t))) (defun math-comp-width (c) - (cond ((not (consp c)) (length c)) + (cond ((not (consp c)) + (or (and (stringp c) + (ceiling (string-pixel-width c) + (string-pixel-width "-"))) + (length c))) ((memq (car c) '(horiz subscr supscr)) (let ((accum 0)) (while (setq c (cdr c)) From 6e37af1fe89316fa921539340fcce9af94e9e69d Mon Sep 17 00:00:00 2001 From: "Jacob S. Gordon" Date: Fri, 9 Jan 2026 16:22:00 -0500 Subject: [PATCH 163/325] ; calc: Correct width of rules composed of Unicode glyphs With higher values of 'calc-string-maximum-character', rules made up of glyphs of non-unit width can be the wrong length. Calculate the number of characters in the rule based on the display width, rounded up to the nearest integer. Refines feature introduced in bug#78528. * lisp/calc/calccomp.el (math-comp-simplify-term): Calculate rule width with a ratio of 'string-pixel-width's. --- lisp/calc/calccomp.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 73a627f178c..86a2c405272 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1558,8 +1558,12 @@ Not all brackets have midpieces.") (setq c (cdr c)) (while (setq c (cdr c)) (if (eq (car-safe (car c)) 'rule) - (math-comp-add-string (make-string maxwid (nth 1 (car c))) - math-comp-hpos math-comp-vpos) + (let* ((sep (nth 1 (car c))) + (rule-width (ceiling + (* maxwid (string-pixel-width "-")) + (string-pixel-width (char-to-string sep))))) + (math-comp-add-string (make-string rule-width sep) + math-comp-hpos math-comp-vpos)) (let ((math-comp-hpos (+ math-comp-hpos (/ (* bias (- maxwid (car widths))) 2)))) From c97b8e6650fa28f44e36e200f966046ffe99fe0f Mon Sep 17 00:00:00 2001 From: kobarity Date: Sun, 11 Jan 2026 17:49:29 +0900 Subject: [PATCH 164/325] Improve non-native completion in Python mode Previously, both the definition of __PYTHON_EL_get_completions and the call to __PYTHON_EL_get_completions were sent to the inferior Python each time 'python-shell-completion-get-completions' was executed. However, there is no need to send the definition every time as long as the definition remains unchanged. We improved this so that the definition of __PYTHON_EL_get_completions is only sent during the inferior Python initialization; it is no longer sent during 'python-shell-completion-get-completions' execution. * lisp/progmodes/python.el (python-shell-completion-send-setup-code): New function. (python-shell-first-prompt-hook): Add the above new function. (python-shell-completion-get-completions): Omit sending 'python-shell-completion-setup-code'. (Bug#80182) --- lisp/progmodes/python.el | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9c5e1e5ee6c..5a820f05d77 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -4514,6 +4514,13 @@ def __PYTHON_EL_get_completions(text): "Code used to setup completion in inferior Python processes." :type 'string) +(defun python-shell-completion-send-setup-code () + "Send `python-shell-completion-setup-code' to inferior Python process." + (python-shell-send-string-no-output python-shell-completion-setup-code)) + +(add-hook 'python-shell-first-prompt-hook + #'python-shell-completion-send-setup-code) + (define-obsolete-variable-alias 'python-shell-completion-module-string-code 'python-shell-completion-string-code @@ -4844,8 +4851,7 @@ With argument MSG show activation/deactivation message." (with-current-buffer (process-buffer process) (let ((completions (python-shell-send-string-no-output - (format "%s\nprint(__PYTHON_EL_get_completions(%s))" - python-shell-completion-setup-code + (format "print(__PYTHON_EL_get_completions(%s))" (python-shell--encode-string input)) process))) (condition-case nil From b04fbc59e95a2ccdef460dd0fb10bdd8080f61e2 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 11 Jan 2026 13:30:22 +0100 Subject: [PATCH 165/325] gnus-msg-mail: Attempt to start Gnus if not yet alive * lisp/gnus/gnus-msg.el (gnus-msg-mail): Attempt to start Gnus if not yet alive. In case of failure, fall back to plain message mode. (Bug#80173) --- lisp/gnus/gnus-msg.el | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index e35f87288e9..99f1735dfec 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -467,11 +467,17 @@ Gcc: header for archiving purposes. If Gnus isn't running, a plain `message-mail' setup is used instead." (interactive) - (if (not (gnus-alive-p)) - (progn - (message "Gnus not running; using plain Message mode") - (message-mail to subject other-headers continue - switch-action yank-action send-actions return-action)) + (if (and (not (gnus-alive-p)) + (condition-case err + (progn + (message "Gnus not running. Starting Gnus...") + (save-window-excursion (gnus)) + nil) + (error + (message "Gnus failed with %s. Using plain Message mode" + (error-message-string err))))) + (message-mail to subject other-headers continue + switch-action yank-action send-actions return-action) (let ((buf (current-buffer)) ;; Don't use posting styles corresponding to any existing group. ;; (group-name gnus-newsgroup-name) From a47430af626b48e619b3540eeb58269715fa4da4 Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Mon, 5 Jan 2026 00:12:45 +0900 Subject: [PATCH 166/325] ; Add admin/cl-lib-deps-report.el to audit cl-lib dependencies This script helps identify redundant runtime dependencies on cl-lib by auditing the usage of cl-lib macros and functions. * admin/cl-lib-deps-report.el: New script. * admin/README: Update. (Bug#80129) --- admin/README | 4 + admin/cl-lib-deps-report.el | 162 ++++++++++++++++++++++++++++++++++++ 2 files changed, 166 insertions(+) create mode 100755 admin/cl-lib-deps-report.el diff --git a/admin/README b/admin/README index 3e86319f2a3..3f2aae3fe84 100644 --- a/admin/README +++ b/admin/README @@ -53,6 +53,10 @@ be used to debug Emacs with dense colormaps (PseudoColor). Check doc strings against documentation. +** cl-lib-deps-report.el + +Audit Lisp files for cl-lib usage and missing requires. + ** cus-test.el Tests for custom types and load problems. diff --git a/admin/cl-lib-deps-report.el b/admin/cl-lib-deps-report.el new file mode 100755 index 00000000000..37d741161ac --- /dev/null +++ b/admin/cl-lib-deps-report.el @@ -0,0 +1,162 @@ +:;exec emacs -Q --batch -l "$0" -- "$@" # -*- lexical-binding: t -*- +;;; cl-lib-deps-report.el --- report cl-lib dependencies in lisp files -*- lexical-binding: t -*- + +;; Copyright (C) 2026 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 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: + +;; Generate an Org report of cl-lib macro/function usage and missing +;; compile-time/runtime requires for files under lisp/. + +;;; Code: + +(require 'cl-lib) +(require 'org) + +(setq debug-on-error nil) + +(defun cl-lib-deps-report--scan-file (file symbol-re macros funcs) + "Return cl-lib usage data for FILE using SYMBOL-RE, MACROS, and FUNCS. +Exclude tokens found in strings or comments, and return a list with +dependency flags, require kind, and sorted symbol lists." + (with-temp-buffer + (insert-file-contents file) + (with-syntax-table emacs-lisp-mode-syntax-table + (let ((tokens '()) + (total-req 0) + (eval-req 0)) + (goto-char (point-min)) + (while (re-search-forward symbol-re nil t) + (let ((ppss (syntax-ppss))) + (unless (or (nth 3 ppss) (nth 4 ppss)) + (push (match-string 0) tokens)))) + (setq tokens (cl-delete-duplicates tokens :test #'string=)) + (let* ((macro-toks (cl-remove-if-not (lambda (tok) (member tok macros)) tokens)) + (func-toks (cl-remove-if-not (lambda (tok) (member tok funcs)) tokens)) + (macro-dep (and macro-toks t)) + (func-dep (and func-toks t))) + (goto-char (point-min)) + (while (re-search-forward "(require[[:space:]\n]*'cl-lib" nil t) + (let ((ppss (syntax-ppss))) + (unless (or (nth 3 ppss) (nth 4 ppss)) + (setq total-req (1+ total-req))))) + (goto-char (point-min)) + (while (re-search-forward "(eval-when-compile[[:space:]\n]*(require[[:space:]\n]*'cl-lib" nil t) + (let ((ppss (syntax-ppss))) + (unless (or (nth 3 ppss) (nth 4 ppss)) + (setq eval-req (1+ eval-req))))) + (let* ((runtime-req (> total-req eval-req)) + (eval-req-present (> eval-req 0)) + (require-kind + (cond + ((and (= total-req 0) (= eval-req 0)) "no") + ((> total-req eval-req) "runtime") + (t "compile-time")))) + (list macro-dep func-dep require-kind runtime-req eval-req-present + (sort macro-toks #'string<) + (sort func-toks #'string<)))))))) + +(defun cl-lib-deps-report--main (args) + "Generate an Org report of cl-lib dependencies under a Lisp directory. +ARGS should be `command-line-args-left', which starts with \"--\" when +invoked via the file's exec stub." + (let* ((script-dir (file-name-directory (or load-file-name buffer-file-name))) + (default-root (expand-file-name "../lisp" script-dir)) + ;; `command-line-args-left' includes a \"--\" sentinel from the exec stub. + (args (if (and args (string= (car args) "--")) (cdr args) args)) + (root (or (car args) default-root))) + (unless (file-directory-p root) + (princ (format "%s: Directory not found: %s\n" (or load-file-name "cl-lib-deps-report.el") root)) + (kill-emacs 1)) + (let* ((candidate-re "cl-[[:alnum:]-]+\\*?") + (symbol-re "\\_") + (pattern (format "%s|\\(require[[:space:]]*'cl-lib|\\(eval-when-compile[[:space:]]*\\(require[[:space:]]*'cl-lib" + candidate-re)) + (files + (let ((cmd (format "find %s -type f -name '*.el' -print0 | xargs -0 grep -l -E %s || true" + (shell-quote-argument root) + (shell-quote-argument pattern)))) + (with-temp-buffer + (call-process "sh" nil t nil "-c" cmd) + (split-string (buffer-string) "\n" t)))) + (macros '()) + (funcs '())) + (mapatoms + (lambda (sym) + (when (and (symbolp sym) + (string-prefix-p "cl-" (symbol-name sym))) + (cond + ((macrop sym) (push (symbol-name sym) macros)) + ((fboundp sym) (push (symbol-name sym) funcs)))))) + (setq macros (sort macros #'string<)) + (setq funcs (sort funcs #'string<)) + (setq files (sort files #'string<)) + (with-temp-buffer + (org-mode) + (insert (format "* cl-lib dependency report (%s)\n" root)) + (insert "** files\n") + (insert "| file | cl- macros used | cl- functions used | require |\n") + (insert "|------|-----------------|--------------------|---------|\n") + (let (runtime-missing compile-missing require-unneeded) + (dolist (file files) + (when (file-regular-p file) + (cl-destructuring-bind (macro-dep func-dep require-kind runtime-req eval-req-present macro-toks func-toks) + (cl-lib-deps-report--scan-file file symbol-re macros funcs) + (when (and func-dep (not runtime-req)) + (push (list file func-toks) runtime-missing)) + (when (and macro-dep (not eval-req-present)) + (push (list file macro-toks) compile-missing)) + (when (and (not func-dep) (not macro-dep) + (or runtime-req eval-req-present)) + (push file require-unneeded)) + (let ((skip + (or (and (not macro-dep) (not func-dep) + (string= require-kind "no")) + (and func-dep (string= require-kind "runtime")) + (and macro-dep (not func-dep) + (string= require-kind "compile-time"))))) + (unless skip + (insert (format "| %s | %s | %s | %s |\n" + file + (if macro-dep "yes" "no") + (if func-dep "yes" "no") + require-kind))))))) + (org-table-align) + (insert "** runtime dependency missing require\n") + (dolist (entry (sort runtime-missing (lambda (a b) (string< (car a) (car b))))) + (insert (format "- %s (%s)\n" + (car entry) + (mapconcat (lambda (s) (format "~%s~" s)) (cadr entry) ", ")))) + (insert "\n** compile-time dependency missing eval-when-compile require\n") + (dolist (entry (sort compile-missing (lambda (a b) (string< (car a) (car b))))) + (insert (format "- %s (%s)\n" + (car entry) + (mapconcat (lambda (s) (format "~%s~" s)) (cadr entry) ", ")))) + (insert "\n** no dependency but require present\n") + (dolist (f (sort require-unneeded #'string<)) + (insert (format "- %s\n" f))) + (insert "\n* Summary\n") + (insert (format "- Total files audited: %d\n" (length files))) + (insert (format "- Redundant requires found: %d\n" (length require-unneeded))) + (insert (format "- Missing runtime requires: %d\n" (length runtime-missing))) + (insert (format "- Missing compile-time requires: %d\n" (length compile-missing)))) + (princ (buffer-string)))))) + +(cl-lib-deps-report--main command-line-args-left) + +;;; cl-lib-deps-report.el ends here From 4efc4dcf301ee9118af626f5ad13103c5ea78669 Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Mon, 5 Jan 2026 02:54:30 +0900 Subject: [PATCH 167/325] ; Gnus: Remove redundant cl-lib runtime dependencies Since Emacs 31 moves 'incf' and 'decf' to core, these Gnus libraries no longer require 'cl-lib' at runtime. * lisp/gnus/gnus-async.el: * lisp/gnus/gnus-cache.el: * lisp/gnus/gnus-logic.el: * lisp/gnus/gnus-salt.el: * lisp/gnus/gnus-spec.el: * lisp/gnus/gnus-srvr.el: * lisp/gnus/gnus-topic.el: * lisp/gnus/gnus-uu.el: * lisp/gnus/gnus-win.el: * lisp/gnus/mm-encode.el: * lisp/gnus/mm-url.el: * lisp/gnus/nnatom.el: * lisp/gnus/nnbabyl.el: * lisp/gnus/nndoc.el: * lisp/gnus/nneething.el: * lisp/gnus/nnmail.el: * lisp/gnus/nnoo.el: * lisp/gnus/nnspool.el: * lisp/gnus/nnvirtual.el: * lisp/gnus/nnweb.el: Remove redundant (require 'cl-lib). (Bug#80129) --- lisp/gnus/gnus-async.el | 2 -- lisp/gnus/gnus-cache.el | 2 -- lisp/gnus/gnus-logic.el | 2 -- lisp/gnus/gnus-salt.el | 2 -- lisp/gnus/gnus-spec.el | 1 - lisp/gnus/gnus-srvr.el | 2 -- lisp/gnus/gnus-topic.el | 2 -- lisp/gnus/gnus-uu.el | 2 -- lisp/gnus/gnus-win.el | 2 -- lisp/gnus/mm-encode.el | 1 - lisp/gnus/mm-url.el | 2 -- lisp/gnus/nnatom.el | 1 - lisp/gnus/nnbabyl.el | 1 - lisp/gnus/nndoc.el | 1 - lisp/gnus/nneething.el | 2 -- lisp/gnus/nnmail.el | 2 -- lisp/gnus/nnoo.el | 1 - lisp/gnus/nnspool.el | 1 - lisp/gnus/nnvirtual.el | 1 - lisp/gnus/nnweb.el | 2 -- 20 files changed, 32 deletions(-) diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index a7488ec02b7..ddb9a4dce1b 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'nntp) diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 3bdf4712c01..ba652343a40 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 4345c5d27bf..7b95a4aaa49 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-score) (require 'gnus-util) diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index e5c4c9e122e..d70f7f8fe5c 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-sum) (require 'gnus-win) diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 6fd7b298d7e..6b920ed5e53 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -24,7 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (defvar gnus-newsrc-file-version) (require 'gnus) diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 849fe9d2129..312862df165 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-start) (require 'gnus-spec) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 7c05895e4d5..315f1a018c9 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -25,8 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-group) (require 'gnus-start) diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 7332fc57320..b32533e105e 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -26,8 +26,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-art) (require 'message) diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 7897589a902..d0505506ea6 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) (require 'gnus-util) (require 'seq) diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 253d31ccfb4..289192acdac 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -23,7 +23,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (require 'mail-parse) (autoload 'mailcap-extension-to-mime "mailcap") (autoload 'mm-body-7-or-8 "mm-bodies") diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index f48e7968097..15ff49ab770 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -28,8 +28,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'mm-util) (require 'gnus) diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el index afc19e5b624..45010ca765c 100644 --- a/lisp/gnus/nnatom.el +++ b/lisp/gnus/nnatom.el @@ -26,7 +26,6 @@ ;;; Code: (eval-when-compile - (require 'cl-lib) (require 'subr-x)) (require 'nnfeed) diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 767b3f16933..38f2ac31767 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -32,7 +32,6 @@ (require 'rmail) (require 'nnmail) (require 'nnoo) -(eval-when-compile (require 'cl-lib)) (nnoo-declare nnbabyl) diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 9e0659b06b6..f2769eb1012 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -33,7 +33,6 @@ (require 'nnoo) (require 'gnus-util) (require 'mm-util) -(eval-when-compile (require 'cl-lib)) (nnoo-declare nndoc) diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index ae06faff57d..498c2b4888a 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -25,8 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'mailcap) (require 'nnheader) (require 'nnmail) diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index e6fca7254ed..1577fb11f7f 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'gnus) ; for macro gnus-kill-buffer, at least (require 'nnheader) (require 'message) diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 62ddb73ce3d..5088afcd1af 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -25,7 +25,6 @@ ;;; Code: (require 'nnheader) -(eval-when-compile (require 'cl-lib)) (defvar nnoo-definition-alist nil) (defvar nnoo-state-alist nil) diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index c0923c1e4da..59805040e97 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -29,7 +29,6 @@ (require 'nnheader) (require 'nntp) (require 'nnoo) -(eval-when-compile (require 'cl-lib)) ;; Probably this entire thing should be obsolete. ;; It's only used to init nnspool-spool-directory, so why not just diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 75f44619e84..12657a698c6 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -38,7 +38,6 @@ (require 'gnus-start) (require 'gnus-sum) (require 'gnus-msg) -(eval-when-compile (require 'cl-lib)) (nnoo-declare nnvirtual) diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index ade8d4b1b87..b906f4610d6 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'nnoo) (require 'message) (require 'gnus-util) From c68c5fbe14657060381bc6069b7d5a2be3ee4fea Mon Sep 17 00:00:00 2001 From: USAMI Kenta Date: Mon, 5 Jan 2026 02:55:13 +0900 Subject: [PATCH 168/325] ; Remove redundant cl-lib runtime dependencies across lisp/ * lisp/editorconfig-tools.el: * lisp/emacs-lisp/shorthands.el: * lisp/info-xref.el: * lisp/international/quail.el: * lisp/international/rfc1843.el: * lisp/mail/ietf-drums.el: * lisp/mail/rfc2047.el: * lisp/mail/yenc.el: * lisp/net/pop3.el: * lisp/net/sasl-scram-sha256.el: * lisp/net/shr-color.el: * lisp/progmodes/grep.el: * lisp/scroll-bar.el: * lisp/textmodes/emacs-news-mode.el: * lisp/textmodes/reftex-auc.el: * lisp/textmodes/reftex-dcr.el: * lisp/textmodes/reftex-global.el: * lisp/textmodes/reftex-sel.el: * lisp/url/url-dav.el: * lisp/vc/vc-src.el: * lisp/xwidget.el: * lisp/yank-media.el: Remove redundant (require 'cl-lib). (Bug#80129) --- lisp/editorconfig-tools.el | 3 --- lisp/emacs-lisp/shorthands.el | 1 - lisp/info-xref.el | 1 - lisp/international/quail.el | 1 - lisp/international/rfc1843.el | 2 -- lisp/mail/ietf-drums.el | 2 -- lisp/mail/rfc2047.el | 1 - lisp/mail/yenc.el | 2 -- lisp/net/pop3.el | 2 -- lisp/net/sasl-scram-sha256.el | 1 - lisp/net/shr-color.el | 1 - lisp/progmodes/grep.el | 1 - lisp/scroll-bar.el | 1 - lisp/textmodes/emacs-news-mode.el | 1 - lisp/textmodes/reftex-auc.el | 2 -- lisp/textmodes/reftex-dcr.el | 2 -- lisp/textmodes/reftex-global.el | 1 - lisp/textmodes/reftex-sel.el | 2 -- lisp/url/url-dav.el | 2 -- lisp/vc/vc-src.el | 1 - lisp/xwidget.el | 1 - lisp/yank-media.el | 1 - 22 files changed, 32 deletions(-) diff --git a/lisp/editorconfig-tools.el b/lisp/editorconfig-tools.el index 4c687fbb570..ae793bff87a 100644 --- a/lisp/editorconfig-tools.el +++ b/lisp/editorconfig-tools.el @@ -31,12 +31,9 @@ ;;; Code: -(require 'cl-lib) - (eval-when-compile (require 'subr-x)) - (require 'editorconfig) ;;;###autoload diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el index 11f9175e468..9c668bb3720 100644 --- a/lisp/emacs-lisp/shorthands.el +++ b/lisp/emacs-lisp/shorthands.el @@ -28,7 +28,6 @@ ;;; Code: (require 'files) (require 'mule) -(eval-when-compile (require 'cl-lib)) (defun hack-read-symbol-shorthands () "Compute `read-symbol-shorthands' from Local Variables section." diff --git a/lisp/info-xref.el b/lisp/info-xref.el index e09c86ef811..df92c77c843 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -45,7 +45,6 @@ ;;; Code: (require 'info) -(eval-when-compile (require 'cl-lib)) ; for `cl-incf' (defgroup info-xref nil "Check external cross-references in Info documents." diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 7de35a3f5e4..eeea4574b42 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -53,7 +53,6 @@ ;;; Code: (require 'help-mode) -(eval-when-compile (require 'cl-lib)) (defgroup quail nil "Quail: multilingual input method." diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el index c938b6cc31c..261e5e02f9e 100644 --- a/lisp/international/rfc1843.el +++ b/lisp/international/rfc1843.el @@ -30,8 +30,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (defvar rfc1843-word-regexp "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)") diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 80949dff198..5ee822e2dec 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -27,8 +27,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177" "US-ASCII control characters excluding CR, LF and white space.") (defvar ietf-drums-text-token "\001-\011\013\014\016-\177" diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 089875209e9..a48b876443b 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -26,7 +26,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (defvar message-posting-charset) (require 'mm-util) diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el index fe3315a226f..88e56c7dc67 100644 --- a/lisp/mail/yenc.el +++ b/lisp/mail/yenc.el @@ -32,8 +32,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (defconst yenc-begin-line "^=ybegin.*$") diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 7d8442c64d2..246528a7176 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -34,8 +34,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'mail-utils) (defgroup pop3 nil diff --git a/lisp/net/sasl-scram-sha256.el b/lisp/net/sasl-scram-sha256.el index 4df500092b6..844425bdb43 100644 --- a/lisp/net/sasl-scram-sha256.el +++ b/lisp/net/sasl-scram-sha256.el @@ -26,7 +26,6 @@ ;;; Code: -(require 'cl-lib) (require 'sasl) (require 'hex-util) (require 'rfc2104) diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el index 45f600a480d..68bf2c418ec 100644 --- a/lisp/net/shr-color.el +++ b/lisp/net/shr-color.el @@ -27,7 +27,6 @@ ;;; Code: (require 'color) -(eval-when-compile (require 'cl-lib)) (defgroup shr-color nil "Simple HTML Renderer colors." diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index a14bd9e357b..e0552b3a7b2 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -29,7 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (require 'compile) (defgroup grep nil diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 09195ae6598..b9d1d3a441e 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -29,7 +29,6 @@ ;;; Code: (require 'mouse) -(eval-when-compile (require 'cl-lib)) ;;;; Utilities. diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el index 12687ff325e..511e6f4a669 100644 --- a/lisp/textmodes/emacs-news-mode.el +++ b/lisp/textmodes/emacs-news-mode.el @@ -23,7 +23,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (require 'outline) (require 'subr-x) ; `emacs-etc--hide-local-variables' diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 3f7709e1497..0396c3bcd8f 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'reftex) (declare-function TeX-argument-prompt "ext:tex" diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 3d49e2f2410..b2e1bb61ddb 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (declare-function bibtex-beginning-of-entry "bibtex" ()) (require 'reftex) diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 890bd9551c7..e9acf91c824 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -24,7 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (provide 'reftex-global) (require 'reftex) diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index dd119ae341b..f75b15c6eb9 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -24,8 +24,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'reftex) ;; Common bindings in reftex-select-label-mode-map diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 5c052ad92fe..275555b4838 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -27,8 +27,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) - (require 'xml) (require 'url-util) (require 'url-handlers) diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index fa664e51220..c43b37627fb 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -82,7 +82,6 @@ ;;; (eval-when-compile - (require 'cl-lib) (require 'vc)) (declare-function vc-setup-buffer "vc-dispatcher" (buf)) diff --git a/lisp/xwidget.el b/lisp/xwidget.el index d8aac1250c4..c75cd047495 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -31,7 +31,6 @@ ;; And is pointless when we do, since it's in C and so preloaded. ;;(require 'xwidget-internal) -(require 'cl-lib) (require 'bookmark) (require 'format-spec) diff --git a/lisp/yank-media.el b/lisp/yank-media.el index 8c55ee3da9f..f01d5ba7d59 100644 --- a/lisp/yank-media.el +++ b/lisp/yank-media.el @@ -24,7 +24,6 @@ ;;; Code: -(require 'cl-lib) (require 'seq) (defvar yank-media--registered-handlers nil) From bc5fb19d1667c4c572c904ae22c35cb4c63f60f4 Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Mon, 12 Jan 2026 12:51:11 +0200 Subject: [PATCH 169/325] NS: Fix startup with HAVE_NATIVE_COMP && !NS_SELF_CONTAINED * src/pdumper.c (pdumper_set_emacs_execdir): Add workaround for !NS_SELF_CONTAINED so that launching Emacs from the app bundle works flawlessly when built with native compilation. * configure.ac: Define BINDIR. (Bug#80094) --- configure.ac | 3 +++ src/pdumper.c | 24 +++++++++++++++++++----- 2 files changed, 22 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 5be2588600d..0c1c1e2d789 100644 --- a/configure.ac +++ b/configure.ac @@ -7200,6 +7200,9 @@ AC_SUBST([ns_appsrc]) AC_SUBST([GNU_OBJC_CFLAGS]) AC_SUBST([OTHER_FILES]) +AS_IF([test $prefix = "NONE"], [_prefix=/usr/local], [_prefix=$prefix]) +AC_DEFINE_UNQUOTED([BINDIR], ["${_prefix}/bin/"], [Executables directory.]) + if test -n "${term_header}"; then AC_DEFINE_UNQUOTED([TERM_HEADER], ["${term_header}"], [Define to the header for the built-in window system.]) diff --git a/src/pdumper.c b/src/pdumper.c index 6ab350fb2dd..615c0cf28c9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5648,11 +5648,25 @@ pdumper_set_emacs_execdir (char *emacs_executable) && !IS_DIRECTORY_SEP (p[-1])) --p; eassert (p > emacs_executable); - emacs_execdir = xpalloc (emacs_execdir, &execdir_size, - p - emacs_executable + 1 - execdir_size, -1, 1); - memcpy (emacs_execdir, emacs_executable, p - emacs_executable); - execdir_len = p - emacs_executable; - emacs_execdir[execdir_len] = '\0'; + +#if HAVE_NS && !NS_SELF_CONTAINED + if (strcmp (basename (emacs_executable), "Emacs") == 0) + { + /* This is the Emacs executable from the non-self-contained app + bundle which can be anywhere on the system. Fortunately, the + location of the Lisp resources is known. */ + emacs_execdir = (char *) BINDIR; + execdir_len = strlen (BINDIR); + } + else +#endif + { + emacs_execdir = xpalloc (emacs_execdir, &execdir_size, + p - emacs_executable + 1 - execdir_size, -1, 1); + memcpy (emacs_execdir, emacs_executable, p - emacs_executable); + execdir_len = p - emacs_executable; + emacs_execdir[execdir_len] = '\0'; + } } #endif From 023bf05816adb2036826a9ccc07b2f34cf763355 Mon Sep 17 00:00:00 2001 From: Pig Fang Date: Tue, 13 Jan 2026 01:46:15 +0000 Subject: [PATCH 170/325] Eglot: support 'wat-mode' * lisp/progmodes/eglot.el (eglot-server-programs): Add wat_server. (Bug#80188) Copyright-paperwork-exempt: yes --- lisp/progmodes/eglot.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 17c11af204e..3d4ff25528f 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -309,6 +309,7 @@ automatically)." ((latex-mode plain-tex-mode context-mode texinfo-mode bibtex-mode tex-mode) . ,(eglot-alternatives '("digestif" "texlab"))) (erlang-mode . ("erlang_ls" "--transport" "stdio")) + (wat-mode . ("wat_server")) ((yaml-ts-mode yaml-mode) . ("yaml-language-server" "--stdio")) ((toml-ts-mode conf-toml-mode) . ("tombi" "lsp")) (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp" "nixd"))) From 83f4e48106a44f1f152bb0ca83b1754fd65ec651 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jostein=20Kj=C3=B8nigsen?= Date: Thu, 15 Jan 2026 11:02:40 +0100 Subject: [PATCH 171/325] csharp-mode.el: Fix indentation after preprocessor statements * lisp/progmodes/csharp-mode.el (csharp-ts-mode--indent-rules): Add rules for preprocessor statements. (Bug#80202) --- lisp/progmodes/csharp-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el index c6e816430a7..6faf5a49da8 100644 --- a/lisp/progmodes/csharp-mode.el +++ b/lisp/progmodes/csharp-mode.el @@ -719,7 +719,9 @@ compilation and evaluation time conflicts." ((parent-is "using_statement") parent-bol 0) ((parent-is "lambda_expression") parent-bol 0) ((parent-is "try_statement") parent-bol 0) - ((parent-is "catch_filter_clause") parent-bol 0)))) + ((parent-is "catch_filter_clause") parent-bol 0) + ((parent-is "preproc_if") parent-bol 0) + ((parent-is "preproc_region") parent-bol 0)))) (defvar csharp-ts-mode--keywords '("using" "namespace" "class" "if" "else" "throw" "new" "for" From 83b4f1ba26844c178e57ecb93ea8db36e8e6fa89 Mon Sep 17 00:00:00 2001 From: kobarity Date: Sun, 4 Jan 2026 22:50:47 +0900 Subject: [PATCH 172/325] Performance improvement of 'python-shell-get-process' 'python-shell-get-process' is frequently called from 'python-eldoc--get-doc-at-point' and etc., invoking 'project-current' unless there is a buffer-specific Inferior Python process. When the buffer is a remote buffer not belonging to any project and has significant latency, 'project-current' may take a long time. To avoid this, implement a process cache in 'python-shell-get-process'. * lisp/progmodes/python.el (python-shell--process-cache) (python-shell--process-cache-valid): New variables. (python-shell--invalidate-process-cache): New function. (python-shell-make-comint): Add a call to the above function. (python-shell-get-process): Add process cache. (Bug#80045) --- lisp/progmodes/python.el | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 5a820f05d77..848a26229e6 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3816,6 +3816,16 @@ variable. (compilation-shell-minor-mode 1) (python-pdbtrack-setup-tracking)) +(defvar-local python-shell--process-cache) +(defvar-local python-shell--process-cache-valid) + +(defun python-shell--invalidate-process-cache () + "Invalidate process cache." + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (setq python-shell--process-cache nil + python-shell--process-cache-valid nil)))) + (defun python-shell-make-comint (cmd proc-name &optional show internal) "Create a Python shell comint buffer. CMD is the Python command to be executed and PROC-NAME is the @@ -3832,6 +3842,7 @@ killed." (let* ((proc-buffer-name (format (if (not internal) "*%s*" " *%s*") proc-name))) (when (not (comint-check-proc proc-buffer-name)) + (python-shell--invalidate-process-cache) (let* ((cmdlist (split-string-and-unquote cmd)) (interpreter (car cmdlist)) (args (cdr cmdlist)) @@ -3955,7 +3966,15 @@ If current buffer is in `inferior-python-mode', return it." (defun python-shell-get-process () "Return inferior Python process for current buffer." - (get-buffer-process (python-shell-get-buffer))) + (unless (and python-shell--process-cache-valid + (or (not python-shell--process-cache) + (and (process-live-p python-shell--process-cache) + (buffer-live-p + (process-buffer python-shell--process-cache))))) + (setq python-shell--process-cache + (get-buffer-process (python-shell-get-buffer)) + python-shell--process-cache-valid t)) + python-shell--process-cache) (defun python-shell-get-process-or-error (&optional interactivep) "Return inferior Python process for current buffer or signal error. From 6e4bceb8ce46488f96f4b162635e785e3a0b7ac1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 28 Dec 2025 12:10:02 +0000 Subject: [PATCH 173/325] Automatically detect the VC outgoing base (bug#80006) * lisp/vc/vc-git.el (vc-git--current-branch): Rename to ... (vc-git-working-branch): ... this. All uses changed. (vc-git-trunk-or-topic-p, vc-git-topic-outgoing-base): * lisp/vc/vc-hg.el (vc-hg--working-branch, vc-hg-working-branch) (vc-hg-trunk-or-topic-p, vc-hg-topic-outgoing-base): * lisp/vc/vc-hooks.el (vc--safe-branch-regexps-p): * lisp/vc/vc.el (vc-default-working-branch) (vc-default-trunk-or-topic-p, vc--match-branch-name-regexps) (vc--outgoing-base, vc--outgoing-base-mergebase) (vc--maybe-read-outgoing-base): New functions. (vc-diff-outgoing-base): Call vc--outgoing-base-mergebase. (vc-root-diff-outgoing-base, vc-diff-outgoing-base): Use vc--maybe-read-outgoing-base in interactive specification. (working-branch, trunk-or-topic-p, topic-outgoing-base): New specifications for backend functions. (vc-trunk-branch-regexps, vc-topic-branch-regexps): New variables. * .dir-locals.el: Commented entries for the new variables. * test/lisp/vc/vc-tests/vc-test-misc.el (vc-test-match-branch-name-regexps): New test. * doc/emacs/vc1-xtra.texi (Outstanding Changes): Document the new functionality. --- .dir-locals.el | 7 +- doc/emacs/vc1-xtra.texi | 128 +++++++++-- lisp/vc/vc-git.el | 80 ++++++- lisp/vc/vc-hg.el | 36 +++ lisp/vc/vc-hooks.el | 8 + lisp/vc/vc.el | 303 +++++++++++++++++++++++--- test/lisp/vc/vc-tests/vc-test-misc.el | 25 +++ 7 files changed, 526 insertions(+), 61 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index af92eac5bba..d9ccf82b166 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -15,7 +15,12 @@ "/[ \t]*DEFVAR_[A-Z_ \t(]+\"[^\"]+\",[ \t]\\([A-Za-z0-9_]+\\)/\\1/")))) (etags-regen-ignores . ("test/manual/etags/")) (vc-prepare-patches-separately . nil) - (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org"))) + (vc-default-patch-addressee . "bug-gnu-emacs@gnu.org") + ;; Uncomment these later once people's builds are likely to know + ;; they're safe local variable values. + ;; (vc-trunk-branch-regexps . ("master" "\\`emacs-[0-9]+\\'")) + ;; (vc-topic-branch-regexps . ("\\`feature/")) + )) (c-mode . ((c-file-style . "GNU") (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "ATTRIBUTE_NO_SANITIZE_ADDRESS" diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 8f9d3bf34e5..8ffd6506dbe 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -312,8 +312,8 @@ these commands provide specialized versions of @kbd{C-x v M D} (see @pxref{Merge Bases}) which also take into account the state of upstream repositories. These commands are useful both when working on a single branch and when developing features on a separate branch -(@pxref{Branches}). These two cases involve using the commands -differently, and so we will describe them separately. +(@pxref{Branches}). These two cases are conceptually distinct, and so +we will introduce them separately. First, consider working on a single branch. @dfn{Outstanding changes} are those which you haven't yet pushed upstream. This includes both @@ -341,12 +341,14 @@ commands, you can use a prefix argument to specify a particular upstream location.} Second, consider developing a feature on a separate branch. Call this -the @dfn{topic branch},@footnote{Topic branches are sometimes called -``feature branches''. It is also common for the term ``feature branch'' -to be reserved for a particular kind of topic branch, one that another -branch or other branches are repeatedly merged into.} and call the -branch from which the topic branch was originally created the -@dfn{trunk} or @dfn{development trunk}. +the @dfn{topic branch},@footnote{What we mean by a topic branch is any +shorter-lived branch used for work which will later be merged into a +longer-lived branch. Topic branches are sometimes called ``feature +branches''. It is also common for the term ``feature branch'' to be +reserved for a particular kind of topic branch, one that another branch +or other branches are repeatedly merged into.} and call the branch from +which the topic branch was originally created the @dfn{trunk} or +@dfn{development trunk}. In this case, outstanding changes is a more specific notion than just unpushed and uncommitted changes on the topic branch. You're not @@ -357,20 +359,104 @@ upstream repository's development trunk. That means committed changes on the topic branch that haven't yet been merged into the trunk, plus uncommitted changes. -@cindex outgoing base, version control -The @dfn{outgoing base} is the upstream location for which the changes -are destined once they are no longer outstanding. In this case, that's -the upstream version of the trunk, to which you and your collaborators -push finished work. +When the current branch is a topic branch and you type @kbd{C-x v o D}, +Emacs displays a summary of all the changes that are outstanding against +the trunk to which the current branch will be merged. This summary is +in the form of a diff of what committing and pushing all the changes, +@emph{and} subsequently merging the topic branch, would do to the trunk. +As above, you can use @kbd{C-x v o =} instead to limit the display of +changes to the current VC fileset. -To display a summary of outgoing changes in this multi-branch example, -supply a prefix argument, by typing @w{@kbd{C-u C-x v o =}} or -@w{@kbd{C-u C-x v o D}}. When prompted, enter the outgoing base. -Exactly what you must supply here depends on the name of your -development trunk and the version control system in use. For example, -with Git, usually you will enter @kbd{origin/master}. We hope to -improve these commands such that no prefix argument is required in the -multi-branch case, too. +This functionality relies on Emacs correctly detecting whether the +current branch is a trunk or a topic branch, and in the latter case, +correctly determining the branch to which the topic branch will +eventually be merged. If the autodetection doesn't produce the right +results, there are several options to tweak and override it. + +@vindex vc-trunk-branch-regexps +@vindex vc-topic-branch-regexps +The variables @code{vc-trunk-branch-regexps} and +@code{vc-topic-branch-regexps} contain lists of regular expressions +matching the names of branches that should always be considered trunk +and topic branches, respectively. You can also specify prefix arguments +to @kbd{C-x v o D} and @kbd{C-x v o =}. Here is a summary of how to use +these controls: + +@enumerate +@item +If the problem is that Emacs thinks your topic branch is a trunk, you +can add either its name, or a regular expression matching its name +(@pxref{Regexps}), to the @code{vc-topic-branch-regexps} variable. +There are a few special kinds of value to simplify common use cases: + +@itemize +@item +If an element contains no characters that are special in regular +expressions, then the regular expression is implictly anchored at both +ends, i.e., it matches only a branch with exactly that name. + +@item +If the first element of @code{vc-topic-branch-regexps} is the symbol +@code{not}, then the meaning of @code{vc-topic-branch-regexps} is +inverted, in that Emacs treats all branches whose names @emph{don't} +match any element of @code{vc-topic-branch-regexps} to be topic +branches. + +@item +If instead of a list of regular expressions the +@code{vc-topic-branch-regexps} variable has the special value @code{t}, +then Emacs treats as a topic branch any branch that the +@code{vc-trunk-branch-regexps} variable doesn't positively identify as a +trunk. +@end itemize + +@xref{Directory Variables}, regarding how to specify values of +@code{vc-topic-branch-regexps} and @code{vc-trunk-branch-regexps} for a +single VC repository. + +@item +If the problem is that Emacs thinks your trunk is a topic branch, you +can add either its name, or a regular expression matching its name, to +the @code{vc-trunk-branch-regexps} variable. This works just like +@code{vc-topic-branch-regexps} with the same special values we just +described. E.g., if the value of @code{vc-trunk-branch-regexps} is +@code{t}, Emacs treats as a trunk any branch that the +@code{vc-topic-branch-regexps} variable doesn't identify as a topic +branch. + +@item +Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v o @dots{}}}, +and Emacs will treat the current branch as a trunk, no matter what. +This is useful when you simply want to obtain a diff of all outgoing +changes (@pxref{VC Change Log}) plus uncommitted changes. + +@item +@cindex outgoing base, version control +Finally, you can take full manual control by supplying a single prefix +argument, i.e. @w{@kbd{C-u C-x v o @dots{}}}. Emacs will prompt you for +the @dfn{outgoing base}, which is the upstream location for which the +changes are destined once they are no longer outstanding. + +To treat the current branch as a trunk specify a reference to the +upstream version of the current branch, to which you and your +collaborators push finished work. To treat the current branch as a +topic branch specify a reference to the upstream version of the trunk to +which the topic branch will later be merged. + +Exactly how to specify a reference to the upstream version of a branch +depends on the version control system in use. For example, with Git, to +refer to the upstream version of a branch @var{foo}, you would supply +@kbd{origin/@var{foo}}. So if @var{foo} is the current branch then you +would enter an outgoing base of @kbd{origin/@var{foo}} to treat +@var{foo} as a trunk, or an outgoing base of @kbd{origin/@var{bar}} to +treat @var{foo} as a topic branch which will later be merged into a +trunk named @var{bar}. + +If there is a default option, it is what Emacs thinks you need to enter +in order to treat the current branch as a topic branch. If there is no +default, then entering nothing at the prompt means to treat the current +branch as a trunk. +@end enumerate @node Other Working Trees @subsubsection Multiple Working Trees for One Repository diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 29e8a24ca0a..73db9c0f181 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -767,13 +767,79 @@ or an empty string if none." :files files :update-function update-function))) -(defun vc-git--current-branch () +(defun vc-git-working-branch () + "Return the name of the current branch, or nil if HEAD is detached." (vc-git--out-match '("symbolic-ref" "HEAD") "^\\(refs/heads/\\)?\\(.+\\)$" 2)) +(defun vc-git-trunk-or-topic-p () + "Return `topic' if branch has distinct pull and push remotes, else nil. +This is able to identify topic branches for certain forge workflows." + (let* ((branch (vc-git-working-branch)) + (merge (string-trim-right + (vc-git--out-str "config" (format "branch.%s.remote" + branch)))) + (push (string-trim-right + (vc-git--out-str "config" (format "branch.%s.pushRemote" + branch)))) + (push (if (string-empty-p push) + (string-trim-right + (vc-git--out-str "config" "remote.pushDefault")) + push))) + (and (plusp (length merge)) + (plusp (length push)) + (not (equal merge push)) + 'topic))) + +(defun vc-git-topic-outgoing-base () + "Return the outgoing base for the current branch as a string. +This works by considering the current branch as a topic branch +(whether or not it actually is). +Requires that the corresponding trunk exists as a local branch. + +The algorithm employed is as follows. Find all merge bases between the +current branch and other local branches. Each of these is a commit on +the current branch. Use `git merge-base --independent' on them all to +find the topologically most recent. Take the branch for which that +commit is a merge base with the current branch to be the branch into +which the current branch will eventually be merged. Find its upstream. +(If there is more than one branch whose merge base with the current +branch is that same topologically most recent commit, try them +one-by-one, accepting the first that has an upstream.)" + (cl-flet ((get-line () (buffer-substring (point) (pos-eol)))) + (let* ((branches (vc-git-branches)) + (current (pop branches)) + merge-bases) + (with-temp-buffer + (dolist (branch branches) + (erase-buffer) + (when (vc-git--out-ok "merge-base" "--all" branch current) + (goto-char (point-min)) + (while (not (eobp)) + (push branch + (alist-get (get-line) merge-bases nil nil #'equal)) + (forward-line 1)))) + (erase-buffer) + (unless (apply #'vc-git--out-ok "merge-base" "--independent" + (mapcar #'car merge-bases)) + (error "`git merge-base --independent' failed")) + ;; If 'git merge-base --independent' printed more than one line, + ;; just pick the first. + (goto-char (point-min)) + (catch 'ret + (dolist (target (cdr (assoc (get-line) merge-bases))) + (erase-buffer) + (when (vc-git--out-ok "for-each-ref" + "--format=%(upstream:short)" + (concat "refs/heads/" target)) + (goto-char (point-min)) + (let ((outgoing-base (get-line))) + (unless (string-empty-p outgoing-base) + (throw 'ret outgoing-base)))))))))) + (defun vc-git-dir--branch-headers () "Return headers for branch-related information." - (let ((branch (vc-git--current-branch)) + (let ((branch (vc-git-working-branch)) tracking remote-url) (if branch (when-let* ((branch-merge @@ -1758,7 +1824,7 @@ If LIMIT is a non-empty string, use it as a base revision." ;; If the branch has no upstream, and we weren't supplied ;; with one, then fetching is always useless (bug#79952). (or upstream-location - (and-let* ((branch (vc-git--current-branch))) + (and-let* ((branch (vc-git-working-branch))) (with-temp-buffer (vc-git--out-ok "config" "--get" (format "branch.%s.remote" @@ -2235,7 +2301,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"." (defun vc-git-revision-published-p (rev) "Whether we think REV has been pushed such that it is public history. Considers only the current branch. Does not fetch." - (let ((branch (vc-git--current-branch)) + (let ((branch (vc-git-working-branch)) (rev (vc-git--rev-parse rev))) (vc-git--assert-revision-on-branch rev branch) (and @@ -2334,7 +2400,7 @@ Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) (defun vc-git-delete-revision (rev) "Rebase current branch to remove REV." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (with-temp-buffer (vc-git-command t 0 nil "log" "--merges" (format "%s~1.." rev)) (unless (bobp) @@ -2352,13 +2418,13 @@ Rebase may --autosquash your other squash!/fixup!/amend!; proceed?"))) (defun vc-git-delete-revisions-from-end (rev) "Hard reset back to REV. It is an error if REV is not on the current branch." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (vc-git-command nil 0 nil "reset" "--hard" rev)) (defun vc-git-uncommit-revisions-from-end (rev) "Mixed reset back to REV. It is an error if REV is not on the current branch." - (vc-git--assert-revision-on-branch rev (vc-git--current-branch)) + (vc-git--assert-revision-on-branch rev (vc-git-working-branch)) (vc-git-command nil 0 nil "reset" "--mixed" rev)) (defvar vc-git-extra-menu-map diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index aeed1de5567..90e25ba43f4 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -1941,6 +1941,42 @@ It is an error if REV is not on the current branch." (vc-hg--assert-rev-on-current-branch rev) (vc-hg--reset-back-to rev t)) +(defun vc-hg--working-branch () + "Return alist with currently active bookmark, if any, and current branch. +Keys into the alist are `branch' and `bookmark', values are the name of +the currently active bookmark (or nil) and the name of the current +branch, as strings." + (with-temp-buffer + (vc-hg-command t nil nil "summary") + (goto-char (point-min)) + (re-search-forward "^branch: \\(.+\\)$") + (let ((alist `((branch . ,(match-string 1))))) + (goto-char (point-min)) + (if (re-search-forward "^bookmarks: \\*\\(\\S-+\\)" nil t) + (cl-acons 'bookmark (match-string 1) alist) + alist)))) + +(defun vc-hg-working-branch () + "Return currently active bookmark if one exists, else current branch. +The return value is always a string." + (let ((alist (vc-hg--working-branch))) + (cdr (or (assq 'bookmark alist) (assq 'branch alist))))) + +(defun vc-hg-trunk-or-topic-p () + "Return `topic' if there is a currently active bookmark, else nil." + (and (assq 'bookmark (vc-hg--working-branch)) 'topic)) + +(defun vc-hg-topic-outgoing-base () + "Return outgoing base for current commit considered as a topic branch. +The current implementation always returns the name of the current +branch, meaning to query the remote head for the current branch +(and not any active bookmark if it also exists remotely). +This is based on the following assumptions: +(i) if there is an active bookmark, it will eventually be merged into + whatever the remote head is +(ii) there is only one remote head for the current branch." + (assq 'branch (vc-hg--working-branch))) + (provide 'vc-hg) ;;; vc-hg.el ends here diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index cab05c20db1..2e342c19919 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1187,6 +1187,14 @@ they had none before." (defun vc-default-extra-menu (_backend) nil) +(defun vc--safe-branch-regexps-p (val) + "Return non-nil if VAL is a safe local value for \\+`vc-*-branch-regexps'." + (or (eq val t) + (and (listp val) + (all (lambda (elt) + (or (symbolp elt) (stringp elt))) + val)))) + (provide 'vc-hooks) ;;; vc-hooks.el ends here diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index fc4a8b2d991..0ce4ce56363 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -610,6 +610,36 @@ ;; does a sanity check whether there aren't any uncommitted changes at ;; or below DIR, and then performs a tree walk, using the `checkout' ;; function to retrieve the corresponding revisions. +;; +;; - working-branch () +;; +;; Return the name of the current branch, if there is one, else nil. +;; +;; - trunk-or-topic-p () +;; +;; For the current branch, or the closest equivalent for a VCS without +;; named branches, return `trunk' if it is definitely a longer-lived +;; trunk branch, `topic' if it is definitely a shorter-lived topic +;; branch, or nil if no general determination can be made. +;; +;; What counts as a longer-lived or shorter-lived branch for VC is +;; explained in Info node `(emacs)Outstanding Changes' and in the +;; docstrings for the `vc-trunk-branch-regexps' and +;; `vc-topic-branch-regexps' user options. +;; +;; - topic-outgoing-base () +;; +;; Return an outgoing base for the current branch (or the closest +;; equivalent for a VCS without named branches) considered as a topic +;; branch. That is, on the assumption that the current branch is a +;; shorter-lived branch which will later be merged into a longer-lived +;; branch, return, if possible, the upstream location to which those +;; changes will be merged. See Info node `(emacs) Outstanding +;; Changes'. The return value should be suitable for passing to the +;; incoming-revision backend function as its UPSTREAM-LOCATION +;; argument. For example, for Git the value will typically be of the +;; form 'origin/foo' whereas Mercurial uses the unmodified name of the +;; longer-lived branch. ;; MISCELLANEOUS ;; @@ -3126,21 +3156,189 @@ global binding." (vc-symbolic-working-revision (caadr fileset) backend) (called-interactively-p 'interactive)))) -;; For the following two commands, the default meaning for -;; UPSTREAM-LOCATION may become dependent on whether we are on a -;; shorter-lived or longer-lived ("trunk") branch. If we are on the -;; trunk then it will always be the place `vc-push' would push to. If -;; we are on a shorter-lived branch, it may instead become the remote -;; trunk branch from which the shorter-lived branch was branched. That -;; way you can use these commands to get a summary of all unmerged work -;; outstanding on the short-lived branch. -;; -;; The obstacle to doing this is that VC lacks any distinction between -;; shorter-lived and trunk branches. But we all work with both of -;; these, for almost any VCS workflow. E.g. modern workflows which -;; eschew traditional feature branches still have a long-lived trunk -;; plus shorter-lived local branches for merge requests or patch series. -;; --spwhitton +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-trunk-branch-regexps 'safe-local-variable +;;;###autoload #'vc--safe-branch-regexps-p) +(defcustom vc-trunk-branch-regexps '("trunk" "master" "main" "default") + "Regular expressions matching the names of longer-lived VCS branches. +There value can be of one of the following forms: +- A list of regular expressions. A trunk branch is one whose name + matches any of the regular expressions. If an element of the list + contains no characters that are special in regular expressions, then + the regexp is implicitly anchored at both ends, i.e., it is the full + name of a branch. +- A list whose first element is `not' and whose remaining elements are + regular expressions. This is the same as the previous case except + that a trunk branch is one whose name does *not* match any of the + regular expressions. +- The symbol t. A trunk branch is any branch that + `vc-topic-branch-regexps' does not positively identify as a topic + branch. +- An empty list (or, the symbol nil). The branch name does not indicate + whether a branch is a trunk. Emacs will ask the backend whether it + thinks the current branch is a trunk. + +In VC, trunk branches are those where you've finished sharing the work +on the branch with your collaborators just as soon as you've checked it +in, and in the case of a decentralized VCS, pushed it. In addition, +typically you never delete trunk branches. + +The specific VCS workflow you are using may only acknowledge a single +trunk, and give other names to kinds of branches which VC would consider +to be just further trunks. + +If trunk branches in your project can be identified by name, include +regexps matching their names in the value of this variable. This is +more reliable than letting Emacs ask the backend. + +See also `vc-topic-branch-regexps'." + :type '(choice (repeat :tag "Regexps" string) + (cons :tag "Negated regexps" + (const not) (repeat :tag "Regexps" string)) + (const :tag "Inverse of `vc-branch-trunk-regexps'" t)) + :safe #'vc--safe-branch-regexps-p + :version "31.1") + +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-topic-branch-regexps 'safe-local-variable +;;;###autoload #'vc--safe-branch-regexps-p) +(defcustom vc-topic-branch-regexps nil + "Regular expressions matching the names of shorter-lived VCS branches. +There value can be of one of the following forms: +- A list of regular expressions. A topic branch is one whose name + matches any of the regular expressions. If an element of the list + contains no characters that are special in regular expressions, then + the regexp is implicitly anchored at both ends, i.e., it is the full + name of a branch. +- A list whose first element is `not' and whose remaining elements are + regular expressions. This is the same as the previous case except + that a topic branch is one whose name does *not* match any of the + regular expressions. +- The symbol t. A topic branch is any branch that + `vc-trunk-branch-regexps' does not positively identify as a trunk + branch. +- An empty list (or, the symbol nil). The branch name does not indicate + whether a branch is a topic branch. Emacs will ask the backend + whether it thinks the current branch is a topic branch. + +In VC, topic branches are those where checking in work, and pushing it +in the case of a decentralized VCS, is not enough to complete the +process of sharing the changes with your collaborators. In addition, +it's required that you merge the topic branch into another branch. +After this is done, typically you delete the topic branch. + +Topic branches are sometimes called \"feature branches\", though it is +also common for that term to be reserved for only a certain kind of +topic branch. + +If topic branches in your project can be identified by name, include +regexps matching their names in the value of this variable. This is +more reliable than letting Emacs ask the backend. + +See also `vc-trunk-branch-regexps'." + :type '(choice (repeat :tag "Regexps" string) + (cons :tag "Negated regexps" + (const not) (repeat :tag "Regexps" string)) + (const :tag "Inverse of `vc-trunk-branch-regexps'" t)) + :safe #'vc--safe-branch-regexps-p + :version "31.1") + +(defun vc--match-branch-name-regexps (branch) + "Match against `vc-trunk-branch-regexps' and `vc-topic-branch-regexps'. +See the docstrings for those two variables for how this matching works. + +If BRANCH matches both sets of regexps we signal an error; this is to +allow for future extension. +If BRANCH matches neither set of regexps return nil to mean that the +defcustoms don't decide the matter of which kind of branch this is." + (when (and (eq vc-trunk-branch-regexps t) + (eq vc-topic-branch-regexps t)) + (user-error "\ +`vc-trunk-branch-regexps' and `vc-topic-branch-regexps' cannot both be `t'")) + (cl-labels ((join-regexps (regexps) + (mapconcat (lambda (elt) + (format (if (equal (regexp-quote elt) elt) + "\\`%s\\'" + "\\(?:%s\\)") + elt)) + regexps "\\|")) + (compile-regexps (regexps) + (if regexps + (let* ((negated (eq (car regexps) 'not)) + (joined (join-regexps (if negated + (cdr regexps) + regexps)))) + (if negated + (lambda (s) (not (string-match-p joined s))) + (lambda (s) (string-match-p joined s)))) + #'ignore)) + (match-trunk (if (eq vc-trunk-branch-regexps t) + (lambda (s) (not (match-topic s))) + (compile-regexps vc-trunk-branch-regexps))) + (match-topic (if (eq vc-topic-branch-regexps t) + (lambda (s) (not (match-trunk s))) + (compile-regexps vc-topic-branch-regexps)))) + (let ((trunk (match-trunk branch)) + (topic (match-topic branch))) + (cond ((and trunk topic) + (error "Branch name `%s' matches both \ +`vc-trunk-branch-regexps' and `vc-topic-branch-regexps'" + branch)) + (trunk 'trunk) + (topic 'topic))))) + +(defun vc--outgoing-base (backend) + "Return an outgoing base for the current branch under VC backend BACKEND. +The outgoing base is the upstream location for which outstanding changes +on this branch are destined once they are no longer outstanding. + +There are two stages to determining the outgoing base. +First we decide whether we think this is a shorter-lived or a +longer-lived (\"trunk\") branch (see `vc-trunk-branch-regexps' and +`vc-topic-branch-regexps' regarding this distinction), as follows: +1. Ask the backend for the name of the current branch. + If it returns non-nil, compare that name against + `vc-trunk-branch-regexps' and `vc-topic-branch-regexps'. +2. If that doesn't settle it, either because the backend returns nil for + the name of the current branch, or because comparing the name against + the two regexp defcustoms yields no decisive answer, call BACKEND's + `trunk-or-topic-p' VC API function. +3. If that doesn't settle it either, assume this is a shorter-lived + branch. This is based on how it's commands primarily intended for + working with shorter-lived branches that call this function. +Second, if we have determined that this is a trunk, return nil, meaning +that the outgoing base is the place to which `vc-push' would push. +Otherwise, we have determined that this is a shorter-lived branch, and +we return the value of calling BACKEND's `topic-outgoing-base' VC API +function." + ;; For further discussion see bug#80006. + (let* ((branch (vc-call-backend backend 'working-branch)) + (type (or (and branch (vc--match-branch-name-regexps branch)) + (vc-call-backend backend 'trunk-or-topic-p) + 'topic))) + (and (eq type 'topic) + (vc-call-backend backend 'topic-outgoing-base)))) + +(defun vc--outgoing-base-mergebase (backend &optional upstream-location refresh) + "Return, under VC backend BACKEND, the merge base with UPSTREAM-LOCATION. +Normally UPSTREAM-LOCATION, if non-nil, is a string. +If UPSTREAM-LOCATION is nil, it means to call `vc--outgoing-base' and +use its return value as UPSTREAM-LOCATION. If `vc--outgoing-base' +returns nil, that means to use the place to which `vc-push' would push. +If UPSTREAM-LOCATION is the special value t, it means to use the place +to which `vc-push' would push as UPSTREAM-LOCATION, unconditionally. +(This is passed when the user invokes an outgoing base command with a + \\`C-u C-u' prefix argument; see `vc--maybe-read-outgoing-base'.) +REFRESH is passed on to `vc--incoming-revision'." + (if-let* ((incoming + (vc--incoming-revision backend + (pcase upstream-location + ('t nil) + ('nil (vc--outgoing-base backend)) + (_ upstream-location)) + refresh))) + (vc-call-backend backend 'mergebase incoming) + (user-error "No incoming revision -- local-only branch?"))) ;;;###autoload (defun vc-root-diff-outgoing-base (&optional upstream-location) @@ -3149,17 +3347,23 @@ The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -This command is like `vc-root-diff-outgoing' except that it includes -uncommitted changes." - (interactive (list (vc--maybe-read-upstream-location))) +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.)" + (interactive (list (vc--maybe-read-outgoing-base))) (vc--with-backend-in-rootdir "VC root-diff" (vc-diff-outgoing-base upstream-location `(,backend (,rootdir))))) @@ -3171,24 +3375,31 @@ The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -When called from Lisp, optional argument FILESET overrides the fileset. +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.) -This command is like to `vc-diff-outgoing' except that it includes -uncommitted changes." - (interactive (list (vc--maybe-read-upstream-location) nil)) - (let* ((fileset (or fileset (vc-deduce-fileset t))) - (backend (car fileset)) - (incoming (vc--incoming-revision backend upstream-location))) +When called from Lisp, optional argument FILESET overrides the fileset." + (interactive (let ((fileset (vc-deduce-fileset t))) + (list (vc--maybe-read-outgoing-base (car fileset)) + fileset))) + (let ((fileset (or fileset (vc-deduce-fileset t)))) (vc-diff-internal vc-allow-async-diff fileset - (vc-call-backend backend 'mergebase incoming) + (vc--outgoing-base-mergebase (car fileset) + upstream-location) nil (called-interactively-p 'interactive)))) @@ -4113,11 +4324,36 @@ starting at that revision. Tags and remote references also work." "History of upstream locations for VC incoming and outgoing commands.") (defun vc--maybe-read-upstream-location () + "Read upstream location if there is a prefix argument, else return nil." (and current-prefix-arg (let ((res (read-string "Upstream location/branch (empty for default): " nil 'vc-remote-location-history))) (and (not (string-empty-p res)) res)))) +(defun vc--maybe-read-outgoing-base (&optional backend) + "Return upstream location for interactive uses of outgoing base commands. +If there is no prefix argument, return nil. +If the current prefix argument is \\`C-u C-u', return t. +Otherwise prompt for an upstream location. +BACKEND is the VC backend." + (cond + ((equal current-prefix-arg '(16)) t) + (current-prefix-arg + (let* ((outgoing-base (vc-call-backend (or backend + (vc-deduce-backend)) + 'topic-outgoing-base)) + ;; If OUTGOING-BASE is non-nil then it isn't possible to + ;; specify an empty string in response to the prompt, which + ;; normally means to treat the current branch as a trunk. + ;; That's okay because you can use a double prefix argument + ;; to force treating the current branch as a trunk. + (res (read-string (if outgoing-base + (format-prompt "Upstream location/branch" + outgoing-base) + "Upstream location/branch (empty to treat as trunk): ") + nil 'vc-remote-location-history outgoing-base))) + (and (not (string-empty-p res)) res))))) + (defun vc--incoming-revision (backend &optional upstream-location refresh) ;; Some backends don't support REFRESH and so always behave as though ;; REFRESH is non-nil. This is not just for a lack of implementation @@ -5624,6 +5860,9 @@ except that this command works only in file-visiting buffers." 'get-change-comment))) (format "Summary: %s\n" (string-trim (funcall fn files rev)))))) +(defalias 'vc-default-working-branch #'ignore) +(defalias 'vc-default-trunk-or-topic-p #'ignore) + ;; These things should probably be generally available diff --git a/test/lisp/vc/vc-tests/vc-test-misc.el b/test/lisp/vc/vc-tests/vc-test-misc.el index 6bf0aed46d9..72dc8de22bf 100644 --- a/test/lisp/vc/vc-tests/vc-test-misc.el +++ b/test/lisp/vc/vc-tests/vc-test-misc.el @@ -217,5 +217,30 @@ (should (equal (buffer-string) "foo\n")))) (kill-buffer buf)))) +(ert-deftest vc-test-match-branch-name-regexps () + "Test `vc--match-branch-name-regexps'." + (let ((vc-trunk-branch-regexps '("master" "main"))) + (let ((vc-topic-branch-regexps '("m.*"))) + (should-error (vc--match-branch-name-regexps "master"))) + (let ((vc-topic-branch-regexps '("f" "o"))) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (null (vc--match-branch-name-regexps "foo")))) + (let ((vc-topic-branch-regexps '("f.*" "o"))) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (eq (vc--match-branch-name-regexps "foo") 'topic))) + (let (vc-topic-branch-regexps) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (null (vc--match-branch-name-regexps "foo")))) + (let ((vc-topic-branch-regexps t)) + (should (eq (vc--match-branch-name-regexps "master") 'trunk)) + (should (eq (vc--match-branch-name-regexps "foo") 'topic)))) + (let ((vc-trunk-branch-regexps '(not "master"))) + (let (vc-topic-branch-regexps) + (should (null (vc--match-branch-name-regexps "master"))) + (should (eq (vc--match-branch-name-regexps "foo") 'trunk))) + (let ((vc-topic-branch-regexps t)) + (should (eq (vc--match-branch-name-regexps "master") 'topic)) + (should (eq (vc--match-branch-name-regexps "foo") 'trunk))))) + (provide 'vc-test-misc) ;;; vc-test-misc.el ends here From 852ca2ff40e6488ea807f02b9ad1f939555dd943 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 10 Jan 2026 11:57:09 +0000 Subject: [PATCH 174/325] Disable diff-restrict-view by default * lisp/vc/diff-mode.el (diff-restrict-view): Disable it. * etc/NEWS: Announce the change. --- etc/NEWS | 7 +++++++ lisp/vc/diff-mode.el | 1 + 2 files changed, 8 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index b3b9a84680e..d21cf659bfb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2825,6 +2825,13 @@ already have, consider replacing the default global bindings, like this: --- *** New command alias 'vc-restore' for 'vc-revert'. +--- +*** The 'diff-restrict-view' command is disabled by default. +This command is Diff mode's specialized 'narrow-to-region'. +'narrow-to-region' has long been disabled by default, so for +consistency, 'diff-restrict-view' is now too. +To enable it again, use 'M-x enable-command'. + ** Package +++ diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index dcba8c44792..5286a079b4c 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -875,6 +875,7 @@ If the prefix ARG is given, restrict the view to the current file instead." (apply #'narrow-to-region (if arg (diff-bounds-of-file) (diff-bounds-of-hunk))) (setq-local diff-narrowed-to (if arg 'file 'hunk))) +(put 'diff-restrict-view 'disabled t) (defun diff--some-hunks-p () (save-excursion From da9792166b143bbe6e3efa73298cb4a921634a9d Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 17 Jan 2026 17:20:22 +0000 Subject: [PATCH 175/325] ; * lisp/ldefs-boot.el: Regenerate. --- lisp/ldefs-boot.el | 156 +++++++++++++++++++++++++++++++-------------- 1 file changed, 107 insertions(+), 49 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 793b54f82d1..e20d8609e88 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5259,6 +5259,8 @@ evaluate the variable `compilation-shell-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{compilation-shell-minor-mode-map} + (fn &optional ARG)" t) (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. @@ -5281,6 +5283,8 @@ evaluate the variable `compilation-minor-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{compilation-minor-mode-map} + (fn &optional ARG)" t) (autoload 'compilation-next-error-function "compile" "\ Advance to the next error message and visit the file where the error was. @@ -9805,7 +9809,7 @@ Turn on EDT Emulation." t) ;;; Generated autoloads from progmodes/eglot.el -(push '(eglot 1 19) package--builtin-versions) +(push '(eglot 1 21) package--builtin-versions) (define-obsolete-function-alias 'eglot-update #'eglot-upgrade-eglot "29.1") (autoload 'eglot "eglot" "\ Start LSP server for PROJECT's buffers under MANAGED-MAJOR-MODES. @@ -9861,6 +9865,8 @@ command only needs to be invoked once per project, as all other files of a given major mode visited within the same project will automatically become managed with no further user intervention needed.") +(autoload 'eglot-manual "eglot" "\ +Read Eglot's manual." t) (autoload 'eglot-upgrade-eglot "eglot" "\ Update Eglot to latest version. @@ -13685,6 +13691,8 @@ evaluate the variable `flymake-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{flymake-mode-map} + (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ Turn Flymake mode on.") @@ -13982,7 +13990,7 @@ value associated with ?b in SPECIFICATION, either padding it with leading zeros or truncating leading characters until it's ten characters wide\". -the substitution for a specification character can also be a +The substitution for a specification character can also be a function, taking no arguments and returning a string to be used for the replacement. It will only be called if FORMAT uses that character. For example: @@ -13996,6 +14004,9 @@ like above, so that it is compiled by the byte-compiler. Any text properties of FORMAT are copied to the result, with any text properties of a %-spec itself copied to its substitution. +However, note that face properties from the two sources are not +merged; the face properties of %-spec override the face properties +of substitutions, if any, in the result. IGNORE-MISSING indicates how to handle %-spec characters not present in SPECIFICATION. If it is nil or omitted, emit an @@ -19216,7 +19227,7 @@ Define an inline function NAME with arguments ARGS and body in BODY. This is halfway between `defmacro' and `defun'. BODY is used as a blueprint both for the body of the function and for the body of the compiler-macro used to generate the code inlined at each call site. -See Info node `(elisp)Inline Functions for more details. +See Info node `(elisp)Inline Functions' for more details. A (noinline t) in the `declare' form prevents the definition of the compiler macro. This is for the rare case in which you want to use this @@ -19453,6 +19464,7 @@ Selections are: \\`m' Place typed-in value in personal dictionary, then recheck current word. \\`C-l' Redraw screen. \\`C-r' Recursive edit. +\\`C-u' Toggle abbrev saving for an immediately subsequent replacement command. \\`C-z' Suspend Emacs or iconify frame.") (autoload 'ispell-kill-ispell "ispell" "\ Kill current Ispell process (so that you may start a fresh one). @@ -24627,10 +24639,6 @@ Each directory name should be absolute. These directories contain packages intended for system-wide; in contrast, `package-user-dir' contains packages for personal use." :type '(repeat directory) :initialize #'custom-initialize-delay :group 'applications :risky t :version "24.1") (custom-autoload 'package-directory-list "package" t) -(defvar package-activated-list nil "\ -List of the names of currently activated packages.") -(defvar package--activated nil "\ -Non-nil if `package-activate-all' has been run.") (autoload 'package-initialize "package" "\ Load Emacs Lisp packages, and activate them. The variable `package-load-list' controls which packages to load. @@ -24648,9 +24656,6 @@ you have code which must run before `package-initialize', put that code in the early init-file. (fn &optional NO-ACTIVATE)" t) -(defun package-activate-all nil "\ -Activate all installed packages. -The variable `package-load-list' controls which packages to load." (setq package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) (or (and qs (not (bound-and-true-p package-activated-list)) (with-demoted-errors "Error during quickstart: %S" (let ((load-source-file-function nil)) (unless (boundp 'package-activated-list) (setq package-activated-list nil)) (load qs nil 'nomessage) t))) (progn (require 'package) (with-no-warnings (package--activate-all)))))) (autoload 'package-import-keyring "package" "\ Import keys from FILE. @@ -24665,14 +24670,6 @@ downloads in the background. This is always the case when the command is invoked interactively. (fn &optional ASYNC)" t) -(autoload 'package-installed-p "package" "\ -Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. -If PACKAGE is a symbol, it is the package name and MIN-VERSION -should be a version list. - -If PACKAGE is a `package-desc' object, MIN-VERSION is ignored. - -(fn PACKAGE &optional MIN-VERSION)") (autoload 'package-install "package" "\ Install the package PKG. @@ -24693,7 +24690,7 @@ If the command is invoked with a prefix argument, it will allow upgrading of built-in packages, as if `package-install-upgrade-built-in' had been enabled. -(fn PKG &optional DONT-SELECT)" t) +(fn PKG &optional DONT-SELECT INTERACTIVE)" t) (autoload 'package-upgrade "package" "\ Upgrade package NAME if a newer version exists. @@ -24779,14 +24776,6 @@ short description. (fn &optional NO-FETCH)" t) (defalias 'package-list-packages 'list-packages) -(autoload 'package-get-version "package" "\ -Return the version number of the package in which this is used. -Assumes it is used from an Elisp file placed inside the top-level directory -of an installed ELPA package. -The return value is a string (or nil in case we can't find it). -It works in more cases if the call is in the file which contains -the `Version:' header.") -(function-put 'package-get-version 'pure 't) (defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\ Location of the file used to speed up activation of packages at startup." :type 'file :group 'applications :initialize #'custom-initialize-delay :version "27.1") (custom-autoload 'package-quickstart-file "package" t) @@ -24797,6 +24786,35 @@ DESC must be a `package-desc' object. (fn DESC)" '(package-menu-mode)) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")) + +;;; Generated autoloads from emacs-lisp/package-activate.el + +(push '(package-activate 1 1 0) package--builtin-versions) +(defvar package-activated-list nil "\ +List of the names of currently activated packages.") +(defvar package--activated nil "\ +Non-nil if `package-activate-all' has been run.") +(defun package-activate-all nil "\ +Activate all installed packages. +The variable `package-load-list' controls which packages to load." (setq package--activated t) (let* ((elc (concat package-quickstart-file "c")) (qs (if (file-readable-p elc) elc (if (file-readable-p package-quickstart-file) package-quickstart-file)))) (or (and qs (not (bound-and-true-p package-activated-list)) (with-demoted-errors "Error during quickstart: %S" (let ((load-source-file-function nil)) (unless (boundp 'package-activated-list) (setq package-activated-list nil)) (load qs nil 'nomessage) t))) (progn (require 'package) (with-no-warnings (package--activate-all)))))) +(autoload 'package-installed-p "package-activate" "\ +Return non-nil if PACKAGE, of MIN-VERSION or newer, is installed. +If PACKAGE is a symbol, it is the package name and MIN-VERSION +should be a version list. + +If PACKAGE is a `package-desc' object, MIN-VERSION is ignored. + +(fn PACKAGE &optional MIN-VERSION)") +(autoload 'package-get-version "package-activate" "\ +Return the version number of the package in which this is used. +Assumes it is used from an Elisp file placed inside the top-level directory +of an installed ELPA package. +The return value is a string (or nil in case we can't find it). +It works in more cases if the call is in the file which contains +the `Version:' header.") +(function-put 'package-get-version 'pure 't) +(register-definition-prefixes "package-activate" '("package-")) + ;;; Generated autoloads from emacs-lisp/package-vc.el @@ -26527,7 +26545,7 @@ Open profile FILENAME. ;;; Generated autoloads from progmodes/project.el -(push '(project 0 11 1) package--builtin-versions) +(push '(project 0 11 2) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -26820,7 +26838,8 @@ would otherwise have the same name. Whether to show current project name and Project menu on the mode line. This feature requires the presence of the following item in `mode-line-format': `(project-mode-line project-mode-line-format)'; it -is part of the default mode line beginning with Emacs 30.") +is part of the default mode line beginning with Emacs 30. When the +value is `non-remote', show the project name only for local files.") (custom-autoload 'project-mode-line "project" t) (register-definition-prefixes "project" '("project-" "vc-")) @@ -27730,6 +27749,8 @@ evaluate the variable `rectangle-mark-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. +\\{rectangle-mark-mode-map} + (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) @@ -33990,9 +34011,9 @@ of the file before running this function, by default can look like one of the following (your choice): Time-stamp: <> Time-stamp: \" \" -This function writes the current time between the brackets or quotes, -by default formatted like this: - Time-stamp: <2024-08-07 17:10:21 gildea> +This function writes the current time between the angle brackets +or quotes, by default formatted like this: + Time-stamp: <2025-08-07 17:10:21 gildea> Although you can run this function manually to update a time stamp once, usually you want automatic time stamp updating. @@ -34010,7 +34031,8 @@ If the file has no time stamp template or if `time-stamp-active' is nil, this function does nothing. You can set `time-stamp-pattern' in a file's local variables list -to customize the information in the time stamp and where it is written." t) +to customize the information in the time stamp, the surrounding +template, and where in the file it can occur." t) (autoload 'time-stamp-toggle-active "time-stamp" "\ Set `time-stamp-active' (whether \\[time-stamp] updates a buffer). If ARG is unset, toggle `time-stamp-active'. With an arg, set @@ -34559,13 +34581,13 @@ This is like `trace-function-foreground', but without popping up the output buffer or changing the window configuration. (fn FUNCTION &optional BUFFER CONTEXT)" t) -(defalias 'trace-function 'trace-function-foreground) +(defalias 'trace-function #'trace-function-foreground) (register-definition-prefixes "trace" '("inhibit-trace" "trace-" "untrace-")) ;;; Generated autoloads from emacs-lisp/track-changes.el -(push '(track-changes 1 4) package--builtin-versions) +(push '(track-changes 1 5) package--builtin-versions) (register-definition-prefixes "track-changes" '("track-changes-" "with--track-changes")) @@ -34751,13 +34773,13 @@ Interactively, with a prefix argument, prompt for a different method." t) ;;; Generated autoloads from net/trampver.el -(push '(tramp 2 8 1 -1) package--builtin-versions) +(push '(tramp 2 8 2 -1) package--builtin-versions) (register-definition-prefixes "trampver" '("tramp-")) ;;; Generated autoloads from transient.el -(push '(transient 0 11 0) package--builtin-versions) +(push '(transient 0 12 0) package--builtin-versions) (autoload 'transient-insert-suffix "transient" "\ Insert a SUFFIX into PREFIX before LOC. PREFIX is a prefix command, a symbol. @@ -36515,22 +36537,31 @@ See `vc-use-incoming-outgoing-prefixes' regarding giving this command a global binding. (fn &optional UPSTREAM-LOCATION FILESET)" t) + (put 'vc-trunk-branch-regexps 'safe-local-variable + #'vc--safe-branch-regexps-p) + (put 'vc-topic-branch-regexps 'safe-local-variable + #'vc--safe-branch-regexps-p) (autoload 'vc-root-diff-outgoing-base "vc" "\ Report diff of all changes since the merge base with UPSTREAM-LOCATION. The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -This command is like `vc-root-diff-outgoing' except that it includes -uncommitted changes. +When called interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.) (fn &optional UPSTREAM-LOCATION)" t) (autoload 'vc-diff-outgoing-base "vc" "\ @@ -36540,16 +36571,23 @@ The merge base with UPSTREAM-LOCATION means the common ancestor of the working revision and UPSTREAM-LOCATION. Uncommitted changes are included in the diff. -When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push -to. This default meaning for UPSTREAM-LOCATION may change in a future -release of Emacs. +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. When called interactively with a prefix argument, prompt for UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION can be a remote branch name. -This command is like to `vc-diff-outgoing' except that it includes -uncommitted changes. +When called interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. (With a double prefix argument, this command is like +`vc-diff-outgoing' except that it includes uncommitted changes.) + +When called from Lisp, optional argument FILESET overrides the fileset. (fn &optional UPSTREAM-LOCATION FILESET)" t) (autoload 'vc-version-ediff "vc" "\ @@ -36700,6 +36738,16 @@ the full log message and the author. Additional control of the shown log style is available via `vc-log-short-style'. (fn &optional WORKING-REVISION LIMIT)" t) +(autoload 'vc-print-change-log "vc" "\ +Show in another window the VC change history of the current fileset. +With a \\[universal-argument] prefix argument, prompt for a branch or revision to log +instead of the working revision, and a number specifying the maximum +number of revisions to show; the default is `vc-log-show-limit'. +You can also use a numeric prefix argument to specify this. + +This is like `vc-print-log' but with an alternative prefix argument that +some users might prefer for interactive usage." t) +(function-put 'vc-print-change-log 'interactive-only 'vc-print-log) (autoload 'vc-print-root-log "vc" "\ Show in another window VC change history of the current VC controlled tree. If LIMIT is non-nil, it should be a number specifying the maximum @@ -36711,6 +36759,16 @@ the command prompts for the id of a REVISION, and shows that revision with its diffs (if the underlying VCS backend supports that). (fn &optional LIMIT REVISION)" t) +(autoload 'vc-print-root-change-log "vc" "\ +Show in another window the VC change history of the whole tree. +With a \\[universal-argument] prefix argument, prompt for a branch or revision to log +instead of the working revision, and a number specifying the maximum +number of revisions to show; the default is `vc-log-show-limit'. +You can also use a numeric prefix argument to specify this. + +This is like `vc-root-print-log' but with an alternative prefix argument +that some users might prefer for interactive usage." t) +(function-put 'vc-print-root-change-log 'interactive-only 'vc-print-root-log) (autoload 'vc-print-fileset-branch-log "vc" "\ Show log of VC changes on BRANCH, limited to the current fileset. When called interactively, prompts for BRANCH. @@ -36727,7 +36785,7 @@ can specify a revision ID instead of a branch name to produce a log starting at that revision. Tags and remote references also work. (fn BRANCH)" t) -(autoload 'vc-log-incoming "vc" "\ +(autoload 'vc-root-log-incoming "vc" "\ Show log of changes that will be received with pull from UPSTREAM-LOCATION. When unspecified UPSTREAM-LOCATION is the place \\[vc-update] would pull from. When called interactively with a prefix argument, prompt for @@ -36735,7 +36793,7 @@ UPSTREAM-LOCATION. In some version control systems UPSTREAM-LOCATION can be a remote branch name. (fn &optional UPSTREAM-LOCATION)" t) -(autoload 'vc-log-outgoing "vc" "\ +(autoload 'vc-root-log-outgoing "vc" "\ Show log of changes that will be sent with a push to UPSTREAM-LOCATION. When unspecified UPSTREAM-LOCATION is the place \\[vc-push] would push to. When called interactively with a prefix argument, prompt for From 60ed7688b507aa0bba447c062dceaae7b9e8c442 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 10 Jan 2026 17:17:08 +0100 Subject: [PATCH 176/325] Quote diff when reviewing package * lisp/emacs-lisp/package.el (package-review): Run 'comment-region' on the output of diff. --- lisp/emacs-lisp/package.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4e0bbdd514c..f2389ce8d9a 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -797,7 +797,10 @@ attached." (pcase mail-user-agent ('sendmail-user-agent (mail-text)) (_ (message-goto-body))) - (insert-buffer-substring tmp-buf))) + (let ((start (point))) + (save-excursion + (insert-buffer-substring tmp-buf) + (comment-region start (point)))))) t) (?c (view-file news) From 18a5151cd118e72f6a9b46fd0834a5488112fa31 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 10 Jan 2026 17:18:35 +0100 Subject: [PATCH 177/325] Add a default "Subject" for package reviews * lisp/emacs-lisp/package.el (package-review): Set the SUBJECT parameter when calling 'compose-mail'. --- lisp/emacs-lisp/package.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f2389ce8d9a..ee7731b31a1 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -793,7 +793,9 @@ attached." ;; prepare mail buffer (let ((tmp-buf (current-buffer))) (compose-mail (with-demoted-errors "Failed to find maintainers: %S" - (package-maintainers pkg-desc))) + (package-maintainers pkg-desc)) + (concat "Emacs Package Review: " + (package-desc-full-name pkg-desc))) (pcase mail-user-agent ('sendmail-user-agent (mail-text)) (_ (message-goto-body))) From bef813eebfd1f4850e9bd408a9433d9323946834 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Jan 2026 11:08:53 -0800 Subject: [PATCH 178/325] Improve doc re integer overflow * doc/lispref/internals.texi (Module Values, C Integer Types): Mention that the example assumes Emacs was built with the GMP library, not with mini-gmp. Mention stdckdint.h for integer overflow checking, and mention Emacs integers for values outside machine range. --- doc/lispref/internals.texi | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index deaf71077a3..70dca8014d0 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -1660,6 +1660,7 @@ point to an array of at least @var{count} elements specifying the little-endian magnitude of the return value. @end deftypefn +@cindex GMP, the GNU Multiprecision Library The following example uses the GNU Multiprecision Library (GMP) to calculate the next probable prime after a given integer. @xref{Top,,,gmp}, for a general overview of GMP, and @pxref{Integer @@ -1752,7 +1753,11 @@ next_prime (emacs_env *env, ptrdiff_t nargs, emacs_value *args, mpz_t p; mpz_init (p); extract_big_integer (env, args[0], p); + + /* Assume Emacs is linked to the full GMP library, + not to its mini-gmp subset that lacks mpz_nextprime. */ mpz_nextprime (p, p); + emacs_value result = make_big_integer (env, p); mpz_clear (p); return result; @@ -2844,11 +2849,23 @@ Avoid arbitrary limits. For example, avoid @code{int len = strlen fit in @code{int} range. @item +@cindex overflow in integers +@cindex integer overflow Do not assume that signed integer arithmetic wraps around on overflow. This is no longer true of Emacs porting targets: signed integer overflow has undefined behavior in practice, and can dump core or even cause earlier or later code to behave illogically. Unsigned -overflow does wrap around reliably, modulo a power of two. +overflow does wrap around reliably, modulo a power of two, +if all operand types are unsigned and are @code{unsigned int} or wider. + +@item +Use the macros of @code{} to check for integer overflow +or to implement wraparound arithmetic reliably with integer types +that are signed or are narrower than @code{unsigned int}. +Although @code{} was not standardized until C23, +on non-C23 platforms Emacs internally provides a fallback substitute. +Avoid complex arguments to its macros @code{ckd_add}, @code{ckd_sub} and +@code{ckd_mul}, as the fallback macros might evaluate arguments more than once. @item Prefer signed types to unsigned, as code gets confusing when signed @@ -2907,10 +2924,17 @@ although @code{off_t} is always signed, @code{time_t} need not be. @item Prefer @code{intmax_t} for representing values that might be any -signed integer value. +signed integer value in machine range. A @code{printf}-family function can print such a value via a format like @code{"%"PRIdMAX}. +@item +Prefer Emacs integers, which are either fixnums or bignums, +for representing values that might be outside machine range. +Although low level code uses GMP directly for efficiency, +Emacs integers are typically more convenient at higher levels of +abstraction. + @item Prefer @code{bool}, @code{false} and @code{true} for booleans. Using @code{bool} can make programs easier to read and a bit faster than From 58b9ac601e010ecce9232e248b3944ad029c711b Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 17 Jan 2026 11:08:53 -0800 Subject: [PATCH 179/325] Avoid overflows in image size calculations Problem reported by Basil L. Contovounesios (bug#66221#89). * src/image.c (image_size_in_bytes, image_frame_cache_size): Use intptr_t for sizes of collections of objects. (struct anim_cache.byte_size, gif_load, Fimage_cache_size): Use intmax_t for sizes of either files or objects. --- src/image.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/image.c b/src/image.c index 71a091ea498..f55596cd1ba 100644 --- a/src/image.c +++ b/src/image.c @@ -2459,10 +2459,10 @@ evicted. */) return Qnil; } -static size_t +static intptr_t image_size_in_bytes (struct image *img) { - size_t size = 0; + intptr_t size = 0; #if defined USE_CAIRO Emacs_Pixmap pm = img->pixmap; @@ -2507,14 +2507,14 @@ image_size_in_bytes (struct image *img) return size; } -static size_t +static intptr_t image_frame_cache_size (struct frame *f) { struct image_cache *c = FRAME_IMAGE_CACHE (f); if (!c) return 0; - size_t total = 0; + intptr_t total = 0; for (ptrdiff_t i = 0; i < c->used; ++i) { struct image *img = c->images[i]; @@ -3695,7 +3695,7 @@ struct anim_cache We don't actually know how much memory the different libraries actually use here (since these cache structures are opaque), so this is mostly just the size of the original image file. */ - int byte_size; + intmax_t byte_size; struct timespec update_time; struct anim_cache *next; }; @@ -9833,7 +9833,7 @@ gif_load (struct frame *f, struct image *img) struct anim_cache* cache = NULL; /* Which sub-image are we to display? */ Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - int byte_size = 0; + intmax_t byte_size = 0; idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; @@ -12769,7 +12769,7 @@ DEFUN ("image-cache-size", Fimage_cache_size, Simage_cache_size, 0, 0, 0, (void) { Lisp_Object tail, frame; - size_t total = 0; + intmax_t total = 0; FOR_EACH_FRAME (tail, frame) if (FRAME_WINDOW_P (XFRAME (frame))) From 674fbfdd9e36a47757f594560eb37b5230968723 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Jan 2026 20:11:09 +0100 Subject: [PATCH 180/325] Remove rcirc-set-{en,de}code-coding-system aliases These were in the wrong order anyway, so they never had any effect. * lisp/net/rcirc.el (rcirc-set-decode-coding-system) (rcirc-set-encode-coding-system): Remove obsoletion aliases. (Bug#80145) --- lisp/net/rcirc.el | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c669d45a0bd..0ffbc915448 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1338,21 +1338,11 @@ The list is updated automatically by `defun-rcirc-command'.") (interactive "zCoding system for incoming messages: ") (setq-local rcirc-decode-coding-system coding-system)) -(define-obsolete-function-alias - 'rcirc-set-decode-coding-system - 'set-rcirc-decode-coding-system - "28.1") - (defun rcirc-set-encode-coding-system (coding-system) "Set the encode CODING-SYSTEM used in this channel." (interactive "zCoding system for outgoing messages: ") (setq-local rcirc-encode-coding-system coding-system)) -(define-obsolete-function-alias - 'rcirc-set-encode-coding-system - 'set-rcirc-encode-coding-system - "28.1") - (defun rcirc-format (pre &optional replace) "Insert markup formatting PRE. PRE and \"^O\" (ASCII #x0f) will either be inserted around the From cdb2ed9dae55bd4d931661400f0dd6374a53ca05 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Jan 2026 20:12:33 +0100 Subject: [PATCH 181/325] ; * admin/MAINTAINERS: Degrade my interest in Rcirc I am not using it on a daily basis anymore, so I wouldn't mind someone with more personal investment taking over. --- admin/MAINTAINERS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS index ea6622ef86a..dd339f9af80 100644 --- a/admin/MAINTAINERS +++ b/admin/MAINTAINERS @@ -235,7 +235,6 @@ Philip Kaludercic lisp/emacs-lisp/package.el lisp/emacs-lisp/package-vc.el lisp/emacs-lisp/compat.el - lisp/net/rcirc.el Yuan Fu src/treesit.c @@ -390,6 +389,7 @@ Juri Linkov lisp/repeat.el Philip Kaludercic + lisp/net/rcirc.el lisp/epa-ks.el Harald Jörg From f1f1898f0c48246b8820759fb236a78185ad4797 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Jan 2026 23:38:09 +0100 Subject: [PATCH 182/325] Remove some mode restriction in interactive specs of package.el * lisp/emacs-lisp/package.el (package-browse-url) (package-report-bug): Do not restrict these commands to 'package-menu-mode'. (Bug#80178) --- lisp/emacs-lisp/package.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index ee7731b31a1..4dc992a4dea 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4684,8 +4684,7 @@ form (PKG-NAME PKG-DESC). If not specified, it will default to SECONDARY (interactively, the prefix), use the secondary browser. DESC must be a `package-desc' object." (interactive (list (package--query-desc) - current-prefix-arg) - package-menu-mode) + current-prefix-arg)) (unless desc (user-error "No package here")) (let ((url (cdr (assoc :url (package-desc-extras desc))))) @@ -4731,8 +4730,7 @@ will be signaled in that case." (defun package-report-bug (desc) "Prepare a message to send to the maintainers of a package. DESC must be a `package-desc' object." - (interactive (list (package--query-desc package-alist)) - package-menu-mode) + (interactive (list (package--query-desc package-alist))) (let ((maint (package-maintainers desc)) (name (symbol-name (package-desc-name desc))) (pkgdir (package-desc-dir desc)) From ca69411e3d0aafbd24a5a470674269e98b0a13be Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sat, 17 Jan 2026 23:39:48 +0100 Subject: [PATCH 183/325] Autoload 'package-browse-url' * lisp/emacs-lisp/package.el (package-browse-url): Add autoload cookie. (Bug#80178) --- lisp/emacs-lisp/package.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4dc992a4dea..7212ac6a56d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4678,6 +4678,7 @@ form (PKG-NAME PKG-DESC). If not specified, it will default to (cadr (assoc (completing-read "Package: " alist nil t) alist #'string=))))) +;;;###autoload (defun package-browse-url (desc &optional secondary) "Open the website of the package under point in a browser. `browse-url' is used to determine the browser to be used. If From e13046628dc3ae74bd584833eba5ee707099c590 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 01:09:39 +0100 Subject: [PATCH 184/325] Autoload 'package-delete' * lisp/emacs-lisp/package.el (package-delete): Add autoload cookie. (Bug#80178) --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7212ac6a56d..acede5a6109 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2326,7 +2326,7 @@ compiled, and remove the DIR from `load-path'." (delete-file (directory-file-name dir)) (delete-directory dir t))) - +;;;###autoload (defun package-delete (pkg-desc &optional force nosave) "Delete package PKG-DESC. From 6fab8c009e0e6701e26d5077ca27762adfa1a644 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 11:18:37 +0100 Subject: [PATCH 185/325] Extract "news" file extraction logic * lisp/emacs-lisp/package.el (package-review) (describe-package-1): Use new function. (package-find-news-file): Add new function that also checks for the "NEWS-elpa" file name. --- lisp/emacs-lisp/package.el | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index acede5a6109..63b7c208741 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -756,11 +756,7 @@ been downloaded. OLD-DESC is either a `package-desc' object of the previous installation or nil, if there was no prior installation. If the review fails, the function throws a symbol `review-failed' with PKG-DESC attached." - (let ((news (let* ((pkg-dir (package-desc-dir pkg-desc)) - (file (expand-file-name "news" pkg-dir))) - (and (file-regular-p file) - (file-readable-p file) - file))) + (let ((news (package-find-news-file pkg-desc)) (enable-recursive-minibuffers t) (diff-command (car package-review-diff-command))) (while (pcase-exhaustive @@ -2640,6 +2636,15 @@ The description is read from the installed package files." 'help-echo "Read this file's commentary" :type 'package--finder-xref)))) +(defun package-find-news-file (pkg-desc) + "Return the file name of a news file of PKG-DESC. +If no such file exists, the function returns nil." + (let ((default-directory (package-desc-dir pkg-desc))) + (catch 'success + (dolist (file '("NEWS-elpa" "news") nil) ;TODO: add user option? + (when (and (file-readable-p file) (file-regular-p file)) + (throw 'success (expand-file-name file))))))) + (defun describe-package-1 (pkg) "Insert the package description for PKG. Helper function for `describe-package'." @@ -2669,12 +2674,7 @@ Helper function for `describe-package'." (maintainers (or (cdr (assoc :maintainer extras)) (cdr (assoc :maintainers extras)))) (authors (cdr (assoc :authors extras))) - (news (and-let* (pkg-dir - ((not built-in)) - (file (expand-file-name "news" pkg-dir)) - ((file-regular-p file)) - ((file-readable-p file))) - file))) + (news (package-find-news-file pkg))) (when (string= status "avail-obso") (setq status "available obsolete")) (when incompatible-reason From c91c0663e5610624e1928d3df9d6263dcd843dc7 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sun, 18 Jan 2026 12:47:47 +0100 Subject: [PATCH 186/325] Fix `Man-shell-file-name' * lisp/man.el (Man-shell-file-name): Fix for MS Windows. (Bug#80212) --- lisp/man.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/man.el b/lisp/man.el index 549dfd6d955..47301f02a2a 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -559,9 +559,12 @@ Otherwise, the value is whatever the function (defun Man-shell-file-name () "Return a proper shell file name, respecting remote directories." + ;; It must be a Bourne-shell. (Bug#75308, Bug#80212) (if (connection-local-p shell-file-name) (connection-local-value shell-file-name) - "/bin/sh")) + (if (memq system-type '(windows-nt ms-dos)) + shell-file-name + "/bin/sh"))) (defun Man-header-file-path () "Return the C header file search path that Man should use. From 313791e017199387994fa14e7fd0e46a8c85b44f Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Jan 2026 14:36:51 +0200 Subject: [PATCH 187/325] ; Fix messages in "M-x man" * lisp/man.el (Man-getpage-in-background): Fix message in synchronous case. --- lisp/man.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/man.el b/lisp/man.el index 47301f02a2a..3b59efa0a44 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1224,7 +1224,11 @@ Return the buffer in which the manpage will appear." (buffer (get-buffer bufname))) (if buffer (Man-notify-when-ready buffer) - (message "Invoking %s %s in the background" manual-program man-args) + (message "Invoking %s %s %s" + manual-program man-args + (if Man-prefer-synchronous-call + "and formatting..." + "in the background")) (setq buffer (generate-new-buffer bufname)) (Man-notify-when-ready buffer) (with-current-buffer buffer From 72a34eceb9e7e3bfd295f908b8148b2aca41a20e Mon Sep 17 00:00:00 2001 From: Wilson Snyder Date: Sun, 18 Jan 2026 09:59:17 -0500 Subject: [PATCH 188/325] verilog-mode.el: Fix parameter replacements in AUTOINST. * lisp/progmodes/verilog-mode.el (verilog-auto-inst-port): Fix parameter replacements in AUTOINST (#1903). --- lisp/progmodes/verilog-mode.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index a25d3c24553..961d7b57fa4 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -9,7 +9,7 @@ ;; Keywords: languages ;; The "Version" is the date followed by the decimal rendition of the Git ;; commit hex. -;; Version: 2025.11.08.248496848 +;; Version: 2026.01.18.088738971 ;; Yoni Rabkin contacted the maintainer of this ;; file on 19/3/2008, and the maintainer agreed that when a bug is @@ -124,7 +124,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2025-11-08-ecfc2d0-vpo-GNU" +(defconst verilog-mode-version "2026-01-18-54a0c9b-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -12283,9 +12283,10 @@ If PAR-VALUES replace final strings with these parameter values." auto-inst-vector auto-inst-vector-tpl tpl-net dflt-bits) - ;; Replace parameters in bit-width + ;; Replace parameters in vl-bits & vl-widths (when (and check-values - (not (equal vl-bits ""))) + (or (not (equal vl-bits "")) + (not (equal vl-width "")))) (while check-values (setq vl-bits (verilog-string-replace-matches (concat "\\<" (nth 0 (car check-values)) "\\>") From f9e063e922bdf1c38ba7c79ac441b5a50658f151 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Jan 2026 19:03:57 +0200 Subject: [PATCH 189/325] ; * src/dbusbind.c (Fdbus_registered_inhibitor_locks): Fix signature. --- src/dbusbind.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/dbusbind.c b/src/dbusbind.c index a416e6c918a..3cf3ec9897e 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1709,7 +1709,7 @@ An entry in this list is a list (FD WHAT WHY BLOCK). The car of the list is the file descriptor retrieved from a 'dbus-make-inhibitor-lock` call. The cdr of the list represents the three arguments 'dbus-make-inhibitor-lock` was called with. */) - () + (void) { /* We return a copy of xd_registered_inhibitor_locks, in order to protect it against malicious manipulation. */ From 0c31ea113fe2cfdc8bd332929c188b6d4b32f3db Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 19:10:39 +0100 Subject: [PATCH 190/325] Improve type of user option 'package-review-policy' * lisp/emacs-lisp/package.el (package-review-policy): Move tags to the cons-cell level, so that the labels are displayed in the menu when inserting a new item. --- lisp/emacs-lisp/package.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 63b7c208741..758fdf199cf 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -683,8 +683,8 @@ SYMBOL) will review packages whose names match SYMBOL. If you prefix the list with a symbol `not', the rules are inverted." :type (let ((choice '(choice :tag "Review specific packages or archives" - (cons (const archive) (string :tag "Archive name")) - (cons (const package) (symbol :tag "Package name"))))) + (cons :tag "Archive name" (const archive) string) + (cons :tag "Package name" (const package) symbol)))) `(choice (const :tag "Review all packages" t) (repeat :tag "Review these specific packages and archives" ,choice) From 3c125e241422a0eab96d2fbc1e3ff41b65d211cf Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 20:49:29 +0100 Subject: [PATCH 191/325] Portable escape SWITCHES in 'package-review-diff-command' * lisp/emacs-lisp/package.el (package-review-diff-command): Use 'shell-quote-argument' to quote arguments instead of assuming a POSIX shell. --- lisp/emacs-lisp/package.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 758fdf199cf..5e51b5bd647 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -710,13 +710,14 @@ case you are concerned about moving files between file systems." (defcustom package-review-diff-command (cons diff-command - '("-u" ;unified patch formatting - "-N" ;treat absent files as empty - "-x" "'*.elc'" ;ignore byte compiled files - "-x" "'*-autoloads.el'" ;ignore the autoloads file - "-x" "'*-pkg.el'" ;ignore the package description - "-x" "'*.info'" ;ignore compiled Info files - )) + (mapcar #'shell-quote-argument + '("-u" ;unified patch formatting + "-N" ;treat absent files as empty + "-x" "*.elc" ;ignore byte compiled files + "-x" "*-autoloads.el" ;ignore the autoloads file + "-x" "*-pkg.el" ;ignore the package description + "-x" "*.info" ;ignore compiled Info files + ))) "Configuration of how `package-review' should generate a Diff. The structure of the value must be (COMMAND . OPTIONS), where `diff-command' is rebound to be COMMAND and OPTIONS are command-line From e14e9eb70b8d26bf1dcd8472f52cbef12c70331c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sun, 18 Jan 2026 22:15:18 +0200 Subject: [PATCH 192/325] ; Fix one of ispell-tests * test/lisp/textmodes/ispell-tests/ispell-tests.el (ispell/ispell-accept-buffer-local-defs/simple): Don't treat Aspell as Ispell even if it pretends to be. (Bug#80165) --- test/lisp/textmodes/ispell-tests/ispell-tests.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/lisp/textmodes/ispell-tests/ispell-tests.el b/test/lisp/textmodes/ispell-tests/ispell-tests.el index 15687ed6f0f..95f88be3b51 100644 --- a/test/lisp/textmodes/ispell-tests/ispell-tests.el +++ b/test/lisp/textmodes/ispell-tests/ispell-tests.el @@ -779,6 +779,11 @@ hunspell. Hence skipping." (ispell-tests--letopt ((ispell-program-name (ispell-tests--some-backend))) + (ispell-check-version) + (if (and ispell-really-aspell + (equal ispell-program-name "ispell")) + ;; Don't let Aspell hide its true nature. + (setq ispell-program-name "aspell")) (let ((test-dictname (ispell-tests--some-valid-dictionary ispell-program-name)) (test-extcharmode "~latin3") (test-parser "~testparser") From f263d2454fa23769d9d07fd73e216b2b9c32b250 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 21:49:16 +0100 Subject: [PATCH 193/325] ; Fix type error in 'describe-package-1' * lisp/emacs-lisp/package.el (describe-package-1): Pass the package descriptor instead of a symbol to 'package-find-news-file'. (Bug#80220) --- lisp/emacs-lisp/package.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5e51b5bd647..af8a700bd18 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2675,7 +2675,7 @@ Helper function for `describe-package'." (maintainers (or (cdr (assoc :maintainer extras)) (cdr (assoc :maintainers extras)))) (authors (cdr (assoc :authors extras))) - (news (package-find-news-file pkg))) + (news (package-find-news-file desc))) (when (string= status "avail-obso") (setq status "available obsolete")) (when incompatible-reason From 9d3c68ab948d45c19e8603aa0deb9b0186f67646 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 21:59:38 +0100 Subject: [PATCH 194/325] ; * .mailmap: Add email alias --- .mailmap | 1 + 1 file changed, 1 insertion(+) diff --git a/.mailmap b/.mailmap index 5350eadca67..c75dc4ed2f1 100644 --- a/.mailmap +++ b/.mailmap @@ -158,6 +158,7 @@ Philip Kaludercic Philip Kaludercic Philip Kaludercic Philip Kaludercic +Philip Kaludercic Philipp Stephani Philipp Stephani Phillip Lord From aff85304d9d9de1ef7833a4ee35b5c081cc80bc7 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Sun, 18 Jan 2026 22:14:54 +0100 Subject: [PATCH 195/325] Have 'package-find-news-file' handle built-in packages * lisp/emacs-lisp/package.el (package-find-news-file): Abort early if the package is built-in. (describe-package-1): Do not invoke 'package-find-news-file' if missing a package descriptor. --- lisp/emacs-lisp/package.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index af8a700bd18..5c18baa5e47 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2640,7 +2640,9 @@ The description is read from the installed package files." (defun package-find-news-file (pkg-desc) "Return the file name of a news file of PKG-DESC. If no such file exists, the function returns nil." - (let ((default-directory (package-desc-dir pkg-desc))) + (and-let* ((pkg-dir (package-desc-dir pkg-desc)) + (_ (not (eq pkg-dir 'builtin))) + (default-directory pkg-dir)) (catch 'success (dolist (file '("NEWS-elpa" "news") nil) ;TODO: add user option? (when (and (file-readable-p file) (file-regular-p file)) @@ -2675,7 +2677,7 @@ Helper function for `describe-package'." (maintainers (or (cdr (assoc :maintainer extras)) (cdr (assoc :maintainers extras)))) (authors (cdr (assoc :authors extras))) - (news (package-find-news-file desc))) + (news (and desc (package-find-news-file desc)))) (when (string= status "avail-obso") (setq status "available obsolete")) (when incompatible-reason From f33507111d98aee6b303fe6d7aa517a998b81f29 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Jan 2026 09:39:00 +0200 Subject: [PATCH 196/325] ; Fix 'treesit-admin--unversioned-treesit-language-source-alist' * admin/tree-sitter/treesit-admin.el (treesit-admin--unversioned-treesit-language-source-alist): Use the correct return value. --- admin/tree-sitter/treesit-admin.el | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) diff --git a/admin/tree-sitter/treesit-admin.el b/admin/tree-sitter/treesit-admin.el index c15768a9c0d..5e78f930443 100644 --- a/admin/tree-sitter/treesit-admin.el +++ b/admin/tree-sitter/treesit-admin.el @@ -138,14 +138,12 @@ This is done by `require'ing all of the features that extend it." (lambda (source) (cond ((or (memq :revision source) (memq :commit source)) - (when (memq :revision source) - (let ((unversioned-source (copy-sequence source))) - (setcar (cdr (memq :revision unversioned-source)) nil) - unversioned-source)) - (when (memq :commit source) - (let ((unversioned-source (copy-sequence source))) - (setcar (cdr (memq :commit unversioned-source)) nil) - unversioned-source))) + (let ((unversioned-source (copy-sequence source))) + (when (memq :revision source) + (setcar (cdr (memq :revision unversioned-source)) nil)) + (when (memq :commit source) + (setcar (cdr (memq :commit unversioned-source)) nil)) + unversioned-source)) ((nthcdr 2 source) (let ((unversioned-source (copy-sequence source))) (setcar (nthcdr 2 unversioned-source) nil) From caeebd6a6d0a9e11336e07cb38a3d034099ce63b Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 19 Jan 2026 09:34:51 +0100 Subject: [PATCH 197/325] Suppress parallel make for filenotify-tests and tramp-tests * test/Makefile.in (.NOTPARALLEL): Add lisp/filenotify-tests.log and lisp/net/tramp-tests.log. (Bug#80164) --- test/Makefile.in | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/Makefile.in b/test/Makefile.in index 3fbb5f8cbf0..e3a589fe24e 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -217,6 +217,10 @@ LOGFILES := $(patsubst %.el,%.log, \ $(patsubst $(srcdir)/%,%,$(ELFILES))) TESTS := $(LOGFILES:.log=) +## Some tests show problems when run in parallel with other tests. +## Suppress parallelism for them. +.NOTPARALLEL: lisp/filenotify-tests.log lisp/net/tramp-tests.log + ## If we have to interrupt a hanging test, preserve the log so we can ## see what the problem was. .PRECIOUS: %.log From 31c07d873b8055e4749bcc097dfb81dc4c29fd5c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Mon, 19 Jan 2026 12:28:18 +0100 Subject: [PATCH 198/325] ; Minor Tramp cleanup * lisp/net/tramp-adb.el: * lisp/net/tramp-androidsu.el: * lisp/net/tramp-integration.el: * lisp/net/tramp-smb.el: Do not delay `connection-local-set-profiles' until after loading `shell'. * lisp/net/tramp-integration.el: Add the local profile for all hosts listed in `tramp-local-host-names'. * lisp/net/tramp.el (tramp-local-host-names): New defvar. (tramp-local-host-regexp): Use it. * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults): Adapt test. --- lisp/net/tramp-adb.el | 9 ++++----- lisp/net/tramp-androidsu.el | 10 +++------- lisp/net/tramp-integration.el | 22 ++++++++-------------- lisp/net/tramp-smb.el | 24 +++++++++++------------- lisp/net/tramp.el | 24 +++++++++++++----------- test/lisp/net/tramp-tests.el | 5 ++--- 6 files changed, 41 insertions(+), 53 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index a745633c24b..1def3aa3791 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -1227,11 +1227,10 @@ connection if a previous connection has died for some reason." 'tramp-adb-connection-local-default-ps-profile tramp-adb-connection-local-default-ps-variables) -(with-eval-after-load 'shell - (connection-local-set-profiles - `(:application tramp :protocol ,tramp-adb-method) - 'tramp-adb-connection-local-default-shell-profile - 'tramp-adb-connection-local-default-ps-profile)) +(connection-local-set-profiles + `(:application tramp :protocol ,tramp-adb-method) + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile) ;; `shell-mode' tries to open remote files like "/adb::~/.history". ;; This fails, because the tilde cannot be expanded. Tell diff --git a/lisp/net/tramp-androidsu.el b/lisp/net/tramp-androidsu.el index d3e528e8ce7..f15c5587651 100644 --- a/lisp/net/tramp-androidsu.el +++ b/lisp/net/tramp-androidsu.el @@ -529,13 +529,9 @@ arguments to pass to the OPERATION." (connection-local-set-profiles `(:application tramp :protocol ,tramp-androidsu-method) - 'tramp-androidsu-connection-local-default-profile) - -(with-eval-after-load 'shell - (connection-local-set-profiles - `(:application tramp :protocol ,tramp-androidsu-method) - 'tramp-adb-connection-local-default-shell-profile - 'tramp-adb-connection-local-default-ps-profile)) + 'tramp-androidsu-connection-local-default-profile + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile) (add-hook 'tramp-unload-hook (lambda () diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 0183960d7f4..83351952c6c 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -367,10 +367,6 @@ It's value must be a Tramp user option, indexed in the Tramp manual via 'tramp-connection-local-default-system-profile tramp-connection-local-default-system-variables) -(connection-local-set-profiles - '(:application tramp) - 'tramp-connection-local-default-system-profile) - (defconst tramp-connection-local-default-shell-variables '((shell-file-name . "/bin/sh") (shell-command-switch . "-c")) @@ -380,10 +376,10 @@ It's value must be a Tramp user option, indexed in the Tramp manual via 'tramp-connection-local-default-shell-profile tramp-connection-local-default-shell-variables) -(with-eval-after-load 'shell - (connection-local-set-profiles - '(:application tramp) - 'tramp-connection-local-default-shell-profile)) +(connection-local-set-profiles + '(:application tramp) + 'tramp-connection-local-default-system-profile + 'tramp-connection-local-default-shell-profile) ;; Tested with FreeBSD 12.2. (defconst tramp-bsd-process-attributes-ps-args @@ -586,12 +582,10 @@ See `tramp-process-attributes-ps-format'.") 'tramp-connection-local-darwin-ps-profile) ;; ... Add other system types here. ))) - (connection-local-set-profiles - `(:application tramp :machine ,(system-name)) - local-profile) - (connection-local-set-profiles - '(:application tramp :machine "localhost") - local-profile)) + (dolist (local-host tramp-local-host-names) + (connection-local-set-profiles + `(:application tramp :machine ,local-host) + local-profile))) ;; Set connection-local variables for buffers visiting a file. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 10ab64929eb..b87eee0fcce 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -2230,10 +2230,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." 'tramp-smb-connection-local-default-system-profile tramp-smb-connection-local-default-system-variables) -(connection-local-set-profiles - `(:application tramp :protocol ,tramp-smb-method) - 'tramp-smb-connection-local-default-system-profile) - ;; (defconst tramp-smb-connection-local-bash-variables ;; '((explicit-shell-file-name . "bash") ;; (explicit-bash-args . ("--norc" "--noediting" "-i")) @@ -2257,12 +2253,6 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." 'tramp-smb-connection-local-powershell-profile tramp-smb-connection-local-powershell-variables) -(defun tramp-smb-shell-prompt () - "Set `comint-prompt-regexp' to a proper value." - ;; Used for remote `shell-mode' buffers. - (when (tramp-smb-file-name-p default-directory) - (setq-local comint-prompt-regexp tramp-smb-prompt))) - ;; (defconst tramp-smb-connection-local-cmd-variables ;; '((explicit-shell-file-name . "cmd") ;; (explicit-cmd-args . ("/Q")) @@ -2274,10 +2264,18 @@ SHARE will be passed to the call of `tramp-smb-get-localname'." ;; 'tramp-smb-connection-local-cmd-profile ;; tramp-smb-connection-local-cmd-variables) +(connection-local-set-profiles + `(:application tramp :protocol ,tramp-smb-method) + 'tramp-smb-connection-local-default-system-profile + 'tramp-smb-connection-local-powershell-profile) + +(defun tramp-smb-shell-prompt () + "Set `comint-prompt-regexp' to a proper value." + ;; Used for remote `shell-mode' buffers. + (when (tramp-smb-file-name-p default-directory) + (setq-local comint-prompt-regexp tramp-smb-prompt))) + (with-eval-after-load 'shell - (connection-local-set-profiles - `(:application tramp :protocol ,tramp-smb-method) - 'tramp-smb-connection-local-powershell-profile) (add-hook 'shell-mode-hook #'tramp-smb-shell-prompt) (add-hook 'tramp-smb-unload-hook diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1614fe5f7a3..f57b572532a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -583,19 +583,21 @@ host runs a restricted shell, it shall be added to this list, too." :type '(repeat (regexp :tag "Host regexp")) :link '(info-link :tag "Tramp manual" "(tramp) Multi-hops")) +;;;###tramp-autoload +(defvar tramp-local-host-names + (list tramp-system-name "localhost" "127.0.0.1" "::1" + ;; Fedora. + "localhost4" "localhost6" + ;; Ubuntu. + "ip6-localhost" "ip6-loopback" + ;; OpenSUSE. + "ipv6-localhost" "ipv6-loopback") + "List of host names which are regarded as local host.") + ;;;###tramp-autoload (defcustom tramp-local-host-regexp - (rx bos - (| (literal tramp-system-name) - (| "localhost" "127.0.0.1" "::1" - ;; Fedora. - "localhost4" "localhost6" - ;; Ubuntu. - "ip6-localhost" "ip6-loopback" - ;; OpenSUSE. - "ipv6-localhost" "ipv6-loopback")) - eos) - "Host names which are regarded as local host. + (rx-to-string `(: bos (| . ,tramp-local-host-names) eos)) + "Regexp of host names which are regarded as local host. If the local host runs a chrooted environment, set this to nil." :version "30.1" :type '(choice (const :tag "Chrooted environment" nil) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index cb8253e66f6..37923cf2a19 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2158,9 +2158,8 @@ being the result.") (string-equal (file-remote-p (format "/-:%s@:" u) 'method) "ftp")))) ;; Default values in tramp-sh.el and tramp-sudoedit.el. (when (assoc "su" tramp-methods) - (dolist - (h `("127.0.0.1" "[::1]" "localhost" "localhost4" "localhost6" - "ip6-localhost" "ip6-loopback" ,(system-name))) + ;; "::1" is used as "[::1]" in remote file names. + (dolist (h (cons "[::1]" (delete "::1" tramp-local-host-names))) (should (string-equal (file-remote-p (format "/-:root@%s:" h) 'method) "su")))) (dolist (m '("su" "sudo" "ksu" "doas" "sudoedit")) From b44053536db891d328620e103aba5a15687eda42 Mon Sep 17 00:00:00 2001 From: Yavor Doganov Date: Sun, 18 Jan 2026 16:01:55 +0200 Subject: [PATCH 199/325] NS: Fix UI freezes and Lisp threads on GNUstep * src/nsterm.m (ns_select_1): Return thread_select if current thread is not the main thread or timeout is zero; otherwise call 'thread_select' with a minimal timeout to allow other Lisp threads to run. (Bug#80110, Bug#80112) --- src/nsterm.m | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) diff --git a/src/nsterm.m b/src/nsterm.m index 07f397b1c5d..ca06195a798 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5066,18 +5066,14 @@ Function modeled after x_draw_glyph_string_box (). if (writefds && FD_ISSET(k, writefds)) ++nr; } - /* emacs -nw doesn't have an NSApp, so we're done. */ - if (NSApp == nil) - return thread_select (pselect, nfds, readfds, writefds, exceptfds, - timeout, sigmask); - - if (![NSThread isMainThread] + if (NSApp == nil + || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - thread_select (pselect, nfds, readfds, writefds, - exceptfds, timeout, sigmask); + return thread_select (pselect, nfds, readfds, writefds, + exceptfds, timeout, sigmask); else { - struct timespec t = {0, 0}; + struct timespec t = {0, 1}; thread_select (pselect, 0, NULL, NULL, NULL, &t, sigmask); } From 11347939c1d49316a94301e798bc6ee574bb14d7 Mon Sep 17 00:00:00 2001 From: RadioNoiseE Date: Sun, 18 Jan 2026 23:56:29 +0800 Subject: [PATCH 200/325] Fix box cursor width returned for stretch glyph * src/window.c (Fwindow_cursor_info): Return canonical character width when on stretch glyph and `x-stretch-cursor' is nil. (Bug#80211) --- src/window.c | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/window.c b/src/window.c index 434d17994d4..55139b9878d 100644 --- a/src/window.c +++ b/src/window.c @@ -8677,13 +8677,25 @@ Note that any element except the first one in the returned vector may be #ifdef HAVE_WINDOW_SYSTEM struct frame *f = XFRAME (WINDOW_FRAME (w)); + struct glyph *phys_cursor_glyph = get_phys_cursor_glyph (w); + if (FRAME_WINDOW_P (f)) { phys_cursor_width = w->phys_cursor_width; phys_cursor_height = w->phys_cursor_height; phys_cursor_ascent = w->phys_cursor_ascent; } + + /* If on a stretch glyph, and `x-stretch-cursor' is nil, use the + canonical character width instead, except for (H)BAR cursors. */ + if (phys_cursor_glyph + && phys_cursor_glyph->type == STRETCH_GLYPH + && !(w->phys_cursor_type == BAR_CURSOR + || w->phys_cursor_type == HBAR_CURSOR) + && !x_stretch_cursor_p) + phys_cursor_width = min (FRAME_COLUMN_WIDTH (f), phys_cursor_width); #endif + return CALLN (Fvector, w->cursor_type, make_fixnum (w->phys_cursor.x), From e81cee7468b263d27da32b41975cb24571551d90 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Jan 2026 14:25:04 +0200 Subject: [PATCH 201/325] ; * src/window.c (Fwindow_cursor_info): Fix commentary of last change. --- src/window.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/window.c b/src/window.c index 55139b9878d..497c587b167 100644 --- a/src/window.c +++ b/src/window.c @@ -8687,7 +8687,9 @@ Note that any element except the first one in the returned vector may be } /* If on a stretch glyph, and `x-stretch-cursor' is nil, use the - canonical character width instead, except for (H)BAR cursors. */ + canonical character width instead, except for (H)BAR cursors. + This mimics what the various *term.c backends do in their + *_draw_stretch_glyph methods. */ if (phys_cursor_glyph && phys_cursor_glyph->type == STRETCH_GLYPH && !(w->phys_cursor_type == BAR_CURSOR From cb7a3f4e893e03c7f33f21523ce59912691fdb9e Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Jan 2026 16:20:39 +0200 Subject: [PATCH 202/325] Fix vertical cursor motion across overlay strings * src/indent.c (Fvertical_motion): Fix vertical cursor motion when a screen line begins with an overlay string. (Bug#80223) --- src/indent.c | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/indent.c b/src/indent.c index 427350020fd..3443ddb8c73 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2506,7 +2506,10 @@ buffer, whether or not it is currently displayed in some window. */) an addition to the hscroll amount. */ if (!NILP (lcols)) { - if (it.method == GET_FROM_STRING && !NILP (it.from_overlay)) + /* Start at beginning of line if inside an overlay string, to + avoid becoming stuck at the beginning of the overlay string. */ + if (it.continuation_lines_width <= 0 /* not in continuation line */ + && it.method == GET_FROM_STRING && !NILP (it.from_overlay)) reseat_at_previous_visible_line_start(&it); move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X); From 1e080e2eccfc7263c00362fb3359107bb5e861c9 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 19 Jan 2026 20:01:48 +0200 Subject: [PATCH 203/325] ; * src/indent.c (Fvertical_motion): Fix last change. (Bug#80223) --- src/indent.c | 1 + 1 file changed, 1 insertion(+) diff --git a/src/indent.c b/src/indent.c index 3443ddb8c73..9721c95dcf7 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2509,6 +2509,7 @@ buffer, whether or not it is currently displayed in some window. */) /* Start at beginning of line if inside an overlay string, to avoid becoming stuck at the beginning of the overlay string. */ if (it.continuation_lines_width <= 0 /* not in continuation line */ + && it.hpos > 0 /* and not at BOL */ && it.method == GET_FROM_STRING && !NILP (it.from_overlay)) reseat_at_previous_visible_line_start(&it); From 86c40dcc317d444da95712c30a2015e21e83ecd7 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Jan 2026 20:27:50 +0200 Subject: [PATCH 204/325] Don't fail in minibuffer--completions-visible for undefined reference buffer * lisp/minibuffer.el (minibuffer--completions-visible): Return 'window' even when 'completion-reference-buffer' is nil (bug#80064). --- lisp/minibuffer.el | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1742421939e..12827cacfe2 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3473,13 +3473,16 @@ in the minibuffer window." (defun minibuffer--completions-visible () "Return the window where the current *Completions* buffer is visible, if any." (when-let* ((window (get-buffer-window "*Completions*" 0))) - (when (eq (buffer-local-value 'completion-reference-buffer - (window-buffer window)) - ;; If there's no active minibuffer, we call - ;; `window-buffer' on nil, assuming that completion is - ;; happening in the selected window. - (window-buffer (active-minibuffer-window))) - window))) + (let ((reference-buffer + (buffer-local-value 'completion-reference-buffer + (window-buffer window)))) + (when (or (null reference-buffer) + (eq reference-buffer + ;; If there's no active minibuffer, we call + ;; `window-buffer' on nil, assuming that completion is + ;; happening in the selected window. + (window-buffer (active-minibuffer-window)))) + window)))) (defun completion--selected-candidate () "Return the selected completion candidate if any." From 5eb9800c420ca6d889313e462b4a89b45cf97577 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Mon, 19 Jan 2026 20:39:27 +0200 Subject: [PATCH 205/325] Allow non-interactive calls of 'goto-line' (bug#80150) * lisp/simple.el (goto-line, goto-line-relative): Add new arg 'interactive'. Remove 'declare' with 'interactive-only'. Don't push the mark when called non-interactively. --- lisp/simple.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index f06e473d383..774dab254c3 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1638,7 +1638,7 @@ Note that on changing from non-nil to nil, the former contents of 'goto-line-history) buffer)))) -(defun goto-line (line &optional buffer relative) +(defun goto-line (line &optional buffer relative interactive) "Go to LINE, counting from line 1 at beginning of buffer. If called interactively, a numeric prefix argument specifies LINE; without a numeric prefix argument, read LINE from the @@ -1659,21 +1659,23 @@ Prior to moving point, this function sets the mark (without activating it), unless Transient Mark mode is enabled and the mark is already active. +A non-nil INTERACTIVE argument means to push the mark. + This function is usually the wrong thing to use in a Lisp program. What you probably want instead is something like: (goto-char (point-min)) (forward-line (1- N)) If at all possible, an even better solution is to use char counts rather than line counts." - (declare (interactive-only forward-line)) - (interactive (goto-line-read-args)) + (interactive (append (goto-line-read-args) '(nil t))) ;; Switch to the desired buffer, one way or another. (if buffer (let ((window (get-buffer-window buffer))) (if window (select-window window) (switch-to-buffer-other-window buffer)))) ;; Leave mark at previous position - (or (region-active-p) (push-mark)) + (when interactive + (or (region-active-p) (push-mark))) ;; Move to the specified line number in that buffer. (let ((pos (save-restriction (unless relative (widen)) @@ -1690,14 +1692,13 @@ rather than line counts." (widen)) (goto-char pos))) -(defun goto-line-relative (line &optional buffer) +(defun goto-line-relative (line &optional buffer interactive) "Go to LINE, counting from line at (point-min). The line number is relative to the accessible portion of the narrowed -buffer. The argument BUFFER is the same as in the function `goto-line'." - (declare (interactive-only forward-line)) - (interactive (goto-line-read-args t)) - (with-suppressed-warnings ((interactive-only goto-line)) - (goto-line line buffer t))) +buffer. The argument BUFFER is the same as in the function `goto-line'. +A non-nil INTERACTIVE argument means to push the mark." + (interactive (append (goto-line-read-args t) t)) + (goto-line line buffer t interactive)) (defun count-words-region (start end &optional arg) "Count the number of words in the region. From 128bfa6d44277632f6bce98ebbfab4a58f42bda7 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 19 Jan 2026 10:53:33 -0800 Subject: [PATCH 206/325] Merge Gnulib save-cwd.c changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lib/save-cwd.c: Propagate changes from Gnulib sibling. This doesn’t affect behavior. --- lib/save-cwd.c | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/lib/save-cwd.c b/lib/save-cwd.c index b1e55067327..ca52f72a90c 100644 --- a/lib/save-cwd.c +++ b/lib/save-cwd.c @@ -5,7 +5,7 @@ This program 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 + the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, @@ -45,10 +45,10 @@ the getcwd-lgpl module, but to be truly robust, use the getcwd module. Some systems lack fchdir altogether: e.g., OS/2, pre-2001 Cygwin, - SCO Xenix. Also, SunOS 4 and Irix 5.3 provide the function, yet it - doesn't work for partitions on which auditing is enabled. If - you're still using an obsolete system with these problems, please - send email to the maintainer of this code. */ + SCO Xenix. Also, SunOS 4 provides the function, yet it doesn't work + for partitions on which auditing is enabled. If you're still using + an obsolete system with these problems, please send email to the + maintainer of this code. */ #if !defined HAVE_FCHDIR && !defined fchdir # define fchdir(fd) (-1) @@ -57,10 +57,11 @@ int save_cwd (struct saved_cwd *cwd) { - cwd->desc = open (".", O_SEARCH | O_CLOEXEC); /* The 'name' member is present only to minimize differences from - gnulib. Initialize it to zero, if only to simplify debugging. */ - cwd->name = 0; + gnulib. Initialize it to NULL, if only to simplify debugging. */ + cwd->name = NULL; + + cwd->desc = open (".", O_SEARCH | O_CLOEXEC); return 0; } From c0afab671cfba7f9ce5610dbd0b2901506ee0862 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 19 Jan 2026 12:24:14 -0800 Subject: [PATCH 207/325] Omit -Wzero-as-null-pointer-constant MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * configure.ac: If --enable-gcc-warnings, don’t use -Wzero-as-null-pointer-constant, which is enabled by default with bleeding-edge Gnulib (as there seems to be movement in this direction in C2y). Although -Wzero-as-null-pointer-constant is useful, Emacs isn’t clean for it yet. --- configure.ac | 1 + 1 file changed, 1 insertion(+) diff --git a/configure.ac b/configure.ac index 0c1c1e2d789..4615717094b 100644 --- a/configure.ac +++ b/configure.ac @@ -1804,6 +1804,7 @@ AS_IF([test $gl_gcc_warnings = no], nw="$nw -Wsync-nand" # irrelevant here, and provokes ObjC warning nw="$nw -Wunsafe-loop-optimizations" # OK to suppress unsafe optimizations nw="$nw -Wbad-function-cast" # These casts are no worse than others. + nw="$nw -Wzero-as-null-pointer-constant" # Emacs is not yet C2y-safe. # Emacs doesn't care about shadowing; see # . From 4a0919df7f15c4322b983a913a429dc7d52b0bdc Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 19 Jan 2026 10:40:06 -0800 Subject: [PATCH 208/325] Update from Gnulib by running admin/merge-gnulib --- build-aux/config.guess | 4 +- build-aux/config.sub | 4 +- doc/misc/texinfo.tex | 2 +- lib/alloca.in.h | 4 +- lib/binary-io.h | 3 +- lib/c-ctype.h | 3 +- lib/c-strcasecmp.c | 3 +- lib/c-strncasecmp.c | 3 +- lib/careadlinkat.c | 4 +- lib/cloexec.c | 3 +- lib/close-stream.c | 3 +- lib/diffseq.h | 4 +- lib/dup2.c | 3 +- lib/filemode.h | 4 +- lib/fpending.c | 4 +- lib/fpending.h | 4 +- lib/fsusage.c | 4 +- lib/getdelim.c | 94 +++++++++++++++++++++-------------------- lib/getgroups.c | 3 +- lib/getloadavg.c | 4 +- lib/gettime.c | 3 +- lib/gettimeofday.c | 3 +- lib/gnulib.mk.in | 2 + lib/group-member.c | 4 +- lib/malloc.c | 3 +- lib/md5-stream.c | 4 +- lib/md5.c | 4 +- lib/md5.h | 4 +- lib/memmem.c | 4 +- lib/memrchr.c | 4 +- lib/nanosleep.c | 3 +- lib/nproc.c | 2 +- lib/save-cwd.h | 4 +- lib/sha1.c | 3 +- lib/sig2str.c | 3 +- lib/stdckdint.in.h | 2 +- lib/stdlib.in.h | 8 +++- lib/strftime.c | 2 +- lib/strtoimax.c | 4 +- lib/strtol.c | 4 +- lib/strtoll.c | 4 +- lib/time_r.c | 3 +- m4/alloca.m4 | 4 +- m4/codeset.m4 | 4 +- m4/d-type.m4 | 4 +- m4/dup2.m4 | 3 +- m4/filemode.m4 | 3 +- m4/fsusage.m4 | 4 +- m4/getgroups.m4 | 4 +- m4/getline.m4 | 4 +- m4/gettime.m4 | 3 +- m4/gettimeofday.m4 | 4 +- m4/group-member.m4 | 4 +- m4/locale-en.m4 | 2 +- m4/manywarnings.m4 | 24 +++++++---- m4/mempcpy.m4 | 4 +- m4/memrchr.m4 | 4 +- m4/mktime.m4 | 4 +- m4/nstrftime.m4 | 4 +- m4/pathmax.m4 | 4 +- m4/selinux-selinux-h.m4 | 7 ++- m4/sig2str.m4 | 3 +- m4/ssize_t.m4 | 3 +- m4/stat-time.m4 | 4 +- m4/stdlib_h.m4 | 3 +- m4/strnlen.m4 | 4 +- m4/strtoimax.m4 | 3 +- m4/strtoll.m4 | 3 +- m4/time_h.m4 | 4 +- m4/timespec.m4 | 4 +- 70 files changed, 179 insertions(+), 183 deletions(-) diff --git a/build-aux/config.guess b/build-aux/config.guess index f4a333427ca..a9d01fde461 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -1,6 +1,6 @@ #! /bin/sh # Attempt to guess a canonical system name. -# Copyright 1992-2026 Free Software Foundation, Inc. +# Copyright 1992-2025 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268 # see below for rationale @@ -60,7 +60,7 @@ version="\ GNU config.guess ($timestamp) Originally written by Per Bothner. -Copyright 1992-2026 Free Software Foundation, Inc. +Copyright 1992-2025 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." diff --git a/build-aux/config.sub b/build-aux/config.sub index b764eb80841..3d35cde174d 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -1,6 +1,6 @@ #! /bin/sh # Configuration validation subroutine script. -# Copyright 1992-2026 Free Software Foundation, Inc. +# Copyright 1992-2025 Free Software Foundation, Inc. # shellcheck disable=SC2006,SC2268,SC2162 # see below for rationale @@ -76,7 +76,7 @@ Report bugs and patches to ." version="\ GNU config.sub ($timestamp) -Copyright 1992-2026 Free Software Foundation, Inc. +Copyright 1992-2025 Free Software Foundation, Inc. This is free software; see the source for copying conditions. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 1682f6cf5f1..260bf4a9f80 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -5,7 +5,7 @@ % \def\texinfoversion{2025-12-23.13} % -% Copyright 1985--1986, 1988, 1990--2026 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2025 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as diff --git a/lib/alloca.in.h b/lib/alloca.in.h index 06d585d8d9a..bb2cb881619 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -1,7 +1,7 @@ /* Memory allocation on the stack. - Copyright (C) 1995, 1999, 2001-2004, 2006-2026 Free Software - Foundation, Inc. + Copyright (C) 1995, 1999, 2001-2004, 2006-2026 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/binary-io.h b/lib/binary-io.h index 78f38127382..37eb3c4bb18 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -1,6 +1,5 @@ /* Binary mode I/O. - Copyright (C) 2001, 2003, 2005, 2008-2026 Free Software Foundation, - Inc. + Copyright (C) 2001, 2003, 2005, 2008-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-ctype.h b/lib/c-ctype.h index 1d9fba13fc5..e3448a4376b 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -5,8 +5,7 @@ functions' behaviour depends on the current locale set via setlocale. - Copyright (C) 2000-2003, 2006, 2008-2026 Free Software Foundation, - Inc. + Copyright (C) 2000-2003, 2006, 2008-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index e534f8e87a9..2e7f5405252 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -1,6 +1,5 @@ /* c-strcasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index e16d33441fa..0fe570ae476 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -1,6 +1,5 @@ /* c-strncasecmp.c -- case insensitive string comparator in C locale - Copyright (C) 1998-1999, 2005-2006, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2005-2006, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 1e2ee8a52e1..fa19e09986c 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -1,7 +1,7 @@ /* Read symbolic links into a buffer without size limitation, relative to fd. - Copyright (C) 2001, 2003-2004, 2007, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 2001, 2003-2004, 2007, 2009-2026 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/cloexec.c b/lib/cloexec.c index c546da0e715..3d4f916b0f4 100644 --- a/lib/cloexec.c +++ b/lib/cloexec.c @@ -1,7 +1,6 @@ /* cloexec.c - set or clear the close-on-exec descriptor flag - Copyright (C) 1991, 2004-2006, 2009-2026 Free Software Foundation, - Inc. + Copyright (C) 1991, 2004-2006, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/close-stream.c b/lib/close-stream.c index 3c19ba63849..0dc79569029 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -1,7 +1,6 @@ /* Close a stream, with nicer error checking than fclose's. - Copyright (C) 1998-2002, 2004, 2006-2026 Free Software Foundation, - Inc. + Copyright (C) 1998-2002, 2004, 2006-2026 Free Software Foundation, Inc. This program 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/lib/diffseq.h b/lib/diffseq.h index a5ae7a46af0..cf710a316f8 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -1,7 +1,7 @@ /* Analyze differences between two vectors. - Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2026 Free - Software Foundation, Inc. + Copyright (C) 1988-1989, 1992-1995, 2001-2004, 2006-2026 Free Software + Foundation, Inc. This program 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/lib/dup2.c b/lib/dup2.c index 6d46f322b5c..b9a55263be4 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -1,7 +1,6 @@ /* Duplicate an open file descriptor to a specified file descriptor. - Copyright (C) 1999, 2004-2007, 2009-2026 Free Software Foundation, - Inc. + Copyright (C) 1999, 2004-2007, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/filemode.h b/lib/filemode.h index 36111daf6b0..22fe84b92be 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -1,7 +1,7 @@ /* Make a string describing file modes. - Copyright (C) 1998-1999, 2003, 2006, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1998-1999, 2003, 2006, 2009-2026 Free Software Foundation, + Inc. This program 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/lib/fpending.c b/lib/fpending.c index ce16f92841d..58c32d499af 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -1,6 +1,6 @@ /* fpending.c -- return the number of pending output bytes on a stream - Copyright (C) 2000, 2004, 2006-2007, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 2000, 2004, 2006-2007, 2009-2026 Free Software Foundation, + Inc. This program 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/lib/fpending.h b/lib/fpending.h index 4163d34f66c..aeb1d9310d8 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -1,7 +1,7 @@ /* Declare __fpending. - Copyright (C) 2000, 2003, 2005-2006, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 2000, 2003, 2005-2006, 2009-2026 Free Software Foundation, + Inc. This program 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/lib/fsusage.c b/lib/fsusage.c index 73916d7e74c..1700a19c996 100644 --- a/lib/fsusage.c +++ b/lib/fsusage.c @@ -1,7 +1,7 @@ /* fsusage.c -- return space usage of mounted file systems - Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2026 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2026 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getdelim.c b/lib/getdelim.c index e16acf8c64b..21f3abc294c 100644 --- a/lib/getdelim.c +++ b/lib/getdelim.c @@ -92,54 +92,56 @@ getdelim (char **lineptr, size_t *n, int delimiter, FILE *fp) *lineptr = new_lineptr; } - size_t cur_len = 0; - for (;;) - { - int i; + { + size_t cur_len = 0; + for (;;) + { + int i; - i = getc_maybe_unlocked (fp); - if (i == EOF) - { - result = -1; + i = getc_maybe_unlocked (fp); + if (i == EOF) + { + result = -1; + break; + } + + /* Make enough space for len+1 (for final NUL) bytes. */ + if (cur_len + 1 >= *n) + { + size_t needed_max = + SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX; + size_t needed = 2 * *n + 1; /* Be generous. */ + + if (needed_max < needed) + needed = needed_max; + if (cur_len + 1 >= needed) + { + result = -1; + errno = EOVERFLOW; + goto unlock_return; + } + + char *new_lineptr = (char *) realloc (*lineptr, needed); + if (new_lineptr == NULL) + { + alloc_failed (); + result = -1; + goto unlock_return; + } + + *lineptr = new_lineptr; + *n = needed; + } + + (*lineptr)[cur_len] = i; + cur_len++; + + if (i == delimiter) break; - } - - /* Make enough space for len+1 (for final NUL) bytes. */ - if (cur_len + 1 >= *n) - { - size_t needed_max = - SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX; - size_t needed = 2 * *n + 1; /* Be generous. */ - - if (needed_max < needed) - needed = needed_max; - if (cur_len + 1 >= needed) - { - result = -1; - errno = EOVERFLOW; - goto unlock_return; - } - - char *new_lineptr = (char *) realloc (*lineptr, needed); - if (new_lineptr == NULL) - { - alloc_failed (); - result = -1; - goto unlock_return; - } - - *lineptr = new_lineptr; - *n = needed; - } - - (*lineptr)[cur_len] = i; - cur_len++; - - if (i == delimiter) - break; - } - (*lineptr)[cur_len] = '\0'; - result = cur_len ? cur_len : result; + } + (*lineptr)[cur_len] = '\0'; + result = cur_len ? cur_len : result; + } unlock_return: funlockfile (fp); /* doesn't set errno */ diff --git a/lib/getgroups.c b/lib/getgroups.c index 77494be91e2..ec20b1a8456 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -1,7 +1,6 @@ /* provide consistent interface to getgroups for systems that don't allow N==0 - Copyright (C) 1996, 1999, 2003, 2006-2026 Free Software Foundation, - Inc. + Copyright (C) 1996, 1999, 2003, 2006-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 6ec41dd8cb2..73b2ee28f36 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -1,7 +1,7 @@ /* Get the system load averages. - Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2026 Free - Software Foundation, Inc. + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2026 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. diff --git a/lib/gettime.c b/lib/gettime.c index 14049fce8b9..edd1cdb02b5 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -1,7 +1,6 @@ /* gettime -- get the system clock - Copyright (C) 2002, 2004-2007, 2009-2026 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004-2007, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index 43493198df4..f236c427fd1 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -1,7 +1,6 @@ /* Provide gettimeofday for systems that don't have it or for which it's broken. - Copyright (C) 2001-2003, 2005-2007, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 2001-2003, 2005-2007, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 28158e521f4..33d8d5ad367 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -951,6 +951,7 @@ HAVE_SYS_ENDIAN_H = @HAVE_SYS_ENDIAN_H@ HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@ HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@ HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@ +HAVE_SYS_PROCESS_H = @HAVE_SYS_PROCESS_H@ HAVE_SYS_RANDOM_H = @HAVE_SYS_RANDOM_H@ HAVE_SYS_SELECT_H = @HAVE_SYS_SELECT_H@ HAVE_SYS_TIME_H = @HAVE_SYS_TIME_H@ @@ -3644,6 +3645,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \ -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ + -e 's|@''HAVE_SYS_PROCESS_H''@|$(HAVE_SYS_PROCESS_H)|g' \ -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ < $@-t1 > $@-t2 diff --git a/lib/group-member.c b/lib/group-member.c index 67dd420b196..b9942c3882a 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -1,7 +1,7 @@ /* group-member.c -- determine whether group id is in calling user's group list - Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2026 Free - Software Foundation, Inc. + Copyright (C) 1994, 1997-1998, 2003, 2005-2006, 2009-2026 Free Software + Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/malloc.c b/lib/malloc.c index 0948f5a50f5..f7d11921aeb 100644 --- a/lib/malloc.c +++ b/lib/malloc.c @@ -1,7 +1,6 @@ /* malloc() function that is glibc compatible. - Copyright (C) 1997-1998, 2006-2007, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1997-1998, 2006-2007, 2009-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/md5-stream.c b/lib/md5-stream.c index c4c1fc2f53d..96b92374c1d 100644 --- a/lib/md5-stream.c +++ b/lib/md5-stream.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2026 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2026 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.c b/lib/md5.c index 4aa3e756b0c..4b0bc59acf7 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -1,7 +1,7 @@ /* Functions to compute MD5 message digest of files or memory blocks. according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2026 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2026 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/md5.h b/lib/md5.h index 29a4c735d87..16c6684b61b 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -1,7 +1,7 @@ /* Declaration of functions and data types used for MD5 sum computing library functions. - Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2026 Free - Software Foundation, Inc. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2026 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/memmem.c b/lib/memmem.c index 1ae62a666fa..6c57a5450db 100644 --- a/lib/memmem.c +++ b/lib/memmem.c @@ -1,5 +1,5 @@ -/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2026 Free - Software Foundation, Inc. +/* Copyright (C) 1991-1994, 1996-1998, 2000, 2004, 2007-2026 Free Software + Foundation, Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/memrchr.c b/lib/memrchr.c index 4f585b53590..a7683c9aea1 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -1,7 +1,7 @@ /* memrchr -- find the last occurrence of a byte in a memory block - Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2026 Free - Software Foundation, Inc. + Copyright (C) 1991, 1993, 1996-1997, 1999-2000, 2003-2026 Free Software + Foundation, Inc. Based on strlen implementation by Torbjorn Granlund (tege@sics.se), with help from Dan Sahlin (dan@sics.se) and diff --git a/lib/nanosleep.c b/lib/nanosleep.c index dc22e8ecdc6..a7abb530588 100644 --- a/lib/nanosleep.c +++ b/lib/nanosleep.c @@ -1,7 +1,6 @@ /* Provide a replacement for the POSIX nanosleep function. - Copyright (C) 1999-2000, 2002, 2004-2026 Free Software Foundation, - Inc. + Copyright (C) 1999-2000, 2002, 2004-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/nproc.c b/lib/nproc.c index 58e45e4e385..b0c9514115b 100644 --- a/lib/nproc.c +++ b/lib/nproc.c @@ -405,7 +405,7 @@ get_cgroup2_cpu_quota (void) if (! fp) return cpu_quota; - /* Get our cgroupv2 (unififed) hierarchy. */ + /* Get our cgroupv2 (unified) hierarchy. */ char *cgroup = NULL; char *cgroup_str = NULL; size_t cgroup_size = 0; diff --git a/lib/save-cwd.h b/lib/save-cwd.h index 7ad4f9e8b9f..2084c68328a 100644 --- a/lib/save-cwd.h +++ b/lib/save-cwd.h @@ -1,7 +1,7 @@ /* Save and restore current working directory. - Copyright (C) 1995, 1997-1998, 2003, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1995, 1997-1998, 2003, 2009-2026 Free Software Foundation, + Inc. This program 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/lib/sha1.c b/lib/sha1.c index 1057642a178..f41bda875db 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -1,8 +1,7 @@ /* sha1.c - Functions to compute SHA1 message digest of files or memory blocks according to the NIST specification FIPS-180-1. - Copyright (C) 2000-2001, 2003-2006, 2008-2026 Free Software - Foundation, Inc. + Copyright (C) 2000-2001, 2003-2006, 2008-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/sig2str.c b/lib/sig2str.c index 5bc7eae54d2..da54234ac48 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -1,7 +1,6 @@ /* sig2str.c -- convert between signal names and numbers - Copyright (C) 2002, 2004, 2006, 2009-2026 Free Software Foundation, - Inc. + Copyright (C) 2002, 2004, 2006, 2009-2026 Free Software Foundation, Inc. This program 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/lib/stdckdint.in.h b/lib/stdckdint.in.h index ac12fd6c7ff..1989f7b8319 100644 --- a/lib/stdckdint.in.h +++ b/lib/stdckdint.in.h @@ -47,7 +47,7 @@ These are like the standard macros introduced in C23, except that arguments should not have side effects. The C++26 standard is - expected to add this header and it's macros. */ + expected to add this header and its macros. */ # define ckd_add(r, a, b) ((bool) _GL_INT_ADD_WRAPV (a, b, r)) # define ckd_sub(r, a, b) ((bool) _GL_INT_SUBTRACT_WRAPV (a, b, r)) diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index 4f4de503bec..95237f2a5cb 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -1,7 +1,6 @@ /* A GNU-like . - Copyright (C) 1995, 2001-2004, 2006-2026 Free Software Foundation, - Inc. + Copyright (C) 1995, 2001-2004, 2006-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as @@ -71,6 +70,11 @@ # include #endif +/* QNX declares getprogname() in . */ +#if (@GNULIB_GETPROGNAME@ || defined GNULIB_POSIXCHECK) && @HAVE_SYS_PROCESS_H@ +# include +#endif + /* Native Windows platforms declare _mktemp() in . */ #if defined _WIN32 && !defined __CYGWIN__ # include diff --git a/lib/strftime.c b/lib/strftime.c index a3909a36c89..8d32023729c 100644 --- a/lib/strftime.c +++ b/lib/strftime.c @@ -316,7 +316,7 @@ typedef sbyte_count_t retval_t; else if (to_uppcase) \ for (byte_count_t _i = 0; _i < _n; _i++) \ FPUTC (TOUPPER ((UCHAR_T) _s[_i], loc), p); \ - else if (fwrite (_s, _n, 1, p) == 0) \ + else if (_n && fwrite (_s, _n, 1, p) == 0) \ return FAILURE; \ } \ while (0) \ diff --git a/lib/strtoimax.c b/lib/strtoimax.c index b651d72dfa9..d130e4afa9f 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an intmax_t value. - Copyright (C) 1999, 2001-2004, 2006, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1999, 2001-2004, 2006, 2009-2026 Free Software Foundation, + Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/lib/strtol.c b/lib/strtol.c index 244fe9b5e3c..12a64b1c5a7 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -1,7 +1,7 @@ /* Convert string representation of a number into an integer value. - Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2026 Free - Software Foundation, Inc. + Copyright (C) 1991-1992, 1994-1999, 2003, 2005-2007, 2009-2026 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with the GNU C Library. Bugs can be reported to bug-glibc@gnu.org. diff --git a/lib/strtoll.c b/lib/strtoll.c index 2b030c9bf66..e8876f98152 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -1,6 +1,6 @@ /* Function to parse a 'long long int' from text. - Copyright (C) 1995-1997, 1999, 2001, 2009-2026 Free Software - Foundation, Inc. + Copyright (C) 1995-1997, 1999, 2001, 2009-2026 Free Software Foundation, + Inc. This file is part of the GNU C Library. This file is free software: you can redistribute it and/or modify diff --git a/lib/time_r.c b/lib/time_r.c index b350d70a3cf..dfc427f6679 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -1,7 +1,6 @@ /* Reentrant time functions like localtime_r. - Copyright (C) 2003, 2006-2007, 2010-2026 Free Software Foundation, - Inc. + Copyright (C) 2003, 2006-2007, 2010-2026 Free Software Foundation, Inc. This file is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 7e29940e713..ff0c59dd415 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -1,7 +1,7 @@ # alloca.m4 # serial 21 -dnl Copyright (C) 2002-2004, 2006-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2004, 2006-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/codeset.m4 b/m4/codeset.m4 index 301e8524870..4ab542f4291 100644 --- a/m4/codeset.m4 +++ b/m4/codeset.m4 @@ -1,7 +1,7 @@ # codeset.m4 # serial 5 (gettext-0.18.2) -dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2026 Free -dnl Software Foundation, Inc. +dnl Copyright (C) 2000-2002, 2006, 2008-2014, 2016, 2019-2026 Free Software +dnl Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/d-type.m4 b/m4/d-type.m4 index 3888f5c2904..0c335f8b1df 100644 --- a/m4/d-type.m4 +++ b/m4/d-type.m4 @@ -1,7 +1,7 @@ # d-type.m4 # serial 12 -dnl Copyright (C) 1997, 1999-2004, 2006, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1997, 1999-2004, 2006, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/dup2.m4 b/m4/dup2.m4 index a94fef03f9f..e1d518983b5 100644 --- a/m4/dup2.m4 +++ b/m4/dup2.m4 @@ -1,7 +1,6 @@ # dup2.m4 # serial 28 -dnl Copyright (C) 2002, 2005, 2007, 2009-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005, 2007, 2009-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/filemode.m4 b/m4/filemode.m4 index c434d8e35d5..9bf319abf54 100644 --- a/m4/filemode.m4 +++ b/m4/filemode.m4 @@ -1,7 +1,6 @@ # filemode.m4 # serial 9 -dnl Copyright (C) 2002, 2005-2006, 2009-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/fsusage.m4 b/m4/fsusage.m4 index 2806e1a702c..db6e0e3b636 100644 --- a/m4/fsusage.m4 +++ b/m4/fsusage.m4 @@ -1,7 +1,7 @@ # fsusage.m4 # serial 37 -dnl Copyright (C) 1997-1998, 2000-2001, 2003-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1997-1998, 2000-2001, 2003-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index e9e067df688..34ac3a6300e 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -1,7 +1,7 @@ # getgroups.m4 # serial 25 -dnl Copyright (C) 1996-1997, 1999-2004, 2008-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1996-1997, 1999-2004, 2008-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/getline.m4 b/m4/getline.m4 index cb9e839fdd9..ed32fa10bfb 100644 --- a/m4/getline.m4 +++ b/m4/getline.m4 @@ -1,8 +1,8 @@ # getline.m4 # serial 35 -dnl Copyright (C) 1998-2003, 2005-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1998-2003, 2005-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, diff --git a/m4/gettime.m4 b/m4/gettime.m4 index 66d2d6c939f..0afe2aab169 100644 --- a/m4/gettime.m4 +++ b/m4/gettime.m4 @@ -1,7 +1,6 @@ # gettime.m4 # serial 15 -dnl Copyright (C) 2002, 2004-2006, 2009-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004-2006, 2009-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index b72864271ff..3728c13e999 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,7 +1,7 @@ # gettimeofday.m4 # serial 30 -dnl Copyright (C) 2001-2003, 2005, 2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2001-2003, 2005, 2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/group-member.m4 b/m4/group-member.m4 index bb185977b13..5e5c3709c39 100644 --- a/m4/group-member.m4 +++ b/m4/group-member.m4 @@ -1,7 +1,7 @@ # group-member.m4 # serial 14 -dnl Copyright (C) 1999-2001, 2003-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1999-2001, 2003-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/locale-en.m4 b/m4/locale-en.m4 index cc54a15fac4..f5e035f3675 100644 --- a/m4/locale-en.m4 +++ b/m4/locale-en.m4 @@ -19,7 +19,7 @@ AC_DEFUN_ONCE([gt_LOCALE_EN_UTF8], *-musl* | midipix*) dnl On musl libc, all kinds of ll_CC.UTF-8 locales exist, even without dnl any locale file on disk. But they are effectively equivalent to the - dnl C.UTF-8 locale, except for locale categories (such as LC_MESSSAGES) + dnl C.UTF-8 locale, except for locale categories (such as LC_MESSAGES) dnl for which localizations (.mo files) have been installed. gt_cv_locale_en_utf8=en_US.UTF-8 ;; diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index ca35e69eecc..0824226fa71 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,5 +1,5 @@ # manywarnings.m4 -# serial 29 +# serial 32 dnl Copyright (C) 2008-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -110,8 +110,8 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], -Wduplicated-branches \ -Wduplicated-cond \ -Wextra \ - -Wformat-signedness \ -Wflex-array-member-not-at-end \ + -Wformat-signedness \ -Winit-self \ -Winline \ -Winvalid-pch \ @@ -138,8 +138,6 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], -Wsuggest-attribute=malloc \ -Wsuggest-attribute=noreturn \ -Wsuggest-attribute=pure \ - -Wsuggest-final-methods \ - -Wsuggest-final-types \ -Wsync-nand \ -Wtrampolines \ -Wuninitialized \ @@ -150,7 +148,6 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], -Wvector-operation-performance \ -Wvla \ -Wwrite-strings \ - \ ; do AS_VAR_APPEND([$1], [" $gl_manywarn_item"]) done @@ -169,20 +166,29 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], AS_VAR_APPEND([$1], [' -Wunused-const-variable=2']) AS_VAR_APPEND([$1], [' -Wvla-larger-than=4031']) - # These are needed for older GCC versions. + # These depend on the GCC version. if test -n "$GCC" && gl_gcc_version=`($CC --version) 2>/dev/null`; then case $gl_gcc_version in - 'gcc (GCC) '[[0-3]].* | \ - 'gcc (GCC) '4.[[0-7]].*) + gcc*' ('*') '[[0-3]].* | \ + gcc*' ('*') '4.[[0-7]].*) AS_VAR_APPEND([$1], [' -fdiagnostics-show-option']) AS_VAR_APPEND([$1], [' -funit-at-a-time']) ;; esac case $gl_gcc_version in - 'gcc (GCC) '[[0-9]].*) + gcc*' ('*') '[[0-9]].*) AS_VAR_APPEND([$1], [' -fno-common']) ;; esac + case $gl_gcc_version in + gcc*' ('*') '?.* | gcc*' ('*') '1[[0-4]].*) + # In GCC < 15 the option either does not exist, + # or is accepted but always warns. + ;; + *) + AS_VAR_APPEND([$1], [' -Wzero-as-null-pointer-constant']) + ;; + esac fi # These options are not supported by gcc, but are useful with clang. diff --git a/m4/mempcpy.m4 b/m4/mempcpy.m4 index d6b5b8f0b4a..eda1b31c44d 100644 --- a/m4/mempcpy.m4 +++ b/m4/mempcpy.m4 @@ -1,7 +1,7 @@ # mempcpy.m4 # serial 14 -dnl Copyright (C) 2003-2004, 2006-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2003-2004, 2006-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/memrchr.m4 b/m4/memrchr.m4 index 59fda84cf61..7e4e39f2ec1 100644 --- a/m4/memrchr.m4 +++ b/m4/memrchr.m4 @@ -1,7 +1,7 @@ # memrchr.m4 # serial 11 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/mktime.m4 b/m4/mktime.m4 index a186def45d5..fa32d138402 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,7 +1,7 @@ # mktime.m4 # serial 43 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/nstrftime.m4 b/m4/nstrftime.m4 index 5c5cc1289d5..f9d699174e4 100644 --- a/m4/nstrftime.m4 +++ b/m4/nstrftime.m4 @@ -1,7 +1,7 @@ # nstrftime.m4 # serial 40 -dnl Copyright (C) 1996-1997, 1999-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 1996-1997, 1999-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/pathmax.m4 b/m4/pathmax.m4 index 4d45922846e..d6bdf43e9ef 100644 --- a/m4/pathmax.m4 +++ b/m4/pathmax.m4 @@ -1,7 +1,7 @@ # pathmax.m4 # serial 11 -dnl Copyright (C) 2002-2003, 2005-2006, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2006, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/selinux-selinux-h.m4 b/m4/selinux-selinux-h.m4 index 5b934461623..b3fcd2102e2 100644 --- a/m4/selinux-selinux-h.m4 +++ b/m4/selinux-selinux-h.m4 @@ -88,10 +88,13 @@ AC_DEFUN([gl_LIBSELINUX], # Warn if SELinux is found but libselinux is absent; if test "$ac_cv_search_setfilecon" = no; then - if test "$host" = "$build" && test -d /selinux; then + if test "$host" = "$build" \ + && { test -d /sys/fs/selinux || test -d /selinux; }; then AC_MSG_WARN([This system supports SELinux but libselinux is missing.]) AC_MSG_WARN([AC_PACKAGE_NAME will be compiled without SELinux support.]) fi - with_selinux=no + if test "$with_selinux" = maybe; then + with_selinux=no + fi fi ]) diff --git a/m4/sig2str.m4 b/m4/sig2str.m4 index 709dd958f97..d2e37ad9e6c 100644 --- a/m4/sig2str.m4 +++ b/m4/sig2str.m4 @@ -1,7 +1,6 @@ # sig2str.m4 # serial 9 -dnl Copyright (C) 2002, 2005-2006, 2009-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2005-2006, 2009-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/ssize_t.m4 b/m4/ssize_t.m4 index 5ff06768677..8710cb7233e 100644 --- a/m4/ssize_t.m4 +++ b/m4/ssize_t.m4 @@ -1,7 +1,6 @@ # ssize_t.m4 # serial 6 -dnl Copyright (C) 2001-2003, 2006, 2010-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2001-2003, 2006, 2010-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/stat-time.m4 b/m4/stat-time.m4 index d3bc20b6a4e..10eb1dfa2d4 100644 --- a/m4/stat-time.m4 +++ b/m4/stat-time.m4 @@ -1,7 +1,7 @@ # stat-time.m4 # serial 1 -dnl Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2026 Free -dnl Software Foundation, Inc. +dnl Copyright (C) 1998-1999, 2001, 2003, 2005-2007, 2009-2026 Free Software +dnl Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index bef82c9688b..f35d661125d 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,5 +1,5 @@ # stdlib_h.m4 -# serial 85 +# serial 86 dnl Copyright (C) 2007-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -223,6 +223,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_STRTOULL=1; AC_SUBST([HAVE_STRTOULL]) HAVE_STRUCT_RANDOM_DATA=1; AC_SUBST([HAVE_STRUCT_RANDOM_DATA]) HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H]) + HAVE_SYS_PROCESS_H=0; AC_SUBST([HAVE_SYS_PROCESS_H]) HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT]) HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV]) REPLACE__EXIT=0; AC_SUBST([REPLACE__EXIT]) diff --git a/m4/strnlen.m4 b/m4/strnlen.m4 index 764a84dc497..a712df9deaa 100644 --- a/m4/strnlen.m4 +++ b/m4/strnlen.m4 @@ -1,7 +1,7 @@ # strnlen.m4 # serial 15 -dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2002-2003, 2005-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index cf628673bad..c6280d02ff8 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,7 +1,6 @@ # strtoimax.m4 # serial 17 -dnl Copyright (C) 2002-2004, 2006, 2009-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002-2004, 2006, 2009-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/strtoll.m4 b/m4/strtoll.m4 index fa5adc54cb5..4ee81fbcc4a 100644 --- a/m4/strtoll.m4 +++ b/m4/strtoll.m4 @@ -1,7 +1,6 @@ # strtoll.m4 # serial 12 -dnl Copyright (C) 2002, 2004, 2006, 2008-2026 Free Software Foundation, -dnl Inc. +dnl Copyright (C) 2002, 2004, 2006, 2008-2026 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/time_h.m4 b/m4/time_h.m4 index 1cfc168b912..8d896ea526d 100644 --- a/m4/time_h.m4 +++ b/m4/time_h.m4 @@ -1,7 +1,7 @@ # time_h.m4 # serial 27 -dnl Copyright (C) 2000-2001, 2003-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2000-2001, 2003-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. diff --git a/m4/timespec.m4 b/m4/timespec.m4 index 8317cb29868..101f94a371d 100644 --- a/m4/timespec.m4 +++ b/m4/timespec.m4 @@ -1,7 +1,7 @@ # timespec.m4 # serial 15 -dnl Copyright (C) 2000-2001, 2003-2007, 2009-2026 Free Software -dnl Foundation, Inc. +dnl Copyright (C) 2000-2001, 2003-2007, 2009-2026 Free Software Foundation, +dnl Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. From 1ca5eda85e0214bf3a8b8fa0b5da56aa5e9297c5 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 19 Jan 2026 12:39:46 -0800 Subject: [PATCH 209/325] =?UTF-8?q?Don=E2=80=99t=20use=20C=20basename=20fu?= =?UTF-8?q?nction?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/pdumper.c (pdumper_set_emacs_execdir): Don’t use basename; simply use the pointer we already have. If we ever need a basename-like function in the future, we should use Gnulib’s basename-lgpl module, as POSIX basename modifies its argument string and is incompatible with glibc/Android basename; see . --- src/pdumper.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index 615c0cf28c9..9b26c80a479 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5650,7 +5650,7 @@ pdumper_set_emacs_execdir (char *emacs_executable) eassert (p > emacs_executable); #if HAVE_NS && !NS_SELF_CONTAINED - if (strcmp (basename (emacs_executable), "Emacs") == 0) + if (strcmp (p, "Emacs") == 0) { /* This is the Emacs executable from the non-self-contained app bundle which can be anywhere on the system. Fortunately, the From 95775d933894ed8b6b173e9cac663abca12a976e Mon Sep 17 00:00:00 2001 From: Pranshu Sharma Date: Tue, 20 Jan 2026 09:26:55 +0100 Subject: [PATCH 210/325] Factor out calculation of window combination for 'split-frame' * lisp/window-x.el (window--get-split-combination): New function. (split-frame): Call it. --- lisp/window-x.el | 92 +++++++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 41 deletions(-) diff --git a/lisp/window-x.el b/lisp/window-x.el index e8ee58dcdc2..a5740fc5d25 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -340,6 +340,51 @@ FRAME1." (delete-frame frame2) frame1)) +;;;###autoload +(defun window--get-split-combination (window arg) + "Return window combination suitable for `split-frame'. + +WINDOW is the main window in which the combination should be derived. +ARG is the argument passed to `split-frame'. Return a +combination of windows `split-frame' is considered to split off." + (let* ((reverse (< arg 0)) + ;; This is where the pivot window is. + (total-window-count (window-child-count window)) + (pivot-window-pos (- (if reverse + (+ total-window-count arg) + arg) + 1)) + (pivot-window (window-child window)) + (active-window (frame-selected-window window)) + ;; If FRAME's selected window is on the left side of the + ;; pivot window. + (active-window-on-left (eq pivot-window active-window))) + ;; We want the 2nd level window that the active window is a + ;; part of. + (while (not (eq (window-parent active-window) window)) + (setq active-window (window-parent active-window))) + + ;; Now we need to find the pivot window + (dotimes (_ pivot-window-pos) + (setq pivot-window (window-next-sibling pivot-window)) + (when (eq active-window pivot-window) + (setq active-window-on-left t))) + + ;; Now we have pivot-window set, and we just need to + ;; combine. We want to split away all windows from the + ;; side of the pivot that doesn't contain the active + ;; window. + (let* ((first (window-child window)) + (last (window-last-child window)) + (next-pivot-sib (window-next-sibling pivot-window)) + (right-comb (if (eq next-pivot-sib last) + last + (combine-windows next-pivot-sib last))) + (left-comb (if (eq first pivot-window) + first + (combine-windows first pivot-window)))) + (if active-window-on-left right-comb left-comb)))) + ;;;###autoload (defun split-frame (&optional frame arg) "Split windows of specified FRAME into two separate frames. @@ -371,47 +416,12 @@ absolute value of ARG. Return the new frame." ((>= (abs arg) total-window-count) (user-error "ARG %s exceeds number of windows %s that can be split off" (abs arg) (1- total-window-count))) - (t (let* ((reverse (< arg 0)) - ;; This is where the pivot window is. - (pivot-window-pos (- (if reverse - (+ total-window-count arg) - arg) - 1)) - (pivot-window (window-child main)) - (active-window (frame-selected-window frame)) - ;; If FRAME's selected window is on the left side of the - ;; pivot window. - (active-window-on-left (eq pivot-window active-window))) - ;; We want the 2nd level window that the active window is a - ;; part of. - (while (not (eq (window-parent active-window) main)) - (setq active-window (window-parent active-window))) - - ;; Now we need to find the pivot window - (dotimes (_ pivot-window-pos) - (setq pivot-window (window-next-sibling pivot-window)) - (when (eq active-window pivot-window) - (setq active-window-on-left t))) - - ;; Now we have pivot-window set, and we just need to - ;; combine. We want to split away all windows from the - ;; side of the pivot that doesn't contain the active - ;; window. - (let* ((first (window-child main)) - (last (window-last-child main)) - (next-pivot-sib (window-next-sibling pivot-window)) - (right-comb (if (eq next-pivot-sib last) - last - (combine-windows next-pivot-sib last))) - (left-comb (if (eq first pivot-window) - first - (combine-windows first pivot-window))) - ;; comb-win is the combination that will be - ;; split off. - (comb-win (if active-window-on-left right-comb left-comb))) - (window-state-put (window-state-get comb-win) - (window-main-window (make-frame))) - (delete-window comb-win))))))) + (t + (let ((comb (window--get-split-combination main arg))) + (window-state-put (window-state-get comb) + (window-main-window (make-frame))) + (delete-window comb)) + )))) (provide 'window-x) ;;; window-x.el ends here From 94051b2c9a7d8f7a945f067b2df0391fce0f172e Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 24 Dec 2024 01:31:35 +0100 Subject: [PATCH 211/325] Call browser functions via `browse-url' This is in order to apply `browse-url-transform-alist'. * lisp/net/browse-url.el (browse-url-with-browser-kind) (browse-url-button-open, browse-url-button-open-url): * lisp/net/shr.el (shr-browse-url): * lisp/net/eww.el (eww-browse-with-external-browser): * lisp/gnus/gnus-sum.el (gnus-summary-browse-url): * lisp/emacs-lisp/package.el (package-browse-url): Let-bind `browse-url-browser-function' and call `browse-url'. --- lisp/emacs-lisp/package.el | 6 ++++-- lisp/gnus/gnus-sum.el | 10 ++++++---- lisp/net/browse-url.el | 23 +++++++++++++++-------- lisp/net/eww.el | 3 ++- lisp/net/shr.el | 9 +++++---- 5 files changed, 32 insertions(+), 19 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 5c18baa5e47..48252c2d5b8 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -4694,8 +4694,10 @@ DESC must be a `package-desc' object." (let ((url (cdr (assoc :url (package-desc-extras desc))))) (unless url (user-error "No website for %s" (package-desc-name desc))) - (if secondary - (funcall browse-url-secondary-browser-function url) + (let ((browse-url-browser-function + (if secondary + browse-url-secondary-browser-function + browse-url-browser-function))) (browse-url url)))) (declare-function ietf-drums-parse-address "ietf-drums" diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 677b028bcaf..e09bb3a4b39 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9410,7 +9410,7 @@ See `gnus-collect-urls'." (concat "#" target))))) (concat host (string-truncate-left rest (- max (length host))))))) -(defun gnus-summary-browse-url (&optional external) +(defun gnus-summary-browse-url (&optional secondary) "Scan the current article body for links, and offer to browse them. Links are opened using `browse-url' unless a prefix argument is @@ -9431,9 +9431,11 @@ default." (gnus-shorten-url (car urls) 40)) urls nil t nil nil (car urls)))))) (if target - (if external - (funcall browse-url-secondary-browser-function target) - (browse-url target)) + (let ((browse-url-browser-function + (if secondary + browse-url-secondary-browser-function + browse-url-browser-function))) + (browse-url target)) (message "No URLs found.")))) (defun gnus-summary-isearch-article (&optional regexp-p) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8806e6ab369..000102f7463 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1000,7 +1000,10 @@ opposite of the browser kind of `browse-url-browser-function'." browse-url-secondary-browser-function #'browse-url-default-browser #'eww)))) - (funcall function url arg))) + (let ((browse-url-browser-function function) + (browse-url-handlers nil) + (browse-url-default-handlers nil)) + (browse-url url)))) ;;;###autoload (defun browse-url-at-mouse (event) @@ -1788,17 +1791,19 @@ clickable and will use `browse-url' to open the URLs in question." browse-url-data ,(match-string 0))))))) ;;;###autoload -(defun browse-url-button-open (&optional external mouse-event) +(defun browse-url-button-open (&optional secondary mouse-event) "Follow the link under point using `browse-url'. -If EXTERNAL (the prefix if used interactively), open with the -external browser instead of the default one." +If SECONDARY (the prefix if used interactively), open with the +secondary browser instead of the default one." (interactive (list current-prefix-arg last-nonmenu-event)) (mouse-set-point mouse-event) (let ((url (get-text-property (point) 'browse-url-data))) (unless url (error "No URL under point")) - (if external - (funcall browse-url-secondary-browser-function url) + (let ((browse-url-browser-function + (if secondary + browse-url-secondary-browser-function + browse-url-browser-function))) (browse-url url)))) ;;;###autoload @@ -1806,8 +1811,10 @@ external browser instead of the default one." "Open URL using `browse-url'. If `current-prefix-arg' is non-nil, use `browse-url-secondary-browser-function' instead." - (if current-prefix-arg - (funcall browse-url-secondary-browser-function url) + (let ((browse-url-browser-function + (if current-prefix-arg + browse-url-secondary-browser-function + browse-url-browser-function))) (browse-url url))) (defun browse-url-button-copy () diff --git a/lisp/net/eww.el b/lisp/net/eww.el index fc7cf2a1710..fb53d067e4f 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -2257,7 +2257,8 @@ external browser." (setq url (or url (plist-get eww-data :url))) (if (eq 'external (browse-url--browser-kind browse-url-secondary-browser-function url)) - (funcall browse-url-secondary-browser-function url) + (let ((browse-url-browser-function browse-url-secondary-browser-function)) + (browse-url url)) (browse-url-with-browser-kind 'external url))) (defun eww-remove-tracking (url) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 9a620af4515..bf78cce13bf 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1097,9 +1097,9 @@ When `shr-fill-text' is nil, only indent." (mouse-set-point ev) (shr-browse-url nil nil t)) -(defun shr-browse-url (&optional external mouse-event new-window) +(defun shr-browse-url (&optional secondary mouse-event new-window) "Browse the URL at point using `browse-url'. -If EXTERNAL is non-nil (interactively, the prefix argument), browse +If SECONDARY is non-nil (interactively, the prefix argument), browse the URL using `browse-url-secondary-browser-function'. If this function is invoked by a mouse click, it will browse the URL at the position of the click. Optional argument MOUSE-EVENT describes @@ -1110,8 +1110,9 @@ the mouse click event." (cond ((not url) (message "No link under point")) - (external - (funcall browse-url-secondary-browser-function url) + (secondary + (let ((browse-url-browser-function browse-url-secondary-browser-function)) + (browse-url url)) (shr--blink-link)) (t (browse-url url (xor new-window browse-url-new-window-flag)))))) From 8f96f5ffb5df8537eeab51959701f2745a8f480e Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Jan 2026 12:30:48 +0100 Subject: [PATCH 212/325] Tag Tramp tests as :expensive-test * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults) (tramp-test10-write-region-file-precious-flag) (tramp-test10-write-region-other-file-name-handler) (tramp-test16-file-expand-wildcards) (tramp-test17-dired-with-wildcards) (tramp-test17-insert-directory-one-file) (tramp-test33-environment-variables-and-port-numbers) (tramp-test35-remote-path, tramp-test39-make-lock-file-name) (tramp-test39-detect-external-change, tramp-test42-utf8) (tramp-test43-file-system-info) (tramp-test44-file-user-group-ids, tramp-test48-session-timeout) (tramp-test49-external-backend-function) (tramp-test50-recursive-load): Tag them as :expensive-test. (Bug#80164) --- test/lisp/net/tramp-tests.el | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 37923cf2a19..7391eb56058 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2145,6 +2145,7 @@ being the result.") (ert-deftest tramp-test03-file-name-defaults () "Check default values for some methods." + :tags '(:expensive-test) (skip-unless (eq tramp-syntax 'default)) ;; Default values in tramp-adb.el. @@ -2801,6 +2802,7 @@ This checks also `file-name-as-directory', `file-name-directory', ;; The following test is inspired by Bug#35497. (ert-deftest tramp-test10-write-region-file-precious-flag () "Check that `file-precious-flag' is respected with Tramp in use." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -2834,6 +2836,7 @@ This checks also `file-name-as-directory', `file-name-directory', ;; The following test is inspired by Bug#55166. (ert-deftest tramp-test10-write-region-other-file-name-handler () "Check that another file name handler in VISIT is acknowledged." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) (skip-unless (executable-find "gzip")) @@ -3444,6 +3447,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; advice for older Emacs versions, so we check that this has been fixed. (ert-deftest tramp-test16-file-expand-wildcards () "Check `file-expand-wildcards'." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil))) @@ -3591,6 +3595,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ert-deftest tramp-test17-dired-with-wildcards () "Check `dired' with wildcards." + :tags '(:expensive-test) ;; `separate' syntax and IPv6 host name syntax do not work. (skip-unless (not (string-match-p (rx "[") ert-remote-temporary-file-directory))) @@ -3708,6 +3713,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; The following test is inspired by Bug#45691. (ert-deftest tramp-test17-insert-directory-one-file () "Check `insert-directory' inside directory listing." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) ;; Relative file names in dired are not supported in tramp-crypt.el. (skip-unless (not (tramp--test-crypt-p))) @@ -6498,6 +6504,7 @@ INPUT, if non-nil, is a string sent to the process." ;; This test is inspired by Bug#27009. (ert-deftest tramp-test33-environment-variables-and-port-numbers () "Check that two connections with separate ports are different." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) ;; We test it only for the mock-up connection; otherwise there might ;; be problems with the used ports. @@ -6707,6 +6714,7 @@ INPUT, if non-nil, is a string sent to the process." ;; This test is inspired by Bug#33781. (ert-deftest tramp-test35-remote-path () "Check loooong `tramp-remote-path'." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) @@ -7134,6 +7142,7 @@ INPUT, if non-nil, is a string sent to the process." (ert-deftest tramp-test39-make-lock-file-name () "Check `make-lock-file-name', `lock-file', `unlock-file' and `file-locked-p'." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) @@ -7295,6 +7304,7 @@ INPUT, if non-nil, is a string sent to the process." (ert-deftest tramp-test39-detect-external-change () "Check that an external file modification is reported." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) @@ -7935,6 +7945,7 @@ This requires restrictions of file name syntax." (ert-deftest tramp-test42-utf8 () "Check UTF8 encoding in file names and file contents." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-container-p))) (skip-unless (not (tramp--test-rsync-p))) @@ -8005,6 +8016,7 @@ This requires restrictions of file name syntax." (ert-deftest tramp-test43-file-system-info () "Check that `file-system-info' returns proper values." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (when-let* ((fsi (file-system-info ert-remote-temporary-file-directory))) @@ -8018,6 +8030,7 @@ This requires restrictions of file name syntax." "Check results of user/group functions. `file-user-uid', `file-group-gid', and `tramp-get-remote-*' should all return proper values." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (let ((default-directory ert-remote-temporary-file-directory)) @@ -8622,6 +8635,7 @@ process sentinels. They shall not disturb each other." ;; This test is inspired by Bug#78572. (ert-deftest tramp-test48-session-timeout () "Check that Tramp handles a session timeout properly." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) @@ -8702,6 +8716,7 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test49-external-backend-function () "Check that Tramp handles external functions for a given backend." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-ange-ftp-p))) @@ -8846,6 +8861,7 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test50-recursive-load () "Check that Tramp does not fail due to recursive load." + :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (let ((default-directory (expand-file-name temporary-file-directory))) From a32ee5026be0646129b0a6aea5a607e109c2b35c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 20 Jan 2026 12:31:51 +0100 Subject: [PATCH 213/325] Extend Tramp traces * lisp/net/tramp-message.el (tramp-debug-message): Change selection for `trace-function-background'. --- lisp/net/tramp-message.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/net/tramp-message.el b/lisp/net/tramp-message.el index fe7758bdb08..7b405061ba8 100644 --- a/lisp/net/tramp-message.el +++ b/lisp/net/tramp-message.el @@ -240,8 +240,10 @@ ARGUMENTS to actually emit the message (if applicable)." (dolist (elt (append - (mapcar - #'intern (all-completions "tramp-" obarray #'functionp)) + (apropos-internal (rx bos "tramp-") #'functionp) + (apropos-internal (rx bos "tramp-") #'macrop) + (apropos-internal + (rx bos "with-" (? "parsed-") "tramp-") #'macrop) tramp-trace-functions)) (unless (get elt 'tramp-suppress-trace) (trace-function-background elt (tramp-trace-buffer-name vec))))) From 2fc549f3b4c1734ae4d755d43f4b7541f3dcd127 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Tue, 20 Jan 2026 14:44:49 +0000 Subject: [PATCH 214/325] ; * lisp/net/browse-url.el (browse-url-with-browser-kind): Fix call. --- lisp/net/browse-url.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 000102f7463..83ec67f976c 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -1003,7 +1003,7 @@ opposite of the browser kind of `browse-url-browser-function'." (let ((browse-url-browser-function function) (browse-url-handlers nil) (browse-url-default-handlers nil)) - (browse-url url)))) + (browse-url url arg)))) ;;;###autoload (defun browse-url-at-mouse (event) From 9ba2f13176a756030e4d8476436662d630447f65 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Tue, 20 Jan 2026 19:32:16 +0200 Subject: [PATCH 215/325] * lisp/tab-bar.el (tab-bar-split-tab): New command. (split-tab): Alias for 'tab-bar-split-tab'. --- etc/NEWS | 7 ++++--- lisp/tab-bar.el | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 3 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d21cf659bfb..fc6ba353d9a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -539,9 +539,10 @@ every buffer. ** Tab Bars and Tab Lines --- -*** New command 'merge-tabs'. -'merge-tabs' merges all windows from two tabs into one of these tabs -and closes the other tab. +*** New commands 'split-tab' and 'merge-tabs'. +'split-tab' moves a specified number of windows from an existing tab +to a newly-created tab. 'merge-tabs' merges all windows from two tabs +into one of these tabs and closes the other tab. --- *** New abnormal hook 'tab-bar-auto-width-functions'. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index 6204dd81d7c..e40171f27a5 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1964,6 +1964,42 @@ configuration." (delete-window)) (tab-bar-switch-to-recent-tab)) +(defun tab-bar-split-tab (&optional tab arg) + "Split windows of specified TAB into two separate tabs. +TAB defaults to the selected tab. ARG specifies the number +of windows to consider for splitting and defaults to 1. +Interactively, ARG is the prefix argument. + +First divide the child windows of TAB's main window into two parts. +The first part includes the first ARG child windows if ARG is positive, +or -ARG last windows if it's negative. The second part includes the +remaining child windows of TAB's main window. Then clone into a +newly-created tab each of the windows of the part which does not +include TAB's selected window and delete those windows from TAB." + (interactive "i\nP") + (let* ((tab (or tab (1+ (tab-bar--current-tab-index)))) + (_ (unless (eq tab (1+ (tab-bar--current-tab-index))) + (tab-bar-select-tab tab))) + (main (window-main-window)) + (total-window-count (window-child-count main)) + (arg (or arg 1))) + (cond + ((window-live-p main) + (user-error "Cannot split tab with only one window")) + ((or (not (numberp arg)) (zerop arg)) + (user-error "Invalid ARG %s for splitting tab" arg)) + ((>= (abs arg) total-window-count) + (user-error "ARG %s exceeds number of windows %s that can be split off" + (abs arg) (1- total-window-count))) + (t + (let* ((comb (window--get-split-combination main arg)) + (ws (window-state-get comb))) + (delete-window comb) + (tab-bar-new-tab) + (window-state-put ws (window-main-window))))))) + +(defalias 'split-tab #'tab-bar-split-tab) + (defun tab-bar-merge-tabs (&optional tab1 tab2 vertical) "Merge the main window of TAB2 into TAB1. Split the main window of TAB1 and make the new window display From 4150c2e22e93ca6bdf682b0067d430e412db3688 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 13 Jan 2026 13:41:55 -0500 Subject: [PATCH 216/325] (garbage-collect-heapsize): New function The info returned from `garbage-collect` is really handy to track the evolution of the heap size, but sadly it's available only at the cost of running a full GC, which has two big downsides: it's slow, it affects what we're measuring, and it can't be used in `post-gc-hook`. So, this patch makes it available without running the GC. * src/alloc.c (Fgarbage_collect_heapsize): New function, extracted from `Fgarbage_collect`. (Fgarbage_collect): Use it. (syms_of_alloc): defsubr it. * doc/lispref/internals.texi (Garbage Collection): Extract documentation for it from that of `garbage-collect`. --- doc/lispref/internals.texi | 22 ++++++++++++++-------- etc/NEWS | 5 +++++ src/alloc.c | 31 +++++++++++++++++++++++-------- 3 files changed, 42 insertions(+), 16 deletions(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 70dca8014d0..64e820537e9 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -286,13 +286,9 @@ program does not use so much space as to force a second garbage collection). @end quotation -@deffn Command garbage-collect -This command runs a garbage collection, and returns information on -the amount of space in use. (Garbage collection can also occur -spontaneously if you use more than @code{gc-cons-threshold} bytes of -Lisp data since the previous garbage collection.) - -@code{garbage-collect} returns a list with information on amount of space in +@defun garbage-collect-heapsize +This function returns information on the current memory usage. +The return value is a list with information on amount of space in use, where each entry has the form @samp{(@var{name} @var{size} @var{used})} or @samp{(@var{name} @var{size} @var{used} @var{free})}. In the entry, @var{name} is a symbol describing the kind of objects this entry represents, @@ -422,7 +418,17 @@ Total heap size, in @var{unit-size} units. @item free-size Heap space which is not currently used, in @var{unit-size} units. @end table -@end deffn +@end defun + +@deffn Command garbage-collect +This command runs a garbage collection, and returns information on +the amount of space in use. (Garbage collection can also occur +spontaneously if you use more than @code{gc-cons-threshold} bytes of +Lisp data since the previous garbage collection.) + +@code{garbage-collect} returns the same list as shown above for +@code{garbage-collect-heapsize}. +@deffn @defopt garbage-collection-messages If this variable is non-@code{nil}, Emacs displays a message at the diff --git a/etc/NEWS b/etc/NEWS index fc6ba353d9a..32b5ff02cc1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3632,6 +3632,11 @@ and other similar functions. * Lisp Changes in Emacs 31.1 ++++ +** New function 'garbage-collect-heapsize'. +Same as 'garbage-collect' but just returns the info from the last GC +without performing a collection. + +++ ** Improve 'replace-region-contents' to accept more forms of sources. It has been promoted from 'subr-x' to the C code. diff --git a/src/alloc.c b/src/alloc.c index c0e23192c0f..a4e97d7a8c3 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5996,14 +5996,7 @@ DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", doc: /* Reclaim storage for Lisp objects no longer needed. Garbage collection happens automatically if you cons more than `gc-cons-threshold' bytes of Lisp data since previous garbage collection. -`garbage-collect' normally returns a list with info on amount of space in use, -where each entry has the form (NAME SIZE USED FREE), where: -- NAME is a symbol describing the kind of objects this entry represents, -- SIZE is the number of bytes used by each one, -- USED is the number of those objects that were found live in the heap, -- FREE is the number of those objects that are not live but that Emacs - keeps around for future allocations (maybe because it does not know how - to return them to the OS). +It returns the same info as `garbage-collect-heapsize'. Note that calling this function does not guarantee that absolutely all unreachable objects will be garbage-collected. Emacs uses a @@ -6020,8 +6013,29 @@ For further details, see Info node `(elisp)Garbage Collection'. */) specbind (Qsymbols_with_pos_enabled, Qnil); garbage_collect (); unbind_to (count, Qnil); + return Fgarbage_collect_heapsize (); +} + +DEFUN ("garbage-collect-heapsize", Fgarbage_collect_heapsize, + Sgarbage_collect_heapsize, 0, 0, 0, + doc: /* Return a list with info on amount of space in use. +This info may not be fully up to date unless it is called right after +a full garbage collection cycle. +Each entry has the form (NAME SIZE USED FREE), where: +- NAME is a symbol describing the kind of objects this entry represents, +- SIZE is the number of bytes used by each one, +- USED is the number of those objects that were found live in the heap, +- FREE is the number of those objects that are not live but that Emacs + keeps around for future allocations (maybe because it does not know how + to return them to the OS). */) + () +{ struct gcstat gcst = gcstat; + /* FIXME: Maybe we could/should add a field countaing the approximate + amount of memory allocated since the last GC, such as + 'gc_threshold - consing_until_gc'. */ + Lisp_Object total[] = { list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)), make_int (gcst.total_conses), @@ -7512,6 +7526,7 @@ N should be nonnegative. */); defsubr (&Smake_finalizer); defsubr (&Sgarbage_collect); defsubr (&Sgarbage_collect_maybe); + defsubr (&Sgarbage_collect_heapsize); defsubr (&Smemory_info); defsubr (&Smemory_use_counts); #if defined GNU_LINUX && defined __GLIBC__ && \ From 75dd442058eb69f88a8acd11f95d25cf7eb1e0c7 Mon Sep 17 00:00:00 2001 From: Jared Finder Date: Tue, 20 Jan 2026 22:46:31 -0500 Subject: [PATCH 217/325] (xterm--init): Fix probem in async mode (bug#80163) In async mode, the workaround for the old Terminal.app collides with the binding we install for the primary DA. Just drop it. * lisp/term/xterm.el (xterm--init): Remove workaround for very old macOS `Terminal.app`. --- lisp/term/xterm.el | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index 7b3e674d997..50135b104a0 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -983,11 +983,7 @@ We run the first FUNCTION whose STRING matches the input events." ;; Try to find out the type of terminal by sending a "Secondary ;; Device Attributes (DA)" query. (xterm--query "\e[>0c" - ;; Some terminals (like macOS's Terminal.app) respond to - ;; this query as if it were a "Primary Device Attributes" - ;; query instead, so we should handle that too. - '(("\e[?" . xterm--version-handler) - ("\e[>" . xterm--version-handler))) + '(("\e[>" . xterm--version-handler))) ;; Check primary DA for OSC-52 support (xterm--query "\e[c" '(("\e[?" . xterm--primary-da-handler)))) From ff644701393431f59a4bfc8764f3c9f719f42c7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?El=C3=ADas=20Gabriel=20P=C3=A9rez?= Date: Wed, 14 Jan 2026 22:06:01 -0600 Subject: [PATCH 218/325] hideshow: Use 'message' instead of 'user-error'. (Bug#80201) Using 'user-error' in 'hs-minor-mode', prevents the major-mode from initializing correctly when hideshow is not supported in that mode, using 'message' instead fixes this. * lisp/progmodes/hideshow.el (hs-minor-mode): Tweak. --- lisp/progmodes/hideshow.el | 60 ++++++++++++++++++++------------------ 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 4f2942ee9e9..3043b04c5ad 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -1498,36 +1498,38 @@ Key bindings: :keymap hs-minor-mode-map (setq hs-headline nil) - (if hs-minor-mode - (progn - (unless (and comment-start comment-end) - (setq hs-minor-mode nil) - (user-error "%S doesn't support the Hideshow minor mode" - major-mode)) + (cond + ((and hs-minor-mode + (not (and comment-start comment-end))) + (setq hs-minor-mode nil) + (message "%S doesn't support the Hideshow minor mode" + major-mode)) - ;; Set the old variables - (hs-grok-mode-type) - ;; Turn off this mode if we change major modes. - (add-hook 'change-major-mode-hook - #'turn-off-hideshow nil t) - (setq-local line-move-ignore-invisible t) - (add-to-invisibility-spec '(hs . t)) - ;; Add block indicators - (when (and hs-show-indicators - (or (and (integerp hs-indicator-maximum-buffer-size) - (< (buffer-size) hs-indicator-maximum-buffer-size)) - (not hs-indicator-maximum-buffer-size))) - (when (and (not (display-graphic-p)) - (eq hs-indicator-type 'fringe)) - (setq-local hs-indicator-type 'margin)) - (when (eq hs-indicator-type 'margin) - (setq-local left-margin-width (1+ left-margin-width)) - (setq-local fringes-outside-margins t) - ;; Force display of margins - (when (eq (current-buffer) (window-buffer)) - (set-window-buffer nil (window-buffer)))) - (jit-lock-register #'hs--add-indicators))) + (hs-minor-mode + ;; Set the old variables + (hs-grok-mode-type) + ;; Turn off this mode if we change major modes. + (add-hook 'change-major-mode-hook + #'turn-off-hideshow nil t) + (setq-local line-move-ignore-invisible t) + (add-to-invisibility-spec '(hs . t)) + ;; Add block indicators + (when (and hs-show-indicators + (or (and (integerp hs-indicator-maximum-buffer-size) + (< (buffer-size) hs-indicator-maximum-buffer-size)) + (not hs-indicator-maximum-buffer-size))) + (when (and (not (display-graphic-p)) + (eq hs-indicator-type 'fringe)) + (setq-local hs-indicator-type 'margin)) + (when (eq hs-indicator-type 'margin) + (setq-local left-margin-width (1+ left-margin-width)) + (setq-local fringes-outside-margins t) + ;; Force display of margins + (when (eq (current-buffer) (window-buffer)) + (set-window-buffer nil (window-buffer)))) + (jit-lock-register #'hs--add-indicators))) + (t (remove-from-invisibility-spec '(hs . t)) (remove-overlays nil nil 'hs-indicator t) (remove-overlays nil nil 'invisible 'hs) @@ -1539,7 +1541,7 @@ Key bindings: (kill-local-variable 'fringes-outside-margins) ;; Force removal of margins (when (eq (current-buffer) (window-buffer)) - (set-window-buffer nil (window-buffer))))))) + (set-window-buffer nil (window-buffer)))))))) ;;;; that's it From 0d448871be6ab1835b676c80eb6f07e55ea44e6a Mon Sep 17 00:00:00 2001 From: Morgan Smith Date: Wed, 21 Jan 2026 09:24:52 +0100 Subject: [PATCH 219/325] * doc/misc/dbus.texi (Inhibitor Locks): Fix path. --- doc/misc/dbus.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 946e7666629..59685087ae8 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -2300,12 +2300,12 @@ D-Bus signal @samp{org.freedesktop.login1.Manager.PrepareForSleep}: (dbus-make-inhibitor-lock "sleep" "Test")))) (dbus-register-signal - :system "org.freedesktop.login1" "/org/freedesktop/login1/Manager" + :system "org.freedesktop.login1" "/org/freedesktop/login1" "org.freedesktop.login1.Manager" "PrepareForSleep" #'my-dbus-PrepareForSleep-handler) @result{} ((:signal :system "org.freedesktop.login1.Manager" "PrepareForSleep") - ("org.freedesktop.login1" "/org/freedesktop/login1/Manager" + ("org.freedesktop.login1" "/org/freedesktop/login1" my-dbus-PrepareForSleep-handler)) @end lisp From 2d758e73ebd74705484017137f1c255735cac00b Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Wed, 21 Jan 2026 11:14:36 +0100 Subject: [PATCH 220/325] Fix thinko in 'quit-restore-window' * lisp/window.el (quit-restore-window): Try to restore the previously selected window only if WINDOW is either the selected window or BURY-OR-KILL is neither 'burying' nor 'killing'. Otherwise, this might deliberately change the selected window, for example, when 'kill-buffer-quit-windows' is non-nil and WINDOW shows the buffer to kill. --- lisp/window.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/lisp/window.el b/lisp/window.el index b6c6c34983e..98722e909a6 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5502,8 +5502,13 @@ elsewhere. This value is used by `quit-windows-on'." ;; If quit-restore-prev was not used, reset the quit-restore ;; parameter (set-window-parameter window 'quit-restore nil)) - ;; If the previously selected window is still alive, select it. - (window--quit-restore-select-window quit-restore-2)) + ;; If WINDOW is the selected window and the previously selected + ;; window is still alive, try to select that window. But do that + ;; only if WINDOW is either the selected window or we are neither + ;; "burying" nor "killing". + (unless (and (not (eq window (selected-window))) + (memq bury-or-kill '(killing burying))) + (window--quit-restore-select-window quit-restore-2))) (t ;; Show some other buffer in WINDOW and leave the ;; quit-restore(-prev) parameters alone (Juri's idea). From ac8bc9a2e2f2062bce8788ea5f058baa317953f1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 21 Jan 2026 13:44:31 +0200 Subject: [PATCH 221/325] ; * src/alloc.c (Fgarbage_collect_heapsize): Avoid compiler warning. --- src/alloc.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/alloc.c b/src/alloc.c index a4e97d7a8c3..c0c24c65737 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6028,7 +6028,7 @@ Each entry has the form (NAME SIZE USED FREE), where: - FREE is the number of those objects that are not live but that Emacs keeps around for future allocations (maybe because it does not know how to return them to the OS). */) - () + (void) { struct gcstat gcst = gcstat; From b364c42a0eb884a07286f13f09ead50f878c026e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 21 Jan 2026 12:44:21 +0100 Subject: [PATCH 222/325] ; * doc/lispref/internals.texi (Garbage Collection): typo --- doc/lispref/internals.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 64e820537e9..26292d75369 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -428,7 +428,7 @@ Lisp data since the previous garbage collection.) @code{garbage-collect} returns the same list as shown above for @code{garbage-collect-heapsize}. -@deffn +@end deffn @defopt garbage-collection-messages If this variable is non-@code{nil}, Emacs displays a message at the From 7ce09a741a8d4bde356a268d3bf93f7253528f6a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 09:33:43 +0000 Subject: [PATCH 223/325] Jsonrpc: allow control over jsonrpc-request quits This allows clients such as Eglot to act on the user C-g's/quits out of a blocking jsonrpc-request call. It also fixes the TIMEOUT=nil passed to jsonrpc-request. An infinite timeout in that case (for a long-running request, for example) and it was not being transmitted to the lower jsonrpc-async-request. * lisp/jsonrpc.el (jsonrpc-request): Add CANCEL-ON-QUIT. Rework docstring. --- lisp/jsonrpc.el | 154 +++++++++++++++++++++++++++--------------------- 1 file changed, 86 insertions(+), 68 deletions(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 955a4f89009..0cd5097e5f0 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -413,86 +413,104 @@ as specified in the JSONRPC 2.0 spec." (apply #'jsonrpc--async-request-1 connection method params args)) (cl-defun jsonrpc-request (connection - method params &key + method params + &rest args + &key deferred timeout + cancel-on-quit cancel-on-input cancel-on-input-retval) "Make a request to CONNECTION, synchronously wait for a reply. -CONNECTION, METHOD and PARAMS as in `jsonrpc-async-request' (which see). +CONNECTION, METHOD, PARAMS, DEFERRED and TIMEOUT are interpreted as in +`jsonrpc-async-request', which see. -Except in the case of a non-nil CANCEL-ON-INPUT (explained -below), this function doesn't exit until anything interesting -happens (success reply, error reply, or timeout). Furthermore, -it only exits locally (returning the JSONRPC result object) if -the request is successful, otherwise it exits non-locally with an -error of type `jsonrpc-error'. +This function has two exit modes: local and non-local. Except for +CANCEL-ON-INPUT, explained below, the only normal local exit occurs when +the remote endpoint succeeds, in which case a JSONRPC result object is +returned. A remote endpoint error or a local timeout cause a non-local +exit with a `jsonrpc-error' condition. -DEFERRED and TIMEOUT as in `jsonrpc-async-request', which see. +A user quit (`'C-g'/`keyboard-quit') causes a non-local exit with a +`quit' condition. A non-nil CANCEL-ON-QUIT must be a function of a +single argument, ID, which identifies the request as specified in the +JSONRPC 2.0 spec. Callers may use this function to issue a cancel +notification to the endpoint, thus preventing it from continuing to work +on the request. -If CANCEL-ON-INPUT is non-nil and the user inputs something while the -function is waiting, the function locally exits immediately returning -CANCEL-ON-INPUT-RETVAL. Any future replies to the request coming from -the remote endpoint (normal or error) are ignored. If CANCEL-ON-INPUT -is a function, it is invoked with one argument, an integer identifying -the canceled request as specified in the JSONRPC 2.0 spec. Callers may -use this function to issue a cancel notification to the endpoint, thus -preventing it from continuing to work on the now-cancelled request." +If CANCEL-ON-INPUT is non-nil and any type of user input is detected +while waiting for a response `jsonrpc-request' locally exits +immediately, returning CANCEL-ON-INPUT-RETVAL. CANCEL-ON-INPUT can also +be a function with the same semantics as CANCEL-ON-QUIT. Since the a +`C-g'/`keyboard-quit' also counts as user input, CANCEL-ON-INPUT +nullifies the effect of CANCEL-ON-QUIT. + +On either cancellation scenario, any future remote endpoint replies +to the original request (normal or error) are ignored." (let* ((tag (funcall (if (fboundp 'gensym) 'gensym 'cl-gensym) "jsonrpc-request-catch-tag")) id-and-timer canceled (throw-on-input nil) - (retval - (unwind-protect - (catch tag - (setq - id-and-timer - (apply - #'jsonrpc--async-request-1 - connection method params - :sync-request t - :success-fn (lambda (result) - (unless canceled - (throw tag `(done ,result)))) - :error-fn - (jsonrpc-lambda - (&key code message data) - (unless canceled - (throw tag `(error (jsonrpc-error-code . ,code) - (jsonrpc-error-message . ,message) - (jsonrpc-error-data . ,data))))) - :timeout-fn - (lambda () - (unless canceled - (throw tag '(error (jsonrpc-error-message . "Timed out"))))) - `(,@(when deferred `(:deferred ,deferred)) - ,@(when timeout `(:timeout ,timeout))))) - (cond (cancel-on-input - (unwind-protect - (let ((inhibit-quit t)) (while (sit-for 30))) - (setq canceled t)) - (when (functionp cancel-on-input) - (funcall cancel-on-input (car id-and-timer))) - `(canceled ,cancel-on-input-retval)) - (t (while t (accept-process-output nil 30))))) - ;; In normal operation, continuations for error/success is - ;; handled by `jsonrpc--continue'. Timeouts also remove - ;; the continuation... - (pcase-let* ((`(,id ,_) id-and-timer)) - ;; ...but we still have to guard against exist explicit - ;; user-quit (C-g) or the `cancel-on-input' case, so - ;; discard the continuation. - (jsonrpc--remove connection id (list deferred (current-buffer))) - ;; ...finally, whatever may have happened to this sync - ;; request, it might have been holding up any outer - ;; "anxious" continuations. The following ensures we - ;; call them. - (jsonrpc--continue connection id))))) - (when (eq 'error (car retval)) - (signal 'jsonrpc-error - (cons - (format "request id=%s failed:" (car id-and-timer)) - (cdr retval)))) + retval) + (unwind-protect + (catch tag + (setq + id-and-timer + (apply + #'jsonrpc--async-request-1 + connection method params + :sync-request t + :success-fn (lambda (result) + (unless canceled + (setq retval `(done ,result)) + (throw tag nil))) + :error-fn + (jsonrpc-lambda + (&key code message data) + (unless canceled + (setq retval `(error (jsonrpc-error-code . ,code) + (jsonrpc-error-message . ,message) + (jsonrpc-error-data . ,data))) + (throw tag nil))) + :timeout-fn + (lambda () + (unless canceled + (setq retval '(error (jsonrpc-error-message . "Timed out"))) + (throw tag nil))) + `(,@(when (plist-member args :deferred) `(:deferred ,deferred)) + ,@(when (plist-member args :timeout) `(:timeout ,timeout))))) + (cond (cancel-on-input + (unwind-protect + (let ((inhibit-quit t)) (while (sit-for 30))) + (setq canceled t)) + (when (functionp cancel-on-input) + (funcall cancel-on-input (car id-and-timer))) + (setq retval `(canceled ,cancel-on-input-retval))) + (t (let ((inhibit-quit nil)) + (while t (accept-process-output nil 30)))))) + ;; In normal operation, continuations for error/success is + ;; handled by `jsonrpc--continue'. Timeouts also remove + ;; the continuation... + (pcase-let* ((`(,id ,_) id-and-timer)) + ;; ...but we still have to guard against exist explicit + ;; user-quit (C-g) or the `cancel-on-input' case, so + ;; discard the continuation. + (jsonrpc--remove connection id (list deferred (current-buffer))) + ;; Furthermore, assume a nil `retval' is a quit from + ;; `accept-process-output' (either "soft" or "hard," like a + ;; double C-g C-g on TTY terminals) + (unless retval + (when cancel-on-quit (funcall cancel-on-quit id))) + ;; ...finally, whatever may have happened to this sync + ;; request, it might have been holding up any outer + ;; "anxious" continuations. The following ensures we + ;; call them. + (jsonrpc--continue connection id))) + (cond ((eq 'error (car retval)) + (signal 'jsonrpc-error + (cons + (format "request id=%s failed:" (car id-and-timer)) + (cdr retval))))) (cadr retval))) (cl-defun jsonrpc-notify (connection method params) From adb605716f2feda57a9ab5ea0d1d979e51ce8915 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 10:46:24 +0000 Subject: [PATCH 224/325] Jsonrpc: don't let remote endpoint requests go unanswered Previously, 'quit' could cause remote endpoints to never get a reply and thus sometimes hang. Ensure we always reply. Also, give the application a chance to signal jsonrpc-error with the served code=32000, meaning "no error". * doc/lispref/text.texi (JSONRPC Overview): Rework section on request dispatchers. * lisp/jsonrpc.el (jsonrpc-connection-receive): Rework. --- doc/lispref/text.texi | 21 +++++++++++++++------ lisp/jsonrpc.el | 39 +++++++++++++++++++++++---------------- 2 files changed, 38 insertions(+), 22 deletions(-) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index d88fb99a6ed..a313480944b 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -6014,12 +6014,21 @@ must be a Lisp object that can be serialized as JSON (@pxref{Parsing JSON}). The result is forwarded to the server as the JSONRPC @code{result} object. A non-local return, achieved by calling the function @code{jsonrpc-error}, causes an error response to be sent to -the server. The details of the accompanying JSONRPC @code{error} -object are filled out with whatever was passed to -@code{jsonrpc-error}. A non-local return triggered by an unexpected -error of any other type also causes an error response to be sent -(unless you have set @code{debug-on-error}, in which case this calls -the Lisp debugger, @pxref{Error Debugging}). +the server. A non-local return triggered by an unexpected error of any +other type also causes a response to be sent. The debugger is never +called (unless you have set @code{debug-on-error}, in which case the +Lisp debugger may be called, @pxref{Error Debugging}). + +The details of the accompanying JSONRPC @code{error} object are filled +out automatically (in the case of unexpected errors) or with whatever +was passed to @code{jsonrpc-error} (in the case of explicit calls). + +Exceptionally, an explicit call to @code{jsonrpc-error} which sets +@code{:code} to 32000 and @code{:data} to any JSON object has the +meaning of ``no error'' and triggers a normal response to the remote +endpoint with @code{result} being set to @code{:data}. This is useful +if the application wants to treat some non-local exits such as user +quits as benign. @findex jsonrpc-convert-to-endpoint @findex jsonrpc-convert-from-endpoint diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 0cd5097e5f0..74a59a04095 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -327,22 +327,29 @@ dispatcher in CONN." (and method id) (let* ((debug-on-error (and debug-on-error (not jsonrpc-inhibit-debug-on-error))) - (reply - (condition-case-unless-debug _ignore - (condition-case oops - `(:result ,(funcall rdispatcher conn (intern method) - params)) - (jsonrpc-error - `(:error - (:code - ,(or (alist-get 'jsonrpc-error-code (cdr oops)) - -32603) - :message ,(or (alist-get 'jsonrpc-error-message - (cdr oops)) - "Internal error"))))) - (error - '(:error (:code -32603 :message "Internal error")))))) - (apply #'jsonrpc--reply conn id method reply))) + reply) + (unwind-protect + (setq + reply + (condition-case oops + `(:result + ,(funcall rdispatcher conn (intern method) params)) + (jsonrpc-error + (let* ((data (cdr oops)) + (code (alist-get 'jsonrpc-error-code data)) + (msg (alist-get 'jsonrpc-error-message + (cdr oops)))) + (if (eq code 32000) ;; This means 'no error' + (when-let* ((d (alist-get 'jsonrpc-error-data + data))) + `(:result ,d)) + `(:error + (:code ,(or code -32603) + :message ,(or msg "Internal error")))))))) + (unless reply + (setq reply + `(:error (:code -32603 :message "Internal error")))) + (apply #'jsonrpc--reply conn id method reply)))) (;; A remote notification method (funcall ndispatcher conn (intern method) params)) From 977e3547090ed1685c4d9353a8841452438c1496 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 09:26:26 +0000 Subject: [PATCH 225/325] Eglot: treat code=0 JSONRPC errors as benign * lisp/progmodes/eglot.el (eglot--request): Shoosh code=0 errors. (eglot-mode-line-error): Check for code=0. --- lisp/progmodes/eglot.el | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 3d4ff25528f..b61d81b2c15 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1959,15 +1959,21 @@ in project `%s'." "Like `jsonrpc-request', but for Eglot LSP requests. Unless IMMEDIATE, send pending changes before making request." (unless immediate (eglot--signal-textDocument/didChange)) - (jsonrpc-request server method params - :timeout timeout - :cancel-on-input - (cond ((and cancel-on-input - eglot-advertise-cancellation) - (lambda (id) - (jsonrpc-notify server '$/cancelRequest `(:id ,id)))) - (cancel-on-input)) - :cancel-on-input-retval cancel-on-input-retval)) + (condition-case oops + (jsonrpc-request + server method params + :timeout timeout + :cancel-on-input + (cond ((and cancel-on-input + eglot-advertise-cancellation) + (lambda (id) + (jsonrpc-notify server '$/cancelRequest `(:id ,id)))) + (cancel-on-input)) + :cancel-on-input-retval cancel-on-input-retval) + (jsonrpc-error + (let* ((data (cddr oops)) (code (alist-get 'jsonrpc-error-code data))) + (if (zerop code) (eglot--message (alist-get 'jsonrpc-error-message data)) + (signal 'jsonrpc-error (cdr oops))))))) (defvar-local eglot--inflight-async-requests nil "An plist of symbols to lists of JSONRPC ids. @@ -2643,12 +2649,14 @@ Uses THING, FACE, DEFS and PREPEND." (defconst eglot-mode-line-error '(:eval (when-let* ((server (eglot-current-server)) - (last-error (and server (jsonrpc-last-error server)))) - (eglot--mode-line-props - "error" 'compilation-mode-line-fail - '((mouse-3 eglot-clear-status "Clear this status")) - (format "An error occurred: %s\n" (plist-get last-error - :message))))) + (last-error (and server (jsonrpc-last-error server))) + (code (plist-get last-error :code))) + (unless (zerop code) + (eglot--mode-line-props + "error" 'compilation-mode-line-fail + '((mouse-3 eglot-clear-status "Clear this status")) + (format "An error occurred: %s\n" (plist-get last-error + :message)))))) "Eglot mode line construct for LSP errors.") (defconst eglot-mode-line-pending-requests From 81b7e8e927dc2739aba3cd3f6a0592bf8de9685e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 21 Jan 2026 01:08:15 +0000 Subject: [PATCH 226/325] Eglot: fix async request cancellation It was completely broken, with a cancel being set for every sent (and probably already received) async request, and no actual discarding of the response of a cancelled request. * lisp/progmodes/eglot.el (eglot--async-request): Fix cancellation of async requests. (eglot--semtok-request): Don't need 'buf' &aux anymore. --- lisp/progmodes/eglot.el | 89 +++++++++++++++++++++-------------------- 1 file changed, 46 insertions(+), 43 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b61d81b2c15..6137c292534 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2006,31 +2006,37 @@ according to `eglot-advertise-cancellation'.") (timeout-fn nil timeout-fn-supplied-p) (timeout nil timeout-supplied-p) hint - &aux moreargs) + &aux moreargs + id (buf (current-buffer))) "Like `jsonrpc-async-request', but for Eglot LSP requests. +SUCCESS-FN, ERROR-FN and TIMEOUT-FN run in buffer of call site. HINT argument is a symbol passed as DEFERRED to `jsonrpc-async-request' and also used as a hint of the request cancellation mechanism (see `eglot-advertise-cancellation')." - (cl-labels ((clearing-fn (fn) - (lambda (&rest args) - (when fn (apply fn args)) - (cl-remf eglot--inflight-async-requests hint)))) + (cl-labels + ((clearing-fn (fn) + (lambda (&rest args) + (eglot--when-live-buffer buf + (when (and + fn (memq id (cl-getf eglot--inflight-async-requests hint))) + (apply fn args)) + (cl-remf eglot--inflight-async-requests hint))))) (eglot--cancel-inflight-async-requests (list hint)) (when timeout-supplied-p (setq moreargs (nconc `(:timeout ,timeout) moreargs))) (when hint (setq moreargs (nconc `(:deferred ,hint) moreargs))) - (let ((id - (car (apply #'jsonrpc-async-request - server method params - :success-fn (clearing-fn success-fn) - :error-fn (clearing-fn error-fn) - :timeout-fn (clearing-fn timeout-fn) - moreargs)))) - (when (and hint eglot-advertise-cancellation) - (push id - (plist-get eglot--inflight-async-requests hint))) - id))) + (setq id + (car (apply #'jsonrpc-async-request + server method params + :success-fn (clearing-fn success-fn) + :error-fn (clearing-fn error-fn) + :timeout-fn (clearing-fn timeout-fn) + moreargs))) + (when (and hint eglot-advertise-cancellation) + (push id + (plist-get eglot--inflight-async-requests hint))) + id)) (cl-defun eglot--delete-overlays (&optional (prop 'eglot--overlays)) (eglot--widening @@ -3432,15 +3438,14 @@ When response arrives call registered `eglot--flymake-report-fn'." `(:previousResultId ,prev-result-id)))) :success-fn (eglot--lambda ((DocumentDiagnosticReport) kind items resultId) - (eglot--when-live-buffer buf - (pcase kind - ("full" - (setq eglot--pulled-diagnostics - (list items version resultId)) - (eglot--flymake-report-push+pulled :force t)) - ("unchanged" - (when (eq buf origin) - (eglot--flymake-report-1 nil :stay :force t))))) + (pcase kind + ("full" + (setq eglot--pulled-diagnostics + (list items version resultId)) + (eglot--flymake-report-push+pulled :force t)) + ("unchanged" + (when (eq buf origin) + (eglot--flymake-report-1 nil :stay :force t)))) (when then (funcall then))) :hint :textDocument/diagnostic))))) ;; JT@2025-12-15: No known server yet supports "relatedDocuments" so @@ -5043,8 +5048,7 @@ See `eglot--semtok-request' implementation for details.") "Ask for tokens. Arrange for BEG..END to be font-lock flushed." (cl-macrolet ((c (tag) `(cl-getf eglot--semtok-state ,tag))) (cl-labels - ((req (method &optional params cont - &aux (buf (current-buffer))) + ((req (method &optional params cont) (setf (c :req-docver) docver (c :orig-docver) docver (c :dispatched) (not eglot--recent-changes) @@ -5055,22 +5059,21 @@ See `eglot--semtok-request' implementation for details.") (append (nconc params `(:textDocument ,(eglot--TextDocumentIdentifier)))) :success-fn (lambda (response) - (eglot--when-live-buffer buf - ;; (trace-values "Response" - ;; eglot--docver docver (c :orig-docver) (c :req-docver)) - ;; This skip is different from the one below. Comparing - ;; the lexical `docver' to the original request's - ;; `:orig-docver' allows skipping the outdated response - ;; of a dispatched request that has been overridden by - ;; another (perhaps not dispatched yet) request. - (when (eq docver (c :orig-docver)) - (setf (c :docver) (c :req-docver) - (c :data) (if cont (funcall cont response) - (plist-get response :data)) - (c :resultId) (plist-get response :resultId)) - ;; (trace-values "Flushing" (length (c :regions)) "regions") - (cl-loop for (a . b) in (c :regions) do (font-lock-flush a b)) - (setf (c :regions) nil)))) + ;; (trace-values "Response" + ;; eglot--docver docver (c :orig-docver) (c :req-docver)) + ;; This skip is different from the one below. Comparing + ;; the lexical `docver' to the original request's + ;; `:orig-docver' allows skipping the outdated response + ;; of a dispatched request that has been overridden by + ;; another (perhaps not dispatched yet) request. + (when (eq docver (c :orig-docver)) + (setf (c :docver) (c :req-docver) + (c :data) (if cont (funcall cont response) + (plist-get response :data)) + (c :resultId) (plist-get response :resultId)) + ;; (trace-values "Flushing" (length (c :regions)) "regions") + (cl-loop for (a . b) in (c :regions) do (font-lock-flush a b)) + (setf (c :regions) nil))) :hint 'semtok))) ;; Skip actually making the request if there's an undispatched ;; waiting for a eglot--send-changes-hook flush. Just update the From ff5bab955288d2cacb77eecbbc0ea65de50dbdbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 09:37:06 +0000 Subject: [PATCH 227/325] Eglot: advertise cancellation on eglot--request quits * lisp/progmodes/eglot.el (eglot--request): Pass CANCEL-ON-QUIT to jsonrpc-request. --- lisp/progmodes/eglot.el | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 6137c292534..ce32e542b8f 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1959,21 +1959,22 @@ in project `%s'." "Like `jsonrpc-request', but for Eglot LSP requests. Unless IMMEDIATE, send pending changes before making request." (unless immediate (eglot--signal-textDocument/didChange)) - (condition-case oops - (jsonrpc-request - server method params - :timeout timeout - :cancel-on-input - (cond ((and cancel-on-input - eglot-advertise-cancellation) - (lambda (id) - (jsonrpc-notify server '$/cancelRequest `(:id ,id)))) - (cancel-on-input)) - :cancel-on-input-retval cancel-on-input-retval) - (jsonrpc-error - (let* ((data (cddr oops)) (code (alist-get 'jsonrpc-error-code data))) - (if (zerop code) (eglot--message (alist-get 'jsonrpc-error-message data)) - (signal 'jsonrpc-error (cdr oops))))))) + (cl-flet ((cancel (id) + (jsonrpc-notify server '$/cancelRequest `(:id ,id)))) + (condition-case oops + (jsonrpc-request server method params + :timeout timeout + :cancel-on-input + (if (and cancel-on-input eglot-advertise-cancellation) + #'cancel + cancel-on-input) + :cancel-on-quit + (and eglot-advertise-cancellation #'cancel) + :cancel-on-input-retval cancel-on-input-retval) + (jsonrpc-error + (let* ((data (cddr oops)) (ec (alist-get 'jsonrpc-error-code data))) + (if (zerop ec) (eglot--message (alist-get 'jsonrpc-error-message data)) + (signal 'jsonrpc-error (cdr oops)))))))) (defvar-local eglot--inflight-async-requests nil "An plist of symbols to lists of JSONRPC ids. From 0917169782238bef030a418a13bcc548c3a01d08 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Tue, 13 Jan 2026 19:11:41 +0000 Subject: [PATCH 228/325] Eglot: slightly friendlier UI for server window/showMessageRequest Previously, the default answer pre-filled in the minibuffer was obscuring the other possible answers. * lisp/progmodes/eglot.el (eglot-handle-request): Rework. --- lisp/progmodes/eglot.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index ce32e542b8f..946a81931e1 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2757,12 +2757,11 @@ return it back to the server. :null is returned if the list was empty." (let* ((actions (mapcar (lambda (a) (cons (plist-get a :title) a)) actions)) (label (completing-read (concat - (format (propertize "[eglot] Server reports (type=%s): %s" - 'face (if (or (not type) (<= type 1)) 'error)) - type message) - "\nChoose an option: ") - (or actions '("OK")) - nil t (caar actions)))) + (propertize "[eglot]" + 'face (if (or (not type) (<= type 1)) 'error)) + " " message) + (or (mapcar #'car actions) '("OK")) + nil t))) (if (and actions label) (cdr (assoc label actions)) :null))) (cl-defmethod eglot-handle-notification From 7216d7ff87e24f07906a609d74f23fabab6c81e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 09:35:25 +0000 Subject: [PATCH 229/325] Eglot: ensure no timeout on remote command executions Else, if the server asks us a question, the user has just 10 seconds to ponder, which is a bit silly. * lisp/progmodes/eglot.el (eglot-execute): Pass timeout=nil to eglot--request. --- lisp/progmodes/eglot.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 946a81931e1..28a092539b0 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1010,7 +1010,8 @@ treated as in `eglot--dbind'." (:method (server command arguments) (eglot--request server :workspace/executeCommand - `(:command ,(format "%s" command) :arguments ,arguments)))) + `(:command ,(format "%s" command) :arguments ,arguments) + :timeout nil))) (cl-defgeneric eglot-execute (server action) "Ask SERVER to execute ACTION. @@ -1024,7 +1025,7 @@ object." (cl-remf action :title) (eglot-execute server action)) (((ExecuteCommandParams)) - (eglot--request server :workspace/executeCommand action)) + (eglot--request server :workspace/executeCommand action :timeout nil)) (((CodeAction) edit command data) (if (and (null edit) (null command) data (eglot-server-capable :codeActionProvider :resolveProvider)) From 155f524f0387dfa5b018685846a14e85322930b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 09:42:01 +0000 Subject: [PATCH 230/325] Eglot: handle user quits when applying server-initiated edits If the user simply C-g's signal a 'jsonrpc-error' with code 32000 to mean "no error", provide an LSP :failureReason and keep server chill. * lisp/progmodes/eglot.el (eglot-handle-request>): --- lisp/progmodes/eglot.el | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 28a092539b0..048dbca557a 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2838,8 +2838,18 @@ THINGS are either registrations or unregisterations (sic)." (cl-defmethod eglot-handle-request (_server (_method (eql workspace/applyEdit)) &key _label edit) "Handle server request workspace/applyEdit." - (eglot--apply-workspace-edit edit last-command) - `(:applied t)) + (condition-case-unless-debug oops + `(:applied ,(eglot--apply-workspace-edit edit last-command)) + (quit + (jsonrpc-error + :code 32000 :data + (list :applied :json-false + :failureReason + (format "'%s'%s." (car oops) + (if (cdr oops) (format " (%s)" (cdr oops)) ""))))) + (t + ;; resignal (unfortunately like this) + (signal (car oops) (cdr oops))))) (cl-defmethod eglot-handle-request (server (_method (eql workspace/workspaceFolders))) From b40e89e52355c35046fff4be227ac8b9791bbdf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 14 Jan 2026 11:09:47 +0000 Subject: [PATCH 231/325] Eglot: default eglot-advertise-cancellation to t The current 2026 landscape suggests servers (especially gopls and ocamllsp) take advantage of this, so let's give it to them by default. * lisp/progmodes/eglot.el (eglot-advertise-cancellation): Default to t. * etc/EGLOT-NEWS: Mention change. --- etc/EGLOT-NEWS | 11 +++++++++++ lisp/progmodes/eglot.el | 2 +- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 6059131cf21..49dd32e51b2 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -17,6 +17,17 @@ This refers to https://github.com/joaotavora/eglot/issues/. That is, to look up issue github#1234, go to https://github.com/joaotavora/eglot/issues/1234. + +* Changes to upcoming Eglot + +** 'eglot-advertise-cancellation' now defaults to t + +The variable 'eglot-advertise-cancellation' now defaults to t, which +means Eglot will send '$/cancelRequest' notifications to servers when it +thinks responses to inflight requests are no longer useful. The current +2026 LSP landscape (especially gopls and ocamllsp) suggests this is +beneficial and helps servers avoid costly useless work. + * Changes in Eglot 1.21 (11/1/2026) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 048dbca557a..fb48656ee05 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -583,7 +583,7 @@ under cursor." (const :tag "Call hierarchies" :callHierarchyProvider) (const :tag "On-demand \"pull\" diagnostics" :diagnosticProvider))) -(defcustom eglot-advertise-cancellation nil +(defcustom eglot-advertise-cancellation t "If non-nil, Eglot attempts to inform server of canceled requests. This is done by sending an additional '$/cancelRequest' notification every time Eglot decides to forget a request. The effect of this From f02a120f1838b49fe1bb0e155580e7690dd4972a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 15 Jan 2026 09:01:11 +0000 Subject: [PATCH 232/325] Eglot: overhaul eglot-confirm-server-edits defcustom Now also accepts file operation kinds as keys in the alist form. * lisp/progmodes/eglot.el (eglot-confirm-server-edits): Rework default value, docstring and defcustom type. (eglot--confirm-server-edits): Also check for operation-kind-based entries. --- lisp/progmodes/eglot.el | 57 +++++++++++++++++++++++++---------------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index fb48656ee05..b3f3772f88f 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -496,25 +496,26 @@ the LSP connection. That can be done by `eglot-reconnect'." (const :tag "Pretty-printed lisp" lisp))))) :package-version '(Eglot . "1.17.30")) -(defcustom eglot-confirm-server-edits '((eglot-rename . nil) - (t . maybe-summary)) +(defcustom eglot-confirm-server-edits '((t . maybe-summary)) "Control if changes proposed by LSP should be confirmed with user. -If this variable's value is the symbol `diff', a diff buffer is -pops up, allowing the user to apply each change individually. If -the symbol `summary' or any other non-nil value, the user is -prompted in the minibuffer with aa short summary of changes. The -symbols `maybe-diff' and `maybe-summary' mean that the -confirmation is offered to the user only if the changes target -files visited in buffers. Finally, a nil value means all changes -are applied directly without any confirmation. +If this variable's value is the symbol `diff', a diff buffer pops +up, allowing the user to apply each change individually. If the +symbol `summary' or any other non-nil value, the user is prompted +in the minibuffer with a short summary of changes. The symbols +`maybe-diff' and `maybe-summary' mean that the confirmation is +offered to the user only if the changes target files not visited +in buffers. Finally, a nil value means all changes are applied +directly without any confirmation. -If this variable's value can also be an alist ((COMMAND . ACTION) -...) where COMMAND is a symbol designating a command, such as -`eglot-rename', `eglot-code-actions', -`eglot-code-action-quickfix', etc. ACTION is one of the symbols -described above. The value t for COMMAND is accepted and its -ACTION is the default value for commands not in the alist." +This variable's value can also be an alist ((KEY . ACTION) ...) +where KEY is either a symbol designating the invoked Emacs command +(such as `eglot-rename', `eglot-code-actions', +`eglot-code-action-quickfix', etc.), or a list of file operation +kinds (`create', `rename', `delete') contained in the edit. +ACTION is one of the symbols described above. The value t for +KEY is accepted and its ACTION is the default value for commands +or file operation kinds not in the alist." :type (let ((basic-choices '((const :tag "Use diff" diff) (const :tag "Summarize and prompt" summary) @@ -522,8 +523,9 @@ ACTION is the default value for commands not in the alist." (const :tag "Maybe summarize and prompt" maybe-summary) (const :tag "Don't confirm" nil)))) `(choice ,@basic-choices - (alist :tag "Per-command alist" + (alist :tag "Per-command or per-kind alist" :key-type (choice (function :tag "Command") + (repeat :tag "File operation kinds" symbol) (const :tag "Default" t)) :value-type (choice . ,basic-choices)))) :package-version '(Eglot . "1.17.30")) @@ -4271,14 +4273,25 @@ If SILENT, don't echo progress in mode-line." (when reporter (progress-reporter-done reporter))))) -(defun eglot--confirm-server-edits (origin _prepared) +(defun eglot--confirm-server-edits (origin prepared) "Helper for `eglot--apply-workspace-edit. -ORIGIN is a symbol designating a command. Reads the -`eglot-confirm-server-edits' user option and returns a symbol -like `diff', `summary' or nil." - (let (v) +ORIGIN is a symbol designating a command. PREPARED is a list of +operations to apply. Reads the `eglot-confirm-server-edits' user +option and returns a symbol like `diff', `summary' or nil." + (let (v op-kinds) (cond ((symbolp eglot-confirm-server-edits) eglot-confirm-server-edits) + ;; Check for command-based entry ((setq v (assoc origin eglot-confirm-server-edits)) (cdr v)) + ;; Check for operation-kind-based entry + ((and (setq op-kinds (mapcar #'car prepared)) + (setq v (cl-find-if (lambda (entry) + (and (listp (car entry)) + (cl-some (lambda (kind) + (memq kind (car entry))) + op-kinds))) + eglot-confirm-server-edits))) + (cdr v)) + ;; Default entry ((setq v (assoc t eglot-confirm-server-edits)) (cdr v))))) (defun eglot--propose-changes-as-diff (prepared) From a3ea65a984ff8b27b3698045a682d51ddcf20fbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 15 Jan 2026 10:38:53 +0000 Subject: [PATCH 233/325] Eglot: support more complex workspace edits (create/rename/delete) Advertise support for file resource operations in workspace edits. Implement create, rename, and delete file operations. Rework confirmation UI to handle mixed operation types. * lisp/progmodes/eglot.el (eglot--lsp-interface-alist): Add CreateFile, RenameFile, DeleteFile interfaces. (eglot-client-capabilities): Advertise resourceOperations and failureHandling. (eglot-handle-request): Return failureReason. (eglot--apply-text-edits): Tweak error message. (eglot--propose-changes-as-diff): Adjust for new prepared format. Return buffer. (eglot--apply-workspace-edit): Rework. Handle file operations. * etc/EGLOT-NEWS: Mention change. --- etc/EGLOT-NEWS | 10 ++ lisp/progmodes/eglot.el | 208 ++++++++++++++++++++++++++++++---------- 2 files changed, 170 insertions(+), 48 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 49dd32e51b2..ffe45baad0a 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,16 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes to upcoming Eglot +** Support for complex workspace edits (create/rename/delete files) + +Eglot now advertises support for file resource operations in workspace +edits and can handle create, rename, and delete file operations. The +confirmation UI has been reworked to handle mixed operation types. + +The 'eglot-confirm-server-edits' defcustom has been overhauled and now +also accepts file operation kinds as keys in the alist form, providing +more fine-grained control over what confirmation mechanism to use. + ** 'eglot-advertise-cancellation' now defaults to t The variable 'eglot-advertise-cancellation' now defaults to t, which diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b3f3772f88f..dc30a4e1d34 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -784,7 +784,10 @@ This can be useful when using docker to run a language server.") (HierarchyItem (:name :kind) (:tags :detail :uri :range :selectionRange :data)) (CallHierarchyIncomingCall (:from :fromRanges) ()) - (CallHierarchyOutgoingCall (:to :fromRanges) ())) + (CallHierarchyOutgoingCall (:to :fromRanges) ()) + (CreateFile (:kind :uri) (:options)) + (RenameFile (:kind :oldUri :newUri) (:options)) + (DeleteFile (:kind :uri) (:options))) "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces. INTERFACE-NAME is a symbol designated by the spec as @@ -1066,7 +1069,9 @@ object." :workspace (list :applyEdit t :executeCommand `(:dynamicRegistration :json-false) - :workspaceEdit `(:documentChanges t) + :workspaceEdit `(:documentChanges t + :resourceOperations ["create" "delete" "rename"] + :failureHandling "abort") :didChangeWatchedFiles `(:dynamicRegistration ,(if (eglot--trampish-p s) :json-false t) @@ -2841,7 +2846,8 @@ THINGS are either registrations or unregisterations (sic)." (_server (_method (eql workspace/applyEdit)) &key _label edit) "Handle server request workspace/applyEdit." (condition-case-unless-debug oops - `(:applied ,(eglot--apply-workspace-edit edit last-command)) + (pcase-let ((`(,retval ,reason) (eglot--apply-workspace-edit edit last-command))) + `(:applied ,retval ,@(and reason `(:failureReason ,reason)))) (quit (jsonrpc-error :code 32000 :data @@ -4236,7 +4242,7 @@ Returns a list as described in docstring of `imenu--index-alist'." If SILENT, don't echo progress in mode-line." (unless edits (cl-return-from eglot--apply-text-edits)) (unless (or (not version) (equal version eglot--docver)) - (jsonrpc-error "Edits on `%s' require version %d, you have %d" + (jsonrpc-error "Edits on `%s' require version %d, have %d" (current-buffer) version eglot--docver)) (atomic-change-group (let* ((change-group (prepare-change-group)) @@ -4305,7 +4311,7 @@ list ((FILENAME EDITS VERSION)...)." (target (current-buffer))) (diff-mode) (erase-buffer) - (pcase-dolist (`(,path ,edits ,_) prepared) + (pcase-dolist (`(_ _ _ ,path ,edits ,_) prepared) (with-temp-buffer (let* ((diff (current-buffer)) (existing-buf (find-buffer-visiting path)) @@ -4331,53 +4337,159 @@ list ((FILENAME EDITS VERSION)...)." (buffer-enable-undo (current-buffer)) (goto-char (point-min)) (pop-to-buffer (current-buffer)) - (font-lock-ensure))) + (font-lock-ensure) + (current-buffer))) -(defun eglot--apply-workspace-edit (wedit origin) +(cl-defun eglot--apply-workspace-edit (wedit origin &aux prepared) "Apply (or offer to apply) the workspace edit WEDIT. -ORIGIN is a symbol designating the command that originated this -edit proposed by the server." - (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit - (let ((prepared - (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits) - (eglot--dbind ((VersionedTextDocumentIdentifier) uri version) - textDocument - (list (eglot-uri-to-path uri) edits version))) - documentChanges))) +ORIGIN is a symbol designating the command that originated this edit +proposed by the server. Returns a list (APPLIED REASON) indicating if +the edit was attempted and optionally why not." + ;; JT@2026-01-11: Note to future (self?). Most if this big function + ;; is preparing with the `prepared' (OP ...) list , where each OP is + ;; (KIND DESC APPLY-FN . MORE). KIND is a symbol, DESC is a string. + ;; APPLY-FN is a unary function of OP that applies the change. + ;; Sometimes there is MORE data, such as when KIND is eg. 'text-edit' + ;; and needs extra info for the diff rendering. + (cl-labels + ((pathify (x) (eglot-uri-to-path x)) + (do-create (path &key overwrite ignoreIfExists + &allow-other-keys) + (let ((exists (file-exists-p path))) + (when (and exists (not ignoreIfExists) (not overwrite)) + (eglot--error "File %s already exists" path)) + (when (or (not exists) overwrite) + (let ((dir (file-name-directory path))) + (unless (file-directory-p dir) + (make-directory dir t))) + (write-region "" nil path nil 'nomessage)))) + (do-rename (old-path new-path &key overwrite ignoreIfExists + &allow-other-keys) + (let ((new-exists (file-exists-p new-path))) + (when (and new-exists (not ignoreIfExists) (not overwrite)) + (eglot--error "File %s already exists" new-path)) + (let ((dir (file-name-directory new-path))) + (unless (file-directory-p dir) + (make-directory dir t))) + ;; If the old file is visited, rename the buffer too + (let ((buf (find-buffer-visiting old-path))) + (when buf + (with-current-buffer buf + (set-visited-file-name new-path t t)))) + (rename-file old-path new-path overwrite))) + (do-delete (path &key recursive ignoreIfNotExists &allow-other-keys) + (let ((exists (file-exists-p path))) + (when (and (not exists) (not ignoreIfNotExists)) + (eglot--error "File %s does not exist" path)) + (when exists + ;; Kill buffer if the file is visited + (let ((buf (find-buffer-visiting path))) + (when buf (kill-buffer buf))) + (delete-file path recursive)))) + (text-edit-op (path edits version) + `(text-edit + ,(format "Change %s (%d change%s)" path (length edits) + (if (> (length edits) 1) "s" "")) + ,(lambda (_op) + (with-current-buffer (find-file-noselect path) + (eglot--apply-text-edits edits version))) + ,path ,edits ,version)) + (mkfn (doit-fn &rest things) + (lambda (op) + (apply doit-fn things) + (eglot--message + "%s" (replace-regexp-in-string "^\\([^ ]+\\) " "\\1d " (cadr op))))) + (prepare (ch) + (pcase (plist-get ch :kind) + ("create" + (eglot--dbind ((CreateFile) uri ((:options o))) ch + (let ((p (pathify uri))) + `(create ,(format "Create `%s'" p) ,(mkfn #'do-create p o))))) + ("rename" + (eglot--dbind ((RenameFile) oldUri newUri ((:options o))) ch + (let ((ol (pathify oldUri)) (nw (pathify newUri))) + `(rename ,(format "Rename `%s' to `%s'" ol nw) + ,(mkfn #'do-rename ol nw o))))) + ("delete" + (eglot--dbind ((DeleteFile) uri ((:options o))) ch + (let ((p (pathify uri))) + `(delete ,(format "Delete `%s'" p) ,(mkfn #'do-delete p o))))) + (_ + ;; It's a TextDocumentEdit (no kind field) + (eglot--dbind ((TextDocumentEdit) textDocument edits) ch + (eglot--dbind ((VersionedTextDocumentIdentifier) uri version) + textDocument (text-edit-op (pathify uri) edits version)))))) + (user-accepts-p () + (y-or-n-p + (format "[eglot] Server wants to:\n%s\nProceed? " + (mapconcat (lambda (op) (concat " " (cadr op))) + prepared "\n")))) + (apply-all () + (cl-loop + for op in prepared + for (_kind _desc fn) = op + do (funcall fn op) + finally (eldoc) (eglot--message "Workspace edit successful")) + `(t nil))) + (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit + (setq prepared (mapcar #'prepare documentChanges)) (unless (and changes documentChanges) - ;; We don't want double edits, and some servers send both - ;; changes and documentChanges. This unless ensures that we - ;; prefer documentChanges over changes. + ;; Prefer `documentChanges' over sort-of-deprecated `changes'. (cl-loop for (uri edits) on changes by #'cddr - do (push (list (eglot-uri-to-path uri) edits) prepared))) - (cl-flet ((notevery-visited-p () - (cl-notevery #'find-buffer-visiting - (mapcar #'car prepared))) - (accept-p () - (y-or-n-p - (format "[eglot] Server wants to edit:\n%sProceed? " - (cl-loop - for (f eds _) in prepared - concat (format - " %s (%d change%s)\n" - f (length eds) - (if (> (length eds) 1) "s" "")))))) - (apply () - (cl-loop for edit in prepared - for (path edits version) = edit - do (with-current-buffer (find-file-noselect path) - (eglot--apply-text-edits edits version)) - finally (eldoc) (eglot--message "Edit successful!")))) - (let ((decision (eglot--confirm-server-edits origin prepared))) - (cond - ((or (eq decision 'diff) - (and (eq decision 'maybe-diff) (notevery-visited-p))) - (eglot--propose-changes-as-diff prepared)) - ((or (memq decision '(t summary)) - (and (eq decision 'maybe-summary) (notevery-visited-p))) - (when (accept-p) (apply))) - (t - (apply)))))))) + do (push (text-edit-op (pathify uri) edits nil) prepared))) + (let* ((decision (eglot--confirm-server-edits origin prepared)) + (all-text-edits (cl-loop for (kind . _) in prepared + always (eq kind 'text-edit))) + (peaceful + (and + all-text-edits + (cl-loop for op in prepared + always (find-buffer-visiting (cadddr op)))))) + (cond + ((and (and (memq decision '(maybe-diff maybe-summary)) peaceful)) + (apply-all)) + ((memq decision '(diff maybe-diff)) + (cond (all-text-edits + (pop-to-buffer + (eglot--propose-changes-as-diff prepared)) + `(nil "decision to apply manually")) + (t + ;; `map-y-or-n-p' heroics. Iterate over prepared + ;; operations with individual prompts, showing diffs + ;; for text-edit operations. + (let* ((wconf (current-window-configuration)) + (applied 0) + (total (length prepared))) + (unwind-protect + (progn + (map-y-or-n-p + (lambda (op) + (when (eq (car op) 'text-edit) + (display-buffer + (eglot--propose-changes-as-diff (list op)))) + (format "[eglot] %s? " (cadr op))) + (lambda (op) + (set-window-configuration wconf) + (funcall (caddr op) op) + (cl-incf applied)) + (lambda () + ;; Skip text-edits for files that don't exist + ;; (e.g. user skipped the create operation). + (cl-loop for op = (pop prepared) while op + when (or (not (eq (car op) 'text-edit)) + (file-exists-p (cadddr op))) + return op)) + '("change" "changes" "apply")) + (if (= applied total) + (progn + (eldoc) + (eglot--message "Workspace edit successful") + `(t nil)) + `(nil "decision to abort"))) + (set-window-configuration wconf)))))) + ((memq decision '(t summary maybe-summary)) + (if (user-accepts-p) (apply-all) `(nil "decision to decline"))) + ((apply-all))))))) (cl-defun eglot--rename-interactive (&aux region) (eglot-server-capable-or-lose :renameProvider) From d3548aea9683736ed17ff49f144df6a8a7a8c56f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 16 Jan 2026 00:52:49 +0000 Subject: [PATCH 234/325] Eglot: limit the number of file watches Some language servers request file watching for a very large number of directories (e.g. Python virtualenvs), which can exhaust system resources and cause slow startup. https://github.com/joaotavora/eglot/issues/1568 * lisp/progmodes/eglot.el (eglot-max-file-watches): New variable. (eglot--count-file-watches): New function. (eglot--watch-globs): Use them to limit watches. Signal jsonrpc-error when limit is reached. (eglot-watch-files-outside-project-root): Fix docstring punctuation. * etc/EGLOT-NEWS: Mention change. --- etc/EGLOT-NEWS | 7 +++++++ lisp/progmodes/eglot.el | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 38 insertions(+), 5 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index ffe45baad0a..f050e0bc294 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -20,6 +20,13 @@ https://github.com/joaotavora/eglot/issues/1234. * Changes to upcoming Eglot +** File watch limits to prevent resource exhaustion (github#1568) + +The new variable 'eglot-max-file-watches' limits the number of file +watches that can be created. Some language servers request watching +for a very large number of directories (e.g. Python virtualenvs), which +can exhaust system resources and cause slow startup. + ** Support for complex workspace edits (create/rename/delete files) Eglot now advertises support for file resource operations in workspace diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index dc30a4e1d34..6c10f9a5512 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -4680,11 +4680,28 @@ at point. With prefix argument, prompt for ACTION-KIND." ;;; File watchers (aka didChangeWatchedFiles) ;;; (defvar eglot-watch-files-outside-project-root t - "If non-nil, allow watching files outside project root") + "If non-nil, allow watching files outside project root.") + +(defvar eglot-max-file-watches 10000 + "Maximum number of file watches across all Eglot servers. +If this limit is reached, a warning is issued and further watches +are not added. Set to nil for unlimited watches.") + +(defun eglot--count-file-watches () + "Count total file watches across all Eglot servers." + (let ((count 0)) + (maphash (lambda (_proj servers) + (dolist (server servers) + (maphash (lambda (_id descs) + (cl-incf count (length descs))) + (eglot--file-watches server)))) + eglot--servers-by-project) + count)) (cl-defun eglot--watch-globs (server id globs dir in-root &aux (project (eglot--project server)) - success) + success + (watch-count (eglot--count-file-watches))) "Set up file watching for relative file names matching GLOBS under DIR. GLOBS is a list of (COMPILED-GLOB . KIND) pairs, where COMPILED-GLOB is a compiled glob predicate and KIND is a bitmask of change types. DIR is @@ -4727,9 +4744,18 @@ happens to be inside or matching the project root." (handle-event `(,desc deleted ,file)) (handle-event `(,desc created ,file1)))))) (add-watch (subdir) - (when (file-readable-p subdir) - (push (file-notify-add-watch subdir '(change) #'handle-event) - (gethash id (eglot--file-watches server)))))) + (cond ((not (file-readable-p subdir))) + ((and eglot-max-file-watches + (>= watch-count eglot-max-file-watches)) + (eglot--warn "Reached `eglot-max-file-watches' limit of %d, \ +not watching some directories" eglot-max-file-watches) + ;; Could `(setq success t)' here to keep partial watches. + (jsonrpc-error "Reached `eglot-max-file-watches' limit of %d" + eglot-max-file-watches)) + (t + (push (file-notify-add-watch subdir '(change) #'handle-event) + (gethash id (eglot--file-watches server))) + (cl-incf watch-count))))) (let ((subdirs (if (or (null dir) in-root) (subdirs-using-project) (condition-case _ (subdirs-using-find) From f643ad53c766764270752b782f1d4ce47305dac3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Mon, 19 Jan 2026 23:57:59 +0000 Subject: [PATCH 235/325] Eglot: set imenu-create-index-function without advice See https://github.com/joaotavora/eglot/issues/1569. * lisp/progmodes/eglot.el (eglot--managed-mode): Stomp on imenu-create-index-function conditionally. (eglot-imenu): Don't check eglot-server-capable here. * etc/EGLOT-NEWS: Mention change. --- etc/EGLOT-NEWS | 5 +++++ lisp/progmodes/eglot.el | 8 +++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index f050e0bc294..201d782575f 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -45,6 +45,11 @@ thinks responses to inflight requests are no longer useful. The current 2026 LSP landscape (especially gopls and ocamllsp) suggests this is beneficial and helps servers avoid costly useless work. +** Imenu setup no longer uses advice (github#1569) + +Eglot now sets 'imenu-create-index-function' directly without using +advice, making the integration cleaner and more predictable. + * Changes in Eglot 1.21 (11/1/2026) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 6c10f9a5512..10a58c57989 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2364,9 +2364,9 @@ the previous reports for TOKEN.") (eglot--setq-saving company-tooltip-align-annotations t) (eglot--setq-saving eldoc-documentation-strategy #'eldoc-documentation-compose) - (unless (eglot--stay-out-of-p 'imenu) - (add-function :before-until (local 'imenu-create-index-function) - #'eglot-imenu)) + (unless (or (eglot--stay-out-of-p 'imenu) + (not (eglot-server-capable :documentSymbolProvider))) + (eglot--setq-saving imenu-create-index-function #'eglot-imenu)) (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1)) (unless (eglot--stay-out-of-p 'eldoc) (dolist (f (list #'eglot-signature-eldoc-function @@ -4222,8 +4222,6 @@ for which LSP on-type-formatting should be requested." (cl-defun eglot-imenu () "Eglot's `imenu-create-index-function'. Returns a list as described in docstring of `imenu--index-alist'." - (unless (eglot-server-capable :documentSymbolProvider) - (cl-return-from eglot-imenu)) (let* ((res (eglot--request (eglot--current-server-or-lose) :textDocument/documentSymbol `(:textDocument From 9d8e1af6f41bf11704c00cc5f6fdbc5eb52ed2d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 21 Jan 2026 11:57:38 +0000 Subject: [PATCH 236/325] Eglot: fix textDocument/prepareRename support Can't send prepareRename requests willy-nilly. See https://github.com/joaotavora/eglot/issues/1554. * lisp/progmodes/eglot.el (eglot--rename-interactive): Fix. (eglot-client-capabilities): Advertise "prepareSupport". * etc/EGLOT-NEWS: Mention change. --- etc/EGLOT-NEWS | 5 +++++ lisp/progmodes/eglot.el | 38 +++++++++++++++++++++++--------------- 2 files changed, 28 insertions(+), 15 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 201d782575f..89870c64641 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -50,6 +50,11 @@ beneficial and helps servers avoid costly useless work. Eglot now sets 'imenu-create-index-function' directly without using advice, making the integration cleaner and more predictable. +** Fixed textDocument/prepareRename support (github#1554) + +Eglot now properly checks server capabilities before sending +prepareRename requests. + * Changes in Eglot 1.21 (11/1/2026) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 10a58c57989..b418bfdedc8 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1139,7 +1139,8 @@ object." :isPreferredSupport t) :formatting `(:dynamicRegistration :json-false) :rangeFormatting `(:dynamicRegistration :json-false) - :rename `(:dynamicRegistration :json-false) + :rename `(:dynamicRegistration :json-false + :prepareSupport t) :semanticTokens `(:dynamicRegistration :json-false :requests (:full (:delta t)) :overlappingTokenSupport t @@ -4489,20 +4490,27 @@ the edit was attempted and optionally why not." (if (user-accepts-p) (apply-all) `(nil "decision to decline"))) ((apply-all))))))) -(cl-defun eglot--rename-interactive (&aux region) - (eglot-server-capable-or-lose :renameProvider) - (let* ((probe (eglot--request (eglot--current-server-or-lose) - :textDocument/prepareRename - (eglot--TextDocumentPositionParams))) - (def - (cond ((null probe) (user-error "[eglot] Can't rename here")) - ((plist-get probe :placeholder)) - ((plist-get probe :defaultBehavior) (thing-at-point 'symbol t)) - ((setq region (eglot-range-region probe)) - (buffer-substring-no-properties (car region) (cdr region)))))) - (list (read-from-minibuffer - (format "Rename `%s' to: " (or def "unknown symbol")) - nil nil nil nil def)))) +(cl-defun eglot--rename-interactive + (&aux + def region + (rename-support (eglot-server-capable-or-lose :renameProvider)) + (prepare-support (and (listp rename-support) + (plist-get rename-support :prepareProvider)))) + (setq + def + (cond (prepare-support + (let ((x (eglot--request (eglot--current-server-or-lose) + :textDocument/prepareRename + (eglot--TextDocumentPositionParams)))) + (cond ((null x) (user-error "[eglot] Can't rename here")) + ((plist-get x :placeholder)) + ((plist-get x :defaultBehavior) (thing-at-point 'symbol t)) + ((setq region (eglot-range-region x)) + (buffer-substring-no-properties (car region) (cdr region)))))) + (t (thing-at-point 'symbol t)))) + (list (read-from-minibuffer + (format "Rename `%s' to: " (or def "unknown symbol")) + nil nil nil nil def))) (defun eglot-rename (newname) "Rename the current symbol to NEWNAME." From fe2469c1c139e85742cf56dc2a9b6eaf7aad36a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Wed, 21 Jan 2026 15:36:52 +0100 Subject: [PATCH 237/325] ; * test/lisp/net/dbus-tests.el: hush warnings on no-dbus platforms --- test/lisp/net/dbus-tests.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index b34ce3381c7..fa7f8000c75 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -28,6 +28,10 @@ (defvar dbus-debug) (defvar dbus-message-type-signal) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) +(declare-function dbus-close-inhibitor-lock "dbusbind.c" (lock)) +(declare-function dbus-registered-inhibitor-locks' "dbusbind.c" ()) +(declare-function dbus-make-inhibitor-lock' "dbusbind.c" + (what why &optional block)) (defconst dbus--test-enabled-session-bus (and (featurep 'dbusbind) From d4dbce74a7bbd1e7c0a3ef7cc7600a5627e26ad6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 21 Jan 2026 17:37:33 +0200 Subject: [PATCH 238/325] Fix updating buffer menu after invoking "M-x term" The doc string of 'frame-or-buffer-changed-p' says not to call it with the nil argument, but term.el did. Since "M-x term" puts 'term--update-term-menu' on the 'menu-bar-update-hook' ahead of 'menu-bar-update-buffers', it caused the latter decide that there was no change in buffers, because the internal state variable used by 'frame-or-buffer-changed-p' when called with the nil argument was reset by 'term--update-term-menu'. Fix that by using a non-nil state variable. * lisp/term.el (term--buffers-changed): New variable. (term--update-term-menu): Use it when calling 'frame-or-buffer-changed-p'. (Bug#80231) --- lisp/term.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/term.el b/lisp/term.el index 34b3450624c..9ac77730350 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1009,9 +1009,11 @@ For custom keybindings purposes please note there is also ["Paging" term-pager-toggle :style toggle :selected term-pager-count :help "Toggle paging feature"])) +(defvar term--buffers-changed nil) + (defun term--update-term-menu (&optional force) (when (and (lookup-key term-mode-map [menu-bar terminal]) - (or force (frame-or-buffer-changed-p))) + (or force (frame-or-buffer-changed-p 'term--buffers-changed))) (let ((buffer-list (match-buffers '(derived-mode . term-mode)))) (easy-menu-change nil From 8ea6f6da7739adb054871da80a073672f6c706d7 Mon Sep 17 00:00:00 2001 From: Binbin Ye Date: Tue, 13 Jan 2026 22:40:24 +0900 Subject: [PATCH 239/325] Add JSON path utility command to json-ts-mode * lisp/progmodes/json-ts-mode.el (json-ts--get-path-at-node) (json-ts--path-to-jq, json-ts--path-to-python): New functions. (json-ts-jq-path-at-point): New command for getting JSON path at point. * test/lisp/progmodes/json-ts-mode-tests.el: New file. Add tests for the utility command. * etc/NEWS: Announce new command 'json-ts-jq-path-at-point' (bug#80190). --- etc/NEWS | 6 ++ lisp/progmodes/json-ts-mode.el | 54 ++++++++++++++ test/lisp/progmodes/json-ts-mode-tests.el | 86 +++++++++++++++++++++++ 3 files changed, 146 insertions(+) create mode 100644 test/lisp/progmodes/json-ts-mode-tests.el diff --git a/etc/NEWS b/etc/NEWS index 32b5ff02cc1..25641b45a4b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1329,6 +1329,12 @@ available. Now method chaining is indented by 8 spaces rather than 4, and this option controls how much is indented for method chaining. +** JSON-ts mode + +*** New command 'json-ts-jq-path-at-point'. +This command copies the path of the JSON element at point to the +kill-ring, formatted for use with the 'jq' utility. + ** PHP-ts mode --- diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el index 0f9f4f4f6a7..cd4cb468095 100644 --- a/lisp/progmodes/json-ts-mode.el +++ b/lisp/progmodes/json-ts-mode.el @@ -128,6 +128,60 @@ Return nil if there is no name or if NODE is not a defun node." t) "\"" "\"")))) +(defun json-ts--get-path-at-node (node) + "Get the path from the root of the JSON tree to NODE. +Return a list of keys (strings) and indices (numbers). +NODE is a tree-sitter node." + (let ((path nil) + (parent nil)) + (while (setq parent (treesit-node-parent node)) + (let ((type (treesit-node-type parent))) + (cond + ((equal type "array") + (push (treesit-node-index node t) path)) + ((equal type "pair") + (let ((key (treesit-node-child-by-field-name parent "key"))) + (push (treesit-node-text key t) path))))) + (setq node parent)) + path)) + +(defun json-ts--path-to-jq (path) + "Convert PATH list to a jq-style path string. +PATH is a list of keys (strings) and indices (numbers)." + (mapconcat + (lambda (x) + (cond + ((numberp x) (format "[%d]" x)) + ((stringp x) + (let ((key (string-trim x "\"" "\""))) + (if (string-match-p (rx bos (any alpha "_") (* (any alnum "_")) eos) key) + (format ".%s" key) + (format "[%S]" key)))) + (t ""))) + path + "")) + +(defun json-ts--path-to-python (path) + "Convert PATH list to a Python-style path string. +PATH is a list of keys (strings) and indices (numbers)." + (mapconcat + (lambda (x) + (cond + ((numberp x) (format "[%d]" x)) + ((stringp x) (format "[\"%s\"]" x)) + (t ""))) + path + "")) + +(defun json-ts-jq-path-at-point () + "Show the JSON path at point in jq format." + (interactive) + (if-let* ((node (treesit-node-at (point)))) + (let ((path (json-ts--path-to-jq (json-ts--get-path-at-node node)))) + (kill-new path) + (message "%s" path)) + (user-error "No JSON node at point"))) + ;;;###autoload (define-derived-mode json-ts-mode prog-mode "JSON" "Major mode for editing JSON, powered by tree-sitter." diff --git a/test/lisp/progmodes/json-ts-mode-tests.el b/test/lisp/progmodes/json-ts-mode-tests.el new file mode 100644 index 00000000000..4fe4582f2f1 --- /dev/null +++ b/test/lisp/progmodes/json-ts-mode-tests.el @@ -0,0 +1,86 @@ +;;; json-ts-mode-tests.el --- Tests for json-ts-mode.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 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 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: + +;; Tests for json-ts-mode. + +;;; Code: + +(require 'ert) +(require 'treesit) +(require 'json-ts-mode) + +(ert-deftest json-ts-mode-test-path-at-point () + "Test `json-ts--get-path-at-node' and `json-ts--path-to-jq'." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (json-ts-mode) + (insert "{\"a\": [1, {\"b\": 2}, 3]}") + + ;; Point at '1' (index 0 of array 'a') + (goto-char (point-min)) + (search-forward "1") + (backward-char) + (should (equal (json-ts--path-to-jq (json-ts--get-path-at-node (treesit-node-at (point)))) + ".a[0]")) + + ;; Point at '2' (key 'b' inside object at index 1) + (goto-char (point-min)) + (search-forward "2") + (backward-char) + (should (equal (json-ts--path-to-jq (json-ts--get-path-at-node (treesit-node-at (point)))) + ".a[1].b")) + + ;; Point at '3' (index 2 of array 'a') + (goto-char (point-min)) + (search-forward "3") + (backward-char) + (should (equal (json-ts--path-to-jq (json-ts--get-path-at-node (treesit-node-at (point)))) + ".a[2]")))) + +(ert-deftest json-ts-mode-test-path-at-point-complex-keys () + "Test path generation with complex keys." + (skip-unless (treesit-language-available-p 'json)) + (with-temp-buffer + (json-ts-mode) + (insert "{\"key.with.dot\": {\"key with space\": 1}}") + + (goto-char (point-min)) + (search-forward "1") + (backward-char) + (should (equal (json-ts--path-to-jq (json-ts--get-path-at-node (treesit-node-at (point)))) + "[\"key.with.dot\"][\"key with space\"]")))) + +(ert-deftest json-ts-mode-test-jq-path-keys () + "Test `json-ts--path-to-jq' with various key formats." + (should (equal (json-ts--path-to-jq '("v123")) ".v123")) + (should (equal (json-ts--path-to-jq '("-123")) "[\"-123\"]")) + (should (equal (json-ts--path-to-jq '("v_v")) ".v_v")) + (should (equal (json-ts--path-to-jq '("123")) "[\"123\"]")) + (should (equal (json-ts--path-to-jq '("_123")) "._123")) + (should (equal (json-ts--path-to-jq '("1v2")) "[\"1v2\"]"))) + +(ert-deftest json-ts-mode-test-path-to-python () + "Test `json-ts--path-to-python'." + (should (equal (json-ts--path-to-python '("a" 0 "b")) + "[\"a\"][0][\"b\"]"))) + +(provide 'json-ts-mode-tests) +;;; json-ts-mode-tests.el ends here From 15d3cc3f65e8ea3bc1e1a4c766f439bcad012150 Mon Sep 17 00:00:00 2001 From: Vincenzo Pupillo Date: Thu, 15 Jan 2026 21:16:52 +0100 Subject: [PATCH 240/325] Flymake support for yaml-ts-mode. * etc/NEWS: Announce the new customization option (bug#80215). * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode): New customization group. (yaml-ts-mode-yamllint-options): New customization option. (yaml-ts-mode--flymake-process): New variable that stores the reference to the flymake process. (yaml-ts-mode-flymake): New function that implements support for Flymake. --- etc/NEWS | 7 +++ lisp/textmodes/yaml-ts-mode.el | 85 ++++++++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 25641b45a4b..2cb1978738e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1386,6 +1386,13 @@ associated to a remote PHP file, show the remote PHP ini files. Rust number literals may have an optional type suffix. When this option is non-nil, this suffix is fontified using 'font-lock-type-face'. +** YAML-ts mode + +--- +*** New user option 'yaml-ts-mode-yamllint-options'. +Additional options for 'yamllint' the command used for Flymake's YAML +support. + ** EIEIO --- diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index 32e3ea0212a..a3dad2f85e0 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -41,6 +41,17 @@ :commit "b733d3f5f5005890f324333dd57e1f0badec5c87") t) +(defgroup yaml-ts-mode nil + "Major mode for editing YAML files." + :prefix "yaml-ts-mode-" + :group 'languages) + +(defcustom yaml-ts-mode-yamllint-options nil + "Additional options to pass to the yamllint command, which is used for Flymake support." + :group 'yaml-ts-mode + :version "31.1" + :type 'string) + (defvar yaml-ts-mode--syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?# "<" table) @@ -175,6 +186,77 @@ Return nil if there is no name or if NODE is not a defun node." (when (string-match-p yaml-ts-mode--outline-nodes (treesit-node-type node)) (not (treesit-node-top-level node yaml-ts-mode--outline-nodes)))) +;;; Flymake integration +(defvar-local yaml-ts-mode--flymake-process nil + "Store the Flymake process.") + +(defun yaml-ts-mode-flymake (report-fn &rest _args) + "YAML backend for Flymake. +Calls REPORT-FN directly." + (when (process-live-p yaml-ts-mode--flymake-process) + (kill-process yaml-ts-mode--flymake-process)) + (let ((yamllint (executable-find "yamllint")) + (params (if yaml-ts-mode-yamllint-options + (append (split-string yaml-ts-mode-yamllint-options) '("-f" "parsable" "-")) + '("-f" "parsable" "-"))) + + (source (current-buffer)) + (diagnostics-pattern (eval-when-compile + (rx bol (+? nonl) ":" ; every diagnostic line start with the filename + (group (1+ digit)) ":" ; 1: line + (group (1+ digit)) ":" ; 2: column + (+ (syntax whitespace)) + (group (or "[error]" "[warning]")) ; 3: type + (+ (syntax whitespace)) + (group (+? nonl)) ;; 4: message + eol)))) + + (if (not yamllint) + (error "Unable to find yamllint command") + (save-restriction + (widen) + (setq yaml-ts-mode--flymake-process + (make-process + :name "yaml-ts-mode-flymake" + :noquery t + :connection-type 'pipe + :buffer (generate-new-buffer " *yaml-ts-mode-flymake*") + :command `(,yamllint ,@params) + :sentinel + (lambda (proc _event) + (when (eq 'exit (process-status proc)) + (unwind-protect + (if (with-current-buffer source + (eq proc yaml-ts-mode--flymake-process)) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (let (diags) + (while (search-forward-regexp + diagnostics-pattern + nil t) + (let* ((beg + (car (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))))) + (end + (cdr (flymake-diag-region + source + (string-to-number (match-string 1)) + (string-to-number (match-string 2))))) + (msg (match-string 4)) + (type (if (string= "[warning]" (match-string 3)) + :warning + :error))) + (push (flymake-make-diagnostic + source beg end type msg) + diags)) + (funcall report-fn diags)))) + (flymake-log :warning "Canceling obsolete check %s" proc)) + (kill-buffer (process-buffer proc))))))) + (process-send-region yaml-ts-mode--flymake-process (point-min) (point-max)) + (process-send-eof yaml-ts-mode--flymake-process))))) + ;;;###autoload (define-derived-mode yaml-ts-mode text-mode "YAML" "Major mode for editing YAML, powered by tree-sitter." @@ -215,6 +297,9 @@ Return nil if there is no name or if NODE is not a defun node." ;; Outline minor mode. (setq-local treesit-outline-predicate #'yaml-ts-mode--outline-predicate) + ;; Flymake + (add-hook 'flymake-diagnostic-functions #'yaml-ts-mode-flymake nil 'local) + (treesit-major-mode-setup) (setq-local hs-treesit-things "block_mapping_pair") From 8063921808c85b9041beeccd9995003bd17bcb11 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 21 Jan 2026 20:02:56 +0200 Subject: [PATCH 241/325] Fix down-list navigation in python-ts-mode * lisp/progmodes/python.el (python-ts-mode): Set 'treesit-sexp-thing-down-list' to 'list' to override sexp navigation with list navigation (bug#72478). * lisp/emacs-lisp/lisp.el (up-list): Mention 'up-list-function' in docstring. --- lisp/emacs-lisp/lisp.el | 2 ++ lisp/progmodes/python.el | 3 ++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 797f40ca1ba..5cbd4213028 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -250,6 +250,8 @@ defined by the current language mode. With ARG, do this that many times. A negative argument means move backward but still to a less deep spot. +Calls `up-list-function' to do the work, if that is non-nil. + If ESCAPE-STRINGS is non-nil (as it is interactively), move out of enclosing strings as well. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 848a26229e6..b6981c9156c 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -7485,7 +7485,8 @@ implementations: `python-mode' and `python-ts-mode'." (treesit-major-mode-setup) ;; Enable the `sexp' navigation by default (setq-local forward-sexp-function #'treesit-forward-sexp - treesit-sexp-thing 'sexp) + treesit-sexp-thing 'sexp + treesit-sexp-thing-down-list 'list) (when (>= emacs-major-version 31) (setq-local hs-treesit-things '(or defun sexp)) From 41c0d254d509aa41b6620bc5127e9f022afd2ed4 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Wed, 21 Jan 2026 20:08:14 +0200 Subject: [PATCH 242/325] ; * lisp/textmodes/yaml-ts-mode.el: Fix docstring wider than 80 characters. --- lisp/textmodes/yaml-ts-mode.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index a3dad2f85e0..f221a16abdb 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -47,7 +47,7 @@ :group 'languages) (defcustom yaml-ts-mode-yamllint-options nil - "Additional options to pass to the yamllint command, which is used for Flymake support." + "Additional options to pass to yamllint command used for Flymake support." :group 'yaml-ts-mode :version "31.1" :type 'string) From 10b132006ecd7b11d0f20beca061120b4217341c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 21 Jan 2026 18:40:06 +0000 Subject: [PATCH 243/325] Eglot: display more readable server-originated messages * lisp/progmodes/eglot.el (eglot--format-server-message): New helper. (eglot-handle-notification) (eglot-handle-request): Use it. --- lisp/progmodes/eglot.el | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b418bfdedc8..b6bdcd79aee 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -1940,6 +1940,14 @@ in project `%s'." "Message out with FORMAT with ARGS." (message "[eglot] %s" (apply #'eglot--format format args))) +(defun eglot--format-server-message (_server type format &rest args) + "Format SERVER-originated message with FORMAT with ARGS. +TYPE is a number indicating the message severity." + (concat + (propertize "[eglot] " + 'face (if (or (not type) (<= type 1)) 'error)) + (apply #'eglot--format format args))) + (defun eglot--warn (format &rest args) "Warning message with FORMAT and ARGS." (apply #'eglot--message (concat "(warning) " format) args) @@ -2751,24 +2759,19 @@ still unanswered LSP requests to the server\n")))) (jsonrpc-error "Unknown request method `%s'" method))) (cl-defmethod eglot-handle-notification - (_server (_method (eql window/showMessage)) &key type message) + (server (_method (eql window/showMessage)) &key type message) "Handle notification window/showMessage." - (eglot--message (propertize "Server reports (type=%s): %s" - 'face (if (<= type 1) 'error)) - type message)) + (message (eglot--format-server-message server type message))) (cl-defmethod eglot-handle-request - (_server (_method (eql window/showMessageRequest)) + (server (_method (eql window/showMessageRequest)) &key type message actions &allow-other-keys) "Handle server request window/showMessageRequest. ACTIONS is a list of MessageActionItem, this has the user choose one and return it back to the server. :null is returned if the list was empty." (let* ((actions (mapcar (lambda (a) (cons (plist-get a :title) a)) actions)) (label (completing-read - (concat - (propertize "[eglot]" - 'face (if (or (not type) (<= type 1)) 'error)) - " " message) + (eglot--format-server-message server type message) (or (mapcar #'car actions) '("OK")) nil t))) (if (and actions label) (cdr (assoc label actions)) :null))) From f2250ba24400c71040fbfb6e9c2f90b1f87dbb59 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Wed, 21 Jan 2026 23:01:00 +0000 Subject: [PATCH 244/325] Eglot: simplify Imenu setup again See https://github.com/joaotavora/eglot/issues/1569. * lisp/progmodes/eglot.el (eglot--managed-mode): Tweak. * etc/EGLOT-NEWS: Tweak. --- etc/EGLOT-NEWS | 6 +++--- lisp/progmodes/eglot.el | 3 ++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/etc/EGLOT-NEWS b/etc/EGLOT-NEWS index 89870c64641..20c2208c54c 100644 --- a/etc/EGLOT-NEWS +++ b/etc/EGLOT-NEWS @@ -45,10 +45,10 @@ thinks responses to inflight requests are no longer useful. The current 2026 LSP landscape (especially gopls and ocamllsp) suggests this is beneficial and helps servers avoid costly useless work. -** Imenu setup no longer uses advice (github#1569) +** Imenu setup is more predictable (github#1569) -Eglot now sets 'imenu-create-index-function' directly without using -advice, making the integration cleaner and more predictable. +Eglot now sets 'imenu-create-index-function' using ':override' advice, +making the integration cleaner and more predictable. ** Fixed textDocument/prepareRename support (github#1554) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index b6bdcd79aee..80099a26ee8 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2375,7 +2375,8 @@ the previous reports for TOKEN.") #'eldoc-documentation-compose) (unless (or (eglot--stay-out-of-p 'imenu) (not (eglot-server-capable :documentSymbolProvider))) - (eglot--setq-saving imenu-create-index-function #'eglot-imenu)) + (add-function :override (local 'imenu-create-index-function) + #'eglot-imenu)) (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1)) (unless (eglot--stay-out-of-p 'eldoc) (dolist (f (list #'eglot-signature-eldoc-function From a0197aef96e091b2bb4e317669a8ad5c9108f269 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Jan 2026 09:37:14 +0200 Subject: [PATCH 245/325] Restrict the 'buffer' arg of 'goto-line' only to interactive uses * lisp/simple.el (goto-line): Use 'buffer' arg only when 'interactive' is non-nil (bug#80150). Update docstring. --- lisp/simple.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 774dab254c3..2a59437406f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1644,9 +1644,8 @@ If called interactively, a numeric prefix argument specifies LINE; without a numeric prefix argument, read LINE from the minibuffer. -If optional argument BUFFER is non-nil, switch to that buffer and -move to line LINE there. If called interactively with \\[universal-argument] -as argument, BUFFER is the most recently selected other buffer. +If called interactively with \\[universal-argument], switch to the +most recently selected other buffer and move to line LINE there. If optional argument RELATIVE is non-nil, counting starts at the beginning of the accessible portion of the (potentially narrowed) buffer. @@ -1659,7 +1658,8 @@ Prior to moving point, this function sets the mark (without activating it), unless Transient Mark mode is enabled and the mark is already active. -A non-nil INTERACTIVE argument means to push the mark. +A non-nil INTERACTIVE argument pushes the mark and switches the buffer +if optional argument BUFFER is non-nil. This function is usually the wrong thing to use in a Lisp program. What you probably want instead is something like: @@ -1669,7 +1669,7 @@ If at all possible, an even better solution is to use char counts rather than line counts." (interactive (append (goto-line-read-args) '(nil t))) ;; Switch to the desired buffer, one way or another. - (if buffer + (if (and buffer interactive) (let ((window (get-buffer-window buffer))) (if window (select-window window) (switch-to-buffer-other-window buffer)))) From 2696eff451e6b42edddca66c807c320cb89aee35 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 22 Jan 2026 09:58:37 +0100 Subject: [PATCH 246/325] ; * test/lisp/net/dbus-tests.el: Fix typos. --- test/lisp/net/dbus-tests.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index fa7f8000c75..53ce1929cad 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -29,8 +29,8 @@ (defvar dbus-message-type-signal) (declare-function dbus-get-unique-name "dbusbind.c" (bus)) (declare-function dbus-close-inhibitor-lock "dbusbind.c" (lock)) -(declare-function dbus-registered-inhibitor-locks' "dbusbind.c" ()) -(declare-function dbus-make-inhibitor-lock' "dbusbind.c" +(declare-function dbus-registered-inhibitor-locks "dbusbind.c" ()) +(declare-function dbus-make-inhibitor-lock "dbusbind.c" (what why &optional block)) (defconst dbus--test-enabled-session-bus From 45089f9588e1fccda16fd4a69a618695453c8d88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Mon, 19 Jan 2026 12:02:12 +0100 Subject: [PATCH 247/325] * lisp/emacs-lisp/macroexp.el (macroexp--expand-all): Speed up. Manicure pcase patterns to avoid performance-sapping internal functions and switch-breaking gaps, resulting in smaller code and less allocation. --- lisp/emacs-lisp/macroexp.el | 181 ++++++++++++++++++++---------------- 1 file changed, 99 insertions(+), 82 deletions(-) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index dcb519b33b5..d9ca6f0b19a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -469,16 +469,23 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp-warn-and-return (format-message "`condition-case' without handlers") exp-body (list 'suspicious 'condition-case) t form)))) - (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) - (push name macroexp--dynvars) - (macroexp--all-forms form 2)) - (`(function ,(and f `(lambda . ,_))) - (let ((macroexp--dynvars macroexp--dynvars)) - (macroexp--cons fn - (macroexp--cons (macroexp--all-forms f 2) - nil - (cdr form)) - form))) + (`(,(or 'defvar 'defconst) . ,args) + (if (and (car-safe args) (symbolp (car-safe args))) + (progn + (push (car args) macroexp--dynvars) + (macroexp--all-forms form 2)) + form)) + (`(function . ,rest) + (if (and (eq (car-safe (car-safe rest)) 'lambda) + (null (cdr rest))) + (let ((f (car rest))) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons fn + (macroexp--cons (macroexp--all-forms f 2) + nil + (cdr form)) + form))) + form)) (`(,(or 'function 'quote) . ,_) form) (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) pcase--dontcare)) @@ -495,82 +502,88 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexp--all-forms body)) (cdr form)) form))) - (`(while) - (macroexp-warn-and-return - (format-message "missing `while' condition") - `(signal 'wrong-number-of-arguments '(while 0)) - nil 'compile-only form)) - (`(unwind-protect ,expr) - (macroexp-warn-and-return - (format-message "`unwind-protect' without unwind forms") - (macroexp--expand-all expr) - (list 'suspicious 'unwind-protect) t form)) - (`(setq ,(and var (pred symbolp) - (pred (not booleanp)) (pred (not keywordp))) - ,expr) - ;; Fast path for the setq common case. - (let ((new-expr (macroexp--expand-all expr))) - (if (eq new-expr expr) - form - `(,fn ,var ,new-expr)))) + (`(while . ,args) + (if args + (macroexp--all-forms form 1) + (macroexp-warn-and-return + (format-message "missing `while' condition") + `(signal 'wrong-number-of-arguments '(while 0)) + nil 'compile-only form))) + (`(unwind-protect . ,args) + (if (cdr-safe args) + (macroexp--all-forms form 1) + (macroexp-warn-and-return + (format-message "`unwind-protect' without unwind forms") + (macroexp--expand-all (car-safe args)) + (list 'suspicious 'unwind-protect) t form))) (`(setq . ,args) - ;; Normalize to a sequence of (setq SYM EXPR). - ;; Malformed code is translated to code that signals an error - ;; at run time. - (let ((nargs (length args))) - (if (oddp nargs) - (macroexp-warn-and-return - (format-message "odd number of arguments in `setq' form") - `(signal 'wrong-number-of-arguments '(setq ,nargs)) - nil 'compile-only fn) - (let ((assignments nil)) - (while (consp (cdr-safe args)) - (let* ((var (car args)) - (expr (cadr args)) - (new-expr (macroexp--expand-all expr)) - (assignment - (if (and (symbolp var) - (not (booleanp var)) (not (keywordp var))) - `(,fn ,var ,new-expr) - (macroexp-warn-and-return - (format-message "attempt to set %s `%s'" - (if (symbolp var) - "constant" - "non-variable") - var) - (cond - ((keywordp var) - ;; Accept `(setq :a :a)' for compatibility. - `(if (eq ,var ,new-expr) - ,var - (signal 'setting-constant (list ',var)))) - ((symbolp var) - `(signal 'setting-constant (list ',var))) - (t - `(signal 'wrong-type-argument - (list 'symbolp ',var)))) - nil 'compile-only var)))) - (push assignment assignments)) - (setq args (cddr args))) - (cons 'progn (nreverse assignments)))))) - (`(,(and fun `(lambda . ,_)) . ,args) - (macroexp--cons (macroexp--all-forms fun 2) - (macroexp--all-forms args) - form)) + (let ((nargs (length args)) + (var (car-safe args))) + (if (and (= nargs 2) + (symbolp var) + (not (booleanp var)) (not (keywordp var))) + ;; Fast path for the common case. + (let* ((expr (nth 1 args)) + (new-expr (macroexp--expand-all expr))) + (if (eq new-expr expr) + form + `(,fn ,var ,new-expr))) + ;; Normalize to a sequence of (setq SYM EXPR). + ;; Malformed code is translated to code that signals an error + ;; at run time. + (if (oddp nargs) + (macroexp-warn-and-return + (format-message "odd number of arguments in `setq' form") + `(signal 'wrong-number-of-arguments '(setq ,nargs)) + nil 'compile-only fn) + (let ((assignments nil)) + (while (consp (cdr-safe args)) + (let* ((var (car args)) + (expr (cadr args)) + (new-expr (macroexp--expand-all expr)) + (assignment + (if (and (symbolp var) + (not (booleanp var)) + (not (keywordp var))) + `(,fn ,var ,new-expr) + (macroexp-warn-and-return + (format-message "attempt to set %s `%s'" + (if (symbolp var) + "constant" + "non-variable") + var) + (cond + ((keywordp var) + ;; Accept `(setq :a :a)' for compatibility. + ;; FIXME: Why, exactly? It's useless. + `(if (eq ,var ,new-expr) + ,var + (signal 'setting-constant (list ',var)))) + ((symbolp var) + `(signal 'setting-constant (list ',var))) + (t + `(signal 'wrong-type-argument + (list 'symbolp ',var)))) + nil 'compile-only var)))) + (push assignment assignments)) + (setq args (cddr args))) + (cons 'progn (nreverse assignments))))))) (`(funcall ,exp . ,args) (let ((eexp (macroexp--expand-all exp)) (eargs (macroexp--all-forms args))) - (pcase eexp - ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' - ;; has a compiler-macro, or to unfold it. - ((and `#',f - (guard (and (symbolp f) - ;; bug#46636 - (not (or (special-form-p f) (macrop f)))))) - (macroexp--expand-all `(,f . ,eargs))) - (`#'(lambda . ,_) - (macroexp--unfold-lambda `(,fn ,eexp . ,eargs))) - (_ `(,fn ,eexp . ,eargs))))) + (if (eq (car-safe eexp) 'function) + (let ((f (cadr eexp))) + (cond + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro, or to unfold it. + ((and (symbolp f) + ;; bug#46636 + (not (or (special-form-p f) (macrop f)))) + (macroexp--expand-all `(,f . ,eargs))) + ((eq (car-safe f) 'lambda) + (macroexp--unfold-lambda `(,fn ,eexp . ,eargs))) + (t `(,fn ,eexp . ,eargs)))) + `(,fn ,eexp . ,eargs)))) (`(funcall . ,_) form) ;bug#53227 (`(,(and func (pred symbolp)) . ,_) (let ((handler (function-get func 'compiler-macro))) @@ -597,6 +610,10 @@ Assumes the caller has bound `macroexpand-all-environment'." newform (macroexp--expand-all form))) (macroexp--expand-all newform)))))) + (`(,(and fun `(lambda . ,_)) . ,args) + (macroexp--cons (macroexp--all-forms fun 2) + (macroexp--all-forms args) + form)) (_ form)))))) ;;;###autoload From 5290b5dddb9903b2e8010fe63564a31f208d209d Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 22 Jan 2026 14:52:12 +0200 Subject: [PATCH 248/325] ; Fix :type of 'yaml-ts-mode-yamllint-options' * lisp/textmodes/yaml-ts-mode.el (yaml-ts-mode-yamllint-options): Fix :type and doc string. --- lisp/textmodes/yaml-ts-mode.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el index f221a16abdb..948186b5a9a 100644 --- a/lisp/textmodes/yaml-ts-mode.el +++ b/lisp/textmodes/yaml-ts-mode.el @@ -47,10 +47,13 @@ :group 'languages) (defcustom yaml-ts-mode-yamllint-options nil - "Additional options to pass to yamllint command used for Flymake support." + "Additional options to pass to yamllint command used for Flymake support. +If non-nil, this should be a single string with command-line options +for the yamllint command, with individual options separated by whitespace." :group 'yaml-ts-mode :version "31.1" - :type 'string) + :type '(choice (const :tag "None" nil) + (string :tag "Options as a single string"))) (defvar yaml-ts-mode--syntax-table (let ((table (make-syntax-table))) From 7b9d3e90ce32e2e19f0b4725868f9a6f76346ae6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 22 Jan 2026 19:36:54 +0200 Subject: [PATCH 249/325] Fix MS-Windows build broken by recent updates in MinGW64 headers * nt/inc/ms-w32.h (strerror): Redirect to sys_strerror after including , to prevent the linker from thinking it should be imported from some DLL. Reported by Richard Copley . * src/w32.c: Remove now unneeded prototype of sys_strerror. --- nt/inc/ms-w32.h | 8 +++++++- src/w32.c | 4 ---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index fc853959b49..1e2af4a424e 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -227,7 +227,6 @@ extern void w32_reset_stack_overflow_guard (void); #define select sys_select #define pselect sys_select #define sleep sys_sleep -#define strerror sys_strerror #undef unlink #define unlink sys_unlink #undef opendir @@ -268,6 +267,13 @@ extern int sys_umask (int); #define cmputc sys_cmputc #define Wcm_clear sys_Wcm_clear +/* MinGW64 system headers include string.h too early, causing the + compiler to emit a warning about sys_strerror having no + prototype, or the linker fail to link. */ +#include +#define strerror sys_strerror +char *sys_strerror (int); + #endif /* emacs */ /* Used both in Emacs, in lib-src, and in Gnulib. */ diff --git a/src/w32.c b/src/w32.c index 7edc31d0a8a..c2262b441cd 100644 --- a/src/w32.c +++ b/src/w32.c @@ -84,10 +84,6 @@ int sys_dup2 (int, int); int sys_read (int, char *, unsigned int); int sys_write (int, const void *, unsigned int); struct tm *sys_localtime (const time_t *); -/* MinGW64 system headers include string.h too early, causing the - compiler to emit a warning about sys_strerror having no - prototype. */ -char *sys_strerror (int); clock_t sys_clock (void); #ifdef HAVE_MODULES From 8ccab6bf06fc0c4428f368bead2561dd945dc705 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 22 Jan 2026 12:58:53 -0500 Subject: [PATCH 250/325] lisp/simple.el (goto-line): Minor optimization --- lisp/simple.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/simple.el b/lisp/simple.el index 2a59437406f..53f11e4eeee 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1669,12 +1669,12 @@ If at all possible, an even better solution is to use char counts rather than line counts." (interactive (append (goto-line-read-args) '(nil t))) ;; Switch to the desired buffer, one way or another. - (if (and buffer interactive) + (when interactive + (when buffer (let ((window (get-buffer-window buffer))) (if window (select-window window) (switch-to-buffer-other-window buffer)))) - ;; Leave mark at previous position - (when interactive + ;; Leave mark at previous position (or (region-active-p) (push-mark))) ;; Move to the specified line number in that buffer. (let ((pos (save-restriction @@ -1695,8 +1695,8 @@ rather than line counts." (defun goto-line-relative (line &optional buffer interactive) "Go to LINE, counting from line at (point-min). The line number is relative to the accessible portion of the narrowed -buffer. The argument BUFFER is the same as in the function `goto-line'. -A non-nil INTERACTIVE argument means to push the mark." +buffer. The arguments BUFFER and INTERACTIVE are the same as in the +function `goto-line'." (interactive (append (goto-line-read-args t) t)) (goto-line line buffer t interactive)) From b4a5948d3330f7ca02c61075eed94b467645ea83 Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Thu, 22 Jan 2026 20:09:47 +0200 Subject: [PATCH 251/325] ; Remove "--" from the name of autoloaded 'window--get-split-combination' * lisp/window-x.el (window-get-split-combination, split-frame): * lisp/tab-bar.el (tab-bar-split-tab): Rename 'window--get-split-combination' to 'window-get-split-combination'. --- lisp/tab-bar.el | 2 +- lisp/window-x.el | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index e40171f27a5..4cc090bca94 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -1992,7 +1992,7 @@ include TAB's selected window and delete those windows from TAB." (user-error "ARG %s exceeds number of windows %s that can be split off" (abs arg) (1- total-window-count))) (t - (let* ((comb (window--get-split-combination main arg)) + (let* ((comb (window-get-split-combination main arg)) (ws (window-state-get comb))) (delete-window comb) (tab-bar-new-tab) diff --git a/lisp/window-x.el b/lisp/window-x.el index a5740fc5d25..4197d5a0a26 100644 --- a/lisp/window-x.el +++ b/lisp/window-x.el @@ -341,7 +341,7 @@ FRAME1." frame1)) ;;;###autoload -(defun window--get-split-combination (window arg) +(defun window-get-split-combination (window arg) "Return window combination suitable for `split-frame'. WINDOW is the main window in which the combination should be derived. @@ -417,7 +417,7 @@ absolute value of ARG. Return the new frame." (user-error "ARG %s exceeds number of windows %s that can be split off" (abs arg) (1- total-window-count))) (t - (let ((comb (window--get-split-combination main arg))) + (let ((comb (window-get-split-combination main arg))) (window-state-put (window-state-get comb) (window-main-window (make-frame))) (delete-window comb)) From 644caa944d9d4f56120b33e4072975553b4370ca Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 23 Jan 2026 13:40:31 +0000 Subject: [PATCH 252/325] ; Autoload pixel-scroll-interpolate- commands. It is useful to bind these to [remap scroll-up-command] and [remap scroll-down-command] even if you don't want to enable pixel-scroll-precision-mode because of how it sets make-cursor-line-fully-visible. --- lisp/pixel-scroll.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index b20af40091a..dbb532f691b 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -820,6 +820,7 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." (end-of-buffer (message (error-message-string '(end-of-buffer))))))))) +;;;###autoload (defun pixel-scroll-interpolate-down () "Interpolate a scroll downwards by one page." (interactive) @@ -832,6 +833,7 @@ It is a vector of the form [ VELOCITY TIME SIGN ]." nil 1) (cua-scroll-up))) +;;;###autoload (defun pixel-scroll-interpolate-up () "Interpolate a scroll upwards by one page." (interactive) @@ -850,6 +852,8 @@ precisely, according to the turning of the mouse wheel." :keymap pixel-scroll-precision-mode-map (setq mwheel-coalesce-scroll-events (not pixel-scroll-precision-mode)) + ;; This works around some issues described in bug#65214. + ;; Ideally this would not be needed because it breaks some other things. (setq-default make-cursor-line-fully-visible (not pixel-scroll-precision-mode))) From 29bdba37f2ac3a912d15d2b65169cfb312707da2 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 23 Jan 2026 14:11:27 +0000 Subject: [PATCH 253/325] New bindings for vc-revert * lisp/vc/vc-dir.el (vc-dir-mode-map): Bind vc-revert to '@'. * lisp/vc/vc-hooks.el (vc-prefix-map): Additionally bind vc-revert to 'C-x v @'. * doc/emacs/maintaining.texi (VC Undo, VC Directory Commands): * etc/NEWS: Document the change. --- doc/emacs/maintaining.texi | 32 +++++++++++++++++++------------- etc/NEWS | 9 ++++++++- lisp/vc/vc-dir.el | 1 + lisp/vc/vc-hooks.el | 3 ++- 4 files changed, 30 insertions(+), 15 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 0c6e5c820e7..f1090d4b43f 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1360,6 +1360,7 @@ also prompt for a specific VCS shell command to run for this purpose. @table @kbd @item C-x v u +@item C-x v @@ Revert the work file(s) in the current VC fileset to the last revision (@code{vc-revert}). @@ -1374,24 +1375,25 @@ Delete an unpushed commit from the revision history. @end table @kindex C-x v u +@kindex C-x v @@ @findex vc-revert @vindex vc-revert-show-diff - If you want to discard all the changes you have made to the current -VC fileset, type @kbd{C-x v u} (@code{vc-revert}). This will ask you -for confirmation before discarding the changes. If you agree, the -fileset is reverted. + If you want to discard all the changes you have made to the current VC +fileset, type @kbd{C-x v u} or @kbd{C-x v @@} (@code{vc-revert}). This +will ask you for confirmation before discarding the changes. If you +agree, the fileset is reverted. If @code{vc-revert-show-diff} is non-@code{nil}, this command will -show you a diff between the work file(s) and the revision from which -you started editing. Afterwards, the diff buffer will either be -killed (if this variable is @code{kill}), or the buffer will be buried -(any other non-@code{nil} value). If you don't want @kbd{C-x v u} to -show a diff, set this variable to @code{nil} (you can still view the -diff directly with @kbd{C-x v =}; @pxref{Old Revisions}). +show you a diff between the work file(s) and the revision from which you +started editing. Afterwards, the diff buffer will either be killed (if +this variable is @code{kill}), or the buffer will be buried (any other +non-@code{nil} value). If you don't want @code{vc-revert} to show you +diffs, set this variable to @code{nil} (you can still view the diff +directly with @kbd{C-x v =}; @pxref{Old Revisions}). - On locking-based version control systems, @kbd{C-x v u} leaves files -unlocked; you must lock again to resume editing. You can also use -@kbd{C-x v u} to unlock a file if you lock it and then decide not to + On locking-based version control systems, @code{vc-revert} leaves +files unlocked; you must lock again to resume editing. You can also use +@code{vc-revert} to unlock a file if you lock it and then decide not to change it. @findex vc-revert-or-delete-revision @@ -1641,6 +1643,10 @@ ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it will append this file to the @file{.gitignore} file. If given a prefix, do this with all the marked files. +@item @@ +Discard all the changes you have made to the current fileset +(@code{vc-revert}). + @item q Quit the VC Directory buffer, and bury it (@code{quit-window}). diff --git a/etc/NEWS b/etc/NEWS index 2cb1978738e..594c0d45322 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2599,8 +2599,15 @@ cloning, or prompts for that, too. When the argument is non-nil, the function switches to a buffer visiting the directory into which the repository was cloned. ++++ +*** 'vc-revert' is now bound to '@' in VC-Dir. + ++++ +*** 'vc-revert' is now additionally bound to 'C-x v @'. +This is in addition to 'C-x v u'. + --- -*** 'C-x v u' ('vc-revert') now works on directories listed in VC Directory. +*** 'vc-revert' now works on directories listed in VC Directory. Reverting a directory means reverting changes to all files inside it. +++ diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 1c6b6a4cba4..303cfd93ba2 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -396,6 +396,7 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and (define-key map (kbd "M-s a C-s") #'vc-dir-isearch) (define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp) (define-key map "G" #'vc-dir-ignore) + (define-key map "@" #'vc-revert) (let ((branch-map (make-sparse-keymap))) (define-key map "b" branch-map) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 2e342c19919..e867654409c 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1023,7 +1023,8 @@ In the latter case, VC mode is deactivated for this buffer." "m" #'vc-merge "r" #'vc-retrieve-tag "s" #'vc-create-tag - "u" #'vc-revert + "u" #'vc-revert ; The traditional binding. + "@" #'vc-revert ; Following VC-Dir's binding. "v" #'vc-next-action "+" #'vc-update "P" #'vc-push From cd8c85c4fd01bd62fc4fb064b58f67c7086618ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Jan 2026 14:34:28 +0100 Subject: [PATCH 254/325] * test/Makefile.in (SLOW_TESTS): add package-vc-tests (bug#80235) --- test/Makefile.in | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Makefile.in b/test/Makefile.in index e3a589fe24e..0d26303a637 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -200,7 +200,8 @@ EXCLUDE_TESTS = ## To speed up parallel builds, put these slow test files (which can ## take longer than all the rest combined) at the start of the list. -SLOW_TESTS = ${srcdir}/lisp/net/tramp-tests.el +SLOW_TESTS = ${srcdir}/lisp/emacs-lisp/package-vc-tests.el \ + ${srcdir}/lisp/net/tramp-tests.el ELFILES := $(sort $(shell find ${srcdir} -name manual -prune -o \ -name data -prune -o -name infra -prune -o \ From 3b547e4f5dc99dc157b52a059cf234f7a5d15112 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 22 Jan 2026 15:32:13 +0100 Subject: [PATCH 255/325] * lisp/emacs-lisp/pcase.el (pcase--macroexpand): Normalise atom etc. Transform (pred P) for P in {atom, nlistp, identity, not} into predicates that pcase already understands in type terms. This doesn't affect the behaviour but generates better code. --- lisp/emacs-lisp/pcase.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 33d39ecd423..61b8f283bd2 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -523,7 +523,17 @@ how many time this CODEGEN is called." (cond ((null head) (if (pcase--self-quoting-p pat) `',pat pat)) - ((memq head '(pred guard quote)) pat) + ((memq head '(guard quote)) pat) + ((eq head 'pred) + ;; Ad-hoc expansion of some predicates that are the complement of another. + ;; Not required for correctness but results in better code. + (let* ((expr (cadr pat)) + (compl (assq expr '((atom . consp) + (nlistp . listp) + (identity . null))))) + (cond (compl `(,head (not ,(cdr compl)))) + ((eq expr 'not) `(,head null)) ; normalise + (t pat)))) ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat)))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t From b7d4681908ff1615501e4b83a4e44c61928a8a9b Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 24 Jan 2026 06:45:00 +0200 Subject: [PATCH 256/325] Stop project-query-replace-regexp failing on directory symlinks * lisp/progmodes/project.el (project--files-safe): New function. (project-search, project-query-replace-regexp): Use it (bug#78209). --- lisp/progmodes/project.el | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index bea41c55760..b9b2f84a824 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -177,9 +177,9 @@ (require 'cl-generic) (require 'cl-lib) (require 'seq) +(require 'generator) (eval-when-compile (require 'subr-x)) - -(defgroup project nil + (defgroup project nil "Operations on the current project." :version "28.1" :group 'tools) @@ -1593,6 +1593,11 @@ create it if it doesn't already exist." (declare-function fileloop-continue "fileloop" ()) +(iter-defun project--files-safe () + (dolist (file (project-files (project-current t))) + (when (file-regular-p file) + (iter-yield file)))) + ;;;###autoload (defun project-search (regexp) "Search for REGEXP in all the files of the project. @@ -1602,7 +1607,7 @@ command \\[fileloop-continue]." (interactive "sSearch (regexp): ") (fileloop-initialize-search regexp - (project-files (project-current t)) + (project--files-safe) 'default) (fileloop-continue)) @@ -1623,7 +1628,7 @@ If you exit the `query-replace', you can later continue the (list from to)))) (fileloop-initialize-replace from to - (project-files (project-current t)) + (project--files-safe) 'default) (fileloop-continue)) From 3573116d3ebf20697ead49f4b12e206b530211ba Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 24 Jan 2026 06:48:29 +0200 Subject: [PATCH 257/325] ; Fix indentation in project.el --- lisp/progmodes/project.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index b9b2f84a824..35840024326 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -179,7 +179,8 @@ (require 'seq) (require 'generator) (eval-when-compile (require 'subr-x)) - (defgroup project nil + +(defgroup project nil "Operations on the current project." :version "28.1" :group 'tools) From 6762394734f960db014099b405776c8e42fda8aa Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 24 Jan 2026 09:07:46 +0100 Subject: [PATCH 258/325] Improve handling of not-parallel test runs * test/Makefile.in: Distinguish between parallel and not-parallel tests. Mark lisp/autorevert-tests.log, lisp/filenotify-tests.log and lisp/net/tramp-tests.log to run not-parrallel. (Bug#80164) * test/README: Some of the tests do not run parallel when expensive tests are activated. * test/infra/gitlab-ci.yml (.job-template): Use "make -j". Makefile knows how to handle parallel runs properly. --- test/Makefile.in | 16 +++++++++++++--- test/README | 7 ++++++- test/infra/gitlab-ci.yml | 5 +++-- 3 files changed, 22 insertions(+), 6 deletions(-) diff --git a/test/Makefile.in b/test/Makefile.in index 0d26303a637..21f31f4c2d0 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -219,8 +219,13 @@ LOGFILES := $(patsubst %.el,%.log, \ TESTS := $(LOGFILES:.log=) ## Some tests show problems when run in parallel with other tests. -## Suppress parallelism for them. -.NOTPARALLEL: lisp/filenotify-tests.log lisp/net/tramp-tests.log +## Suppress parallelism for them when SELECTOR is equal to +## SELECTOR_EXPENSIVE or SELECTOR_ALL. +PARALLEL_TESTS := $(LOGFILES) +ifeq ($(subst $(SELECTOR_ALL),yes,$(subst $(SELECTOR_EXPENSIVE),yes,$(SELECTOR_ACTUAL))), yes) +$(eval NOT_PARALLEL_TESTS := $(filter lisp/autorevert-tests.log lisp/filenotify-tests.log lisp/net/tramp-tests.log, $(LOGFILES))) +$(eval PARALLEL_TESTS := $(filter-out $(NOT_PARALLEL_TESTS), ${LOGFILES})) +endif ## If we have to interrupt a hanging test, preserve the log so we can ## see what the problem was. @@ -352,7 +357,12 @@ ifeq ($(TEST_INTERACTIVE), yes) $(patsubst %,-l %,$(if $(findstring $(TEST_LOAD_EL),yes),$ELFILES,$(ELFILES:.el=))) \ $(TEST_RUN_ERT) else - -@${MAKE} -k ${LOGFILES} +ifdef NOT_PARALLEL_TESTS + -@${MAKE} -k -j1 ${NOT_PARALLEL_TESTS} +endif +ifdef PARALLEL_TESTS + -@${MAKE} -k ${PARALLEL_TESTS} +endif @$(emacs) --batch -l ert --eval \ "(ert-summarize-tests-batch-and-exit ${SUMMARIZE_TESTS})" ${LOGFILES} endif diff --git a/test/README b/test/README index a287ae69734..fa48b690347 100644 --- a/test/README +++ b/test/README @@ -35,7 +35,9 @@ test" instead. Running several tests in parallel could result in unexpected side effects with ephemeral test errors. Therefore, it is recommend not to -use "make -j". +use "make -j". Nonetheless, when expensive tests are activated, some of +the tests do not run parallel anyway. See make variable +$NOT_PARALLEL_TESTS. The Makefile sets the environment variable $EMACS_TEST_DIRECTORY, which points to this directory. This environment variable does not @@ -97,6 +99,9 @@ use it directly: make SELECTOR='test-foo-remote' +Setting $SELECTOR in combination with the check-expensive or check-all +make targets is ignored. + Note that although the test files are always compiled (unless they set no-byte-compile), the source files will be run when expensive or unstable tests are involved, to give nicer backtraces. To run the diff --git a/test/infra/gitlab-ci.yml b/test/infra/gitlab-ci.yml index 23af677d186..1f0f33bbe86 100644 --- a/test/infra/gitlab-ci.yml +++ b/test/infra/gitlab-ci.yml @@ -90,6 +90,7 @@ default: -e EMACS_TEST_JUNIT_REPORT=${EMACS_TEST_JUNIT_REPORT} -e EMACS_TEST_TIMEOUT=${EMACS_TEST_TIMEOUT} -e EMACS_TEST_VERBOSE=${EMACS_TEST_VERBOSE} + -e NPROC=`nproc` -e http_proxy=${http_proxy} -e https_proxy=${https_proxy} -e no_proxy=${no_proxy} @@ -103,8 +104,8 @@ default: git diff --name-only FETCH_HEAD && ( git diff --name-only FETCH_HEAD | xargs git checkout -f FETCH_HEAD ) && - make && - make -k ${make_params}"' + make -j \$NPROC && + make -k -j \$NPROC ${make_params}"' after_script: # - docker ps -a # - pwd; printenv From 17c78c992041b5a250e1f44019a3f47d447acc85 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Sat, 24 Jan 2026 10:15:29 +0100 Subject: [PATCH 259/325] ; Tramp code cleanup * lisp/net/tramp-cache.el (tramp-cache-unload-hook): * lisp/net/tramp-cmds.el (tramp-enable-method, tramp-bug): * lisp/net/tramp-compat.el: * test/lisp/net/tramp-tests.el (tramp-test26-interactive-file-name-completion): Simplify retrieving proper function symbols. --- lisp/net/tramp-cache.el | 10 +++------- lisp/net/tramp-cmds.el | 5 ++--- lisp/net/tramp-compat.el | 4 ++-- test/lisp/net/tramp-tests.el | 2 +- 4 files changed, 8 insertions(+), 13 deletions(-) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index bb9179630cb..1fc3fb3aeae 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -202,11 +202,6 @@ Return DEFAULT if not set." (set var (1+ val)))) value))) -(add-hook 'tramp-cache-unload-hook - (lambda () - (dolist (var (all-completions "tramp-cache-get-count-" obarray)) - (unintern var obarray)))) - ;;;###tramp-autoload (defun tramp-set-file-property (key file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of KEY. @@ -229,8 +224,9 @@ Return VALUE." (add-hook 'tramp-cache-unload-hook (lambda () - (dolist (var (all-completions "tramp-cache-set-count-" obarray)) - (unintern var obarray)))) + (dolist (var (apropos-internal + (rx bos "tramp-cache-" (| "get" "set") "-count-"))) + (unintern var nil)))) ;;;###tramp-autoload (defun tramp-file-property-p (key file property) diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 84c1c7ea7f4..95e1c5ecad8 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -78,8 +78,7 @@ SYNTAX can be one of the symbols `default' (default), ((not (assoc method tramp-methods)))) method)) ;; All method enabling functions. - (mapcar - #'intern (all-completions "tramp-enable-" obarray #'functionp)))))) + (apropos-internal (rx bos "tramp-enable-") #'functionp))))) (when-let* (((not (assoc method tramp-methods))) (fn (intern (format "tramp-enable-%s-method" method))) @@ -839,7 +838,7 @@ This is needed if there are compatibility problems." (and x (boundp x) (not (get x 'tramp-suppress-trace)) (cons x 'tramp-reporter-dump-variable))) (append - (mapcar #'intern (all-completions "tramp-" obarray #'boundp)) + (apropos-internal (rx bos "tramp-") #'boundp) ;; Non-Tramp variables of interest. '(shell-prompt-pattern backup-by-copying diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index c9a728e2be1..f975457d4df 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -229,8 +229,8 @@ value is the default binding of the variable." (cdr result) ,variable))))) -(dolist (elt (all-completions "tramp-compat-" obarray #'functionp)) - (function-put (intern elt) 'tramp-suppress-trace t)) +(dolist (elt (apropos-internal (rx bos "tramp-compat-") #'functionp)) + (function-put elt 'tramp-suppress-trace t)) (add-hook 'tramp-unload-hook (lambda () diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7391eb56058..20e76e5fe9b 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -5060,7 +5060,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (dolist (elt (append - (mapcar #'intern (all-completions "tramp-" obarray #'functionp)) + (apropos-internal (rx bos "tramp-") #'functionp) '(completion-file-name-table read-file-name))) (unless (get elt 'tramp-suppress-trace) (trace-function-background elt)))) From 0ca00d9a98d64e1672cd7b34d074a211d7c8d75c Mon Sep 17 00:00:00 2001 From: Josh Berdine Date: Sun, 30 Nov 2025 17:07:45 +0000 Subject: [PATCH 260/325] Use math symbols instead of CJK punctuation in TeX input method This seems more appropriate given the context, and additionally the CJK symbols often render wider, as a full width CJK glyph, while the math symbols render narrower. There was some related discussion in bug#12948, where an analogous change was made for \langle and \rangle. * lisp/leim/quail/latin-ltx.el (latin-ltx--define-rules): Change rules for \llbracket, \rrbracket and \ldata, \rdata to generate Unicode code points in the Miscellaneous Mathematical Symbols-A block (U+27E6, U+27E7 and U+27EA, U+27EB) instead of the CJK Symbols and Punctuation block (U+301A, U+301B and U+300A , U+300B). Copyright-paperwork-exempt: yes --- lisp/leim/quail/latin-ltx.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index bbcadb9c611..2356ce3a244 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -787,12 +787,12 @@ system, including many technical ones. Examples: ("\\sqrt" ?√) ("\\sqrt[3]" ?∛) ("\\sqrt[4]" ?∜) - ("\\llbracket" ?\〚) ; stmaryrd - ("\\rrbracket" ?\〛) + ("\\llbracket" ?\⟦) ; stmaryrd + ("\\rrbracket" ?\⟧) ;; ("\\lbag" ?\〚) ; fuzz ;; ("\\rbag" ?\〛) - ("\\ldata" ?\《) ; fuzz/zed - ("\\rdata" ?\》) + ("\\ldata" ?\⟪) ; fuzz/zed + ("\\rdata" ?\⟫) ;; From Karl Eichwalder. ("\\glq" ?‚) ("\\grq" ?‘) From b1f7d6254a647a0dc9662320e9e2363aaeb7a028 Mon Sep 17 00:00:00 2001 From: "Leo C. Stein" Date: Sun, 12 Oct 2025 21:51:06 -0500 Subject: [PATCH 261/325] Add some missing LaTeX macros to TeX input method * lisp/leim/quail/latin-ltx.el (latin-ltx--define-rules): Add standard TeX names that were missing; some already had other aliases. Add a few other non-systematic additions. --- lisp/leim/quail/latin-ltx.el | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 2356ce3a244..c40b395a639 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -281,6 +281,7 @@ system, including many technical ones. Examples: ("\\Vert" ?‖) ("\\Vvdash" ?⊪) ("\\above" ?┴) + ("\\acute" ?́) ;; synonymous with \'‌ ("\\aleph" ?ℵ) ("\\amalg" ?∐) ("\\angle" ?∠) @@ -297,6 +298,7 @@ system, including many technical ones. Examples: ("\\backsim" ?∽) ("\\backsimeq" ?⋍) ("\\backslash" ?\\) + ("\\bar" ?̄) ;; synonymous with \= ("\\barwedge" ?⊼) ("\\because" ?∵) ("\\begin" ?\〖) @@ -328,11 +330,14 @@ system, including many technical ones. Examples: ("\\boxplus" ?⊞) ("\\boxtimes" ?⊠) ("\\bra" ?\⟨) + ("\\breve" ?̆) ;; synonymous with \u ("\\bullet" ?•) ("\\bumpeq" ?≏) ("\\cap" ?∩) + ("\\cbrt" ?∛) ("\\cdots" ?⋯) ("\\centerdot" ?·) + ("\\check" ?̌) ;; synonymous with \v ("\\checkmark" ?✓) ("\\chi" ?χ) ("\\circ" ?∘) @@ -370,10 +375,12 @@ system, including many technical ones. Examples: ("\\ddagger" ?‡) ("\\ddddot" ?⃜) ("\\dddot" ?⃛) + ("\\ddot" ?̈) ;; synonymous with \" ("\\ddots" ?⋱) ("\\diamond" ?⋄) ("\\diamondsuit" ?♢) ("\\divideontimes" ?⋇) + ("\\dot" ?̇) ("\\doteq" ?≐) ("\\doteqdot" ?≑) ("\\dotplus" ?∔) @@ -397,13 +404,17 @@ system, including many technical ones. Examples: ("\\fallingdotseq" ?≒) ("\\flat" ?♭) ("\\forall" ?∀) + ("\\frac03" ?↉) ("\\frac1" ?⅟) + ("\\frac110" ?⅒) ("\\frac12" ?½) ("\\frac13" ?⅓) ("\\frac14" ?¼) ("\\frac15" ?⅕) ("\\frac16" ?⅙) + ("\\frac17" ?⅐) ("\\frac18" ?⅛) + ("\\frac19" ?⅑) ("\\frac23" ?⅔) ("\\frac25" ?⅖) ("\\frac34" ?¾) @@ -426,6 +437,7 @@ system, including many technical ones. Examples: ("\\gneq" ?≩) ("\\gneqq" ?≩) ("\\gnsim" ?⋧) + ("\\grave" ?̀) ;; synonymous with \` ("\\gtrapprox" ?≳) ("\\gtrdot" ?⋗) ("\\gtreqless" ?⋛) @@ -433,6 +445,7 @@ system, including many technical ones. Examples: ("\\gtrless" ?≷) ("\\gtrsim" ?≳) ("\\gvertneqq" ?≩) + ("\\hat" ?̂) ;; synonymous with \^ ("\\hbar" ?ℏ) ("\\heartsuit" ?♥) ("\\hookleftarrow" ?↩) @@ -451,6 +464,8 @@ system, including many technical ones. Examples: ("\\intercal" ?⊺) ("\\jj" ?ⅉ) ("\\jmath" ?ȷ) + ("\\ket" ?\⟩) + ("\\land" ?∧) ;; logical and, same symbol as \wedge ("\\langle" ?⟨) ;; Was ?〈, see bug#12948. ("\\lbrace" ?{) ("\\lbrack" ?\[) @@ -480,11 +495,13 @@ system, including many technical ones. Examples: ("\\lessgtr" ?≶) ("\\lesssim" ?≲) ("\\lfloor" ?⌊) + ("\\lgroup" ?\⟮) ("\\lhd" ?◁) ("\\rhd" ?▷) ("\\ll" ?≪) ("\\llcorner" ?⌞) ("\\lll" ?⋘) + ("\\lmoustache" ?⎰) ("\\lnapprox" ?⋦) ("\\lneq" ?≨) ("\\lneqq" ?≨) @@ -495,6 +512,7 @@ system, including many technical ones. Examples: ("\\longrightarrow" ?⟶) ("\\looparrowleft" ?↫) ("\\looparrowright" ?↬) + ("\\lor" ?∨) ;; logical or, same symbol as \vee ("\\lozenge" ?✧) ("\\lq" ?‘) ("\\lrcorner" ?⌟) @@ -502,6 +520,7 @@ system, including many technical ones. Examples: ("\\lvertneqq" ?≨) ("\\maltese" ?✠) ("\\mapsto" ?↦) + ("\\mathring" ?̊) ("\\measuredangle" ?∡) ("\\mho" ?℧) ("\\mid" ?∣) @@ -569,8 +588,12 @@ system, including many technical ones. Examples: ("\\oplus" ?⊕) ("\\oslash" ?⊘) ("\\otimes" ?⊗) + ("\\overbar" ?̅) ("\\overbrace" ?⏞) + ("\\overleftarrow" ?⃖) ("\\overparen" ?⏜) + ("\\overrightarrow" ?⃗) ;; synonymous with \vec + ("\\owns" ?∋) ;; synonymous with \ni ("\\par" ?
) ("\\parallel" ?∥) ("\\partial" ?∂) @@ -611,6 +634,8 @@ system, including many technical ones. Examples: ("\\rightrightarrows" ?⇉) ("\\rightthreetimes" ?⋌) ("\\risingdotseq" ?≓) + ("\\rgroup" ?\⟯) + ("\\rmoustache" ?⎱) ("\\rrect" ?▢) ("\\sdiv" ?⁄) ("\\rtimes" ?⋊) @@ -662,6 +687,7 @@ system, including many technical ones. Examples: ("\\therefore" ?∴) ("\\thickapprox" ?≈) ("\\thicksim" ?∼) + ("\\tilde" ?̃) ;; synonymous with \~ ("\\to" ?→) ("\\top" ?⊤) ("\\triangle" ?▵) @@ -678,6 +704,8 @@ system, including many technical ones. Examples: ("\\updownarrow" ?↕) ("\\underbar" ?▁) ("\\underbrace" ?⏟) + ("\\underleftarrow" ?⃮) + ("\\underrightarrow" ?⃯) ("\\underparen" ?⏝) ("\\upleftharpoon" ?↿) ("\\uplus" ?⊎) @@ -686,6 +714,7 @@ system, including many technical ones. Examples: ("\\urcorner" ?⌝) ("\\u{i}" ?ĭ) ("\\vbar" ?│) + ("\\vec" ?⃗) ("\\vDash" ?⊨) ((lambda (name char) @@ -772,6 +801,7 @@ system, including many technical ones. Examples: ;; ("\\Yinyang" ?☯) ;; ("\\Heart" ?♡) ("\\dh" ?ð) + ("\\eth" ?ð) ("\\DH" ?Ð) ("\\th" ?þ) ("\\TH" ?Þ) From 4de7ddc837848a80ff8eae1ac99e518b53b3f0e1 Mon Sep 17 00:00:00 2001 From: "Leo C. Stein" Date: Mon, 13 Oct 2025 22:38:39 -0500 Subject: [PATCH 262/325] Add unicode's mathematical alphabets to TeX input method * lisp/leim/quail/latin-ltx.el: Add math "alphabets" that can be matched with simple regexps; a few others are added by hand. There are 13 variants: bf, it, bfit, bb, scr, bfscr, frak, bffrak, sf, bfsf, sfit, bfsfit, and tt. --- lisp/leim/quail/latin-ltx.el | 87 ++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index c40b395a639..cd7b24fccdc 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -66,6 +66,22 @@ system, including many technical ones. Examples: (defun latin-ltx--ascii-p (char) (and (characterp char) (< char 128))) + ;; For mathematical alphabets + (defconst latin-ltx--math-variant-prefix-map + '(("BOLD" . "bf") + ("ITALIC" . "it") + ("BOLD ITALIC" . "bfit") + ("DOUBLE-STRUCK" . "bb") + ("SCRIPT" . "scr") + ("BOLD SCRIPT" . "bfscr") + ("FRAKTUR" . "frak") + ("BOLD FRAKTUR" . "bffrak") + ("SANS-SERIF" . "sf") + ("SANS-SERIF BOLD" . "bfsf") + ("SANS-SERIF ITALIC" . "sfit") + ("SANS-SERIF BOLD ITALIC" . "bfsfit") + ("MONOSPACE" . "tt"))) + (defmacro latin-ltx--define-rules (&rest rules) (load "uni-name" nil t) (let ((newrules ())) @@ -742,6 +758,77 @@ system, including many technical ones. Examples: ("\\wp" ?℘) ("\\wr" ?≀) + ;;;; Mathematical alphabets + ;; Latin letters + ((lambda (name _char) + (let* ((variant (match-string 1 name)) + (prefix (cdr (assoc variant latin-ltx--math-variant-prefix-map))) + (basename (match-string 3 name)) + (name (if (match-end 2) (capitalize basename) (downcase basename)))) + (concat "\\" prefix name))) + "\\`MATHEMATICAL \\(.+\\) \\(?:SMALL\\|CAPITA\\(L\\)\\) \\([[:ascii:]]+\\)\\'") + + ;; Digits + ((lambda (name _char) + (let* ((variant (match-string 1 name)) + (prefix (cdr (assoc variant latin-ltx--math-variant-prefix-map))) + (basename (match-string 2 name))) + (concat "\\" prefix (char-to-string (char-from-name basename))))) + "\\`MATHEMATICAL \\(.+\\) \\(DIGIT [[:ascii:]]+\\)\\'") + + ;; Some Greek variants + ;; NOTE: Check if any of these are reversed from their counterparts, like + ;; the claim above of \phi and \varphi being swapped + ((lambda (name _char) + (let* ((variant (match-string 1 name)) + (prefix (cdr (assoc variant latin-ltx--math-variant-prefix-map))) + (basename (downcase (match-string 2 name)))) + (if prefix ;; This avoids e.g. MATHEMATICAL BOLD CAPITAL SYMBOL + (concat "\\" prefix "var" basename)))) + "\\`MATHEMATICAL \\(.+\\) \\([A-Z]+\\) SYMBOL\\'") + + ((lambda (name _char) + (let* ((variant (match-string 1 name)) + (prefix (cdr (assoc variant latin-ltx--math-variant-prefix-map))) + (basename (if (match-end 2) "partial" "nabla"))) + (concat "\\" prefix basename))) + "\\`MATHEMATICAL \\(.*\\) \\(?:NABLA\\|PARTIAL DIFFERENTIA\\(L\\)\\)\\'") + + ;; Some of the math alphabet characters have other canonical names and must be + ;; added manually + ("\\scrB" ?ℬ) + ("\\scrE" ?ℰ) + ("\\scrF" ?ℱ) + ("\\scrH" ?ℋ) + ("\\scrI" ?ℐ) + ("\\scrL" ?ℒ) + ("\\scrM" ?ℳ) + ("\\scrR" ?ℛ) + ("\\frakC" ?ℭ) + ("\\frakH" ?ℌ) + ("\\frakI" ?ℑ) + ("\\frakR" ?ℜ) + ("\\frakZ" ?ℨ) + ("\\bbC" ?ℂ) + ("\\bbH" ?ℍ) + ("\\bbN" ?ℕ) + ("\\bbP" ?ℙ) + ("\\bbQ" ?ℚ) + ("\\bbR" ?ℝ) + ("\\bbZ" ?ℤ) + ("\\ith" ?ℎ) + ("\\scre" ?ℯ) + ("\\scrg" ?ℊ) + ("\\scro" ?ℴ) + + ("\\bbsum" ?⅀) + ("\\bbSigma" ?⅀) + ("\\bbgamma" ?ℽ) + ("\\bbGamma" ?ℾ) + ("\\bbprod" ?ℿ) + ("\\bbPi" ?ℿ) + ("\\bbpi" ?ℼ) + ("\\Bbb{A}" ?𝔸) ; AMS commands for blackboard bold ("\\Bbb{B}" ?𝔹) ; Also sometimes \mathbb. ("\\Bbb{C}" ?ℂ) From 11d26dccde6ea335b559cd95693d39bd70a65380 Mon Sep 17 00:00:00 2001 From: "Leo C. Stein" Date: Wed, 19 Nov 2025 10:15:15 -0600 Subject: [PATCH 263/325] Add a few missing mathematical brackets to TeX input method * lisp/leim/quail/latin-ltx.el: Add a few more left/right brackets, especially the ones whose names in ucs-names start with MATHEMATICAL. The macro names are taken from unimath-symbols.pdf, available at http://mirrors.ctan.org/macros/unicodetex/latex/unicode-math/unimath-symbols.pdf --- lisp/leim/quail/latin-ltx.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index cd7b24fccdc..356db627818 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -393,6 +393,8 @@ system, including many technical ones. Examples: ("\\dddot" ?⃛) ("\\ddot" ?̈) ;; synonymous with \" ("\\ddots" ?⋱) + ("\\diagdown" ?⟍) + ("\\diagup" ?⟋) ("\\diamond" ?⋄) ("\\diamondsuit" ?♢) ("\\divideontimes" ?⋇) @@ -483,8 +485,13 @@ system, including many technical ones. Examples: ("\\ket" ?\⟩) ("\\land" ?∧) ;; logical and, same symbol as \wedge ("\\langle" ?⟨) ;; Was ?〈, see bug#12948. + ("\\lAngle" ?\⟪) ("\\lbrace" ?{) ("\\lbrack" ?\[) + ("\\lBrack" ?\⟦) + ("\\lblkbrbrak" ?\⦗) + ("\\lbrbrak" ?\❲) + ("\\Lbrbrak" ?\⟬) ("\\lceil" ?⌈) ("\\ldiv" ?∕) ("\\ldots" ?…) @@ -633,9 +640,14 @@ system, including many technical ones. Examples: ("\\qed" ?∎) ("\\quad" ? ) ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948. + ("\\rAngle" ?\⟫) ("\\ratio" ?∶) ("\\rbrace" ?}) ("\\rbrack" ?\]) + ("\\rBrack" ?\⟧) + ("\\rblkbrbrak" ?\⦘) + ("\\rbrbrak" ?\❳) + ("\\Rbrbrak" ?\⟭) ("\\rceil" ?⌉) ("\\rddots" ?⋰) ("\\rect" ?▭) From 92072c887f405d9faaa19c0589585763f01bc912 Mon Sep 17 00:00:00 2001 From: "Leo C. Stein" Date: Wed, 19 Nov 2025 10:16:47 -0600 Subject: [PATCH 264/325] Backslashify all open/close punctuation so we don't confuse indenter * lisp/leim/quail/latin-ltx.el: Quote characters with general-category Ps and Pe (Punctuation, Open and Punctuation, Close) with backslash, otherwise lisp indentation code gets confused. --- lisp/leim/quail/latin-ltx.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 356db627818..8b2e0999f77 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -484,15 +484,15 @@ system, including many technical ones. Examples: ("\\jmath" ?ȷ) ("\\ket" ?\⟩) ("\\land" ?∧) ;; logical and, same symbol as \wedge - ("\\langle" ?⟨) ;; Was ?〈, see bug#12948. + ("\\langle" ?\⟨) ;; Was ?〈, see bug#12948. ("\\lAngle" ?\⟪) - ("\\lbrace" ?{) + ("\\lbrace" ?\{) ("\\lbrack" ?\[) ("\\lBrack" ?\⟦) ("\\lblkbrbrak" ?\⦗) ("\\lbrbrak" ?\❲) ("\\Lbrbrak" ?\⟬) - ("\\lceil" ?⌈) + ("\\lceil" ?\⌈) ("\\ldiv" ?∕) ("\\ldots" ?…) ("\\le" ?≤) @@ -517,7 +517,7 @@ system, including many technical ones. Examples: ("\\lesseqqgtr" ?⋚) ("\\lessgtr" ?≶) ("\\lesssim" ?≲) - ("\\lfloor" ?⌊) + ("\\lfloor" ?\⌊) ("\\lgroup" ?\⟮) ("\\lhd" ?◁) ("\\rhd" ?▷) @@ -642,16 +642,16 @@ system, including many technical ones. Examples: ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948. ("\\rAngle" ?\⟫) ("\\ratio" ?∶) - ("\\rbrace" ?}) + ("\\rbrace" ?\}) ("\\rbrack" ?\]) ("\\rBrack" ?\⟧) ("\\rblkbrbrak" ?\⦘) ("\\rbrbrak" ?\❳) ("\\Rbrbrak" ?\⟭) - ("\\rceil" ?⌉) + ("\\rceil" ?\⌉) ("\\rddots" ?⋰) ("\\rect" ?▭) - ("\\rfloor" ?⌋) + ("\\rfloor" ?\⌋) ("\\rightarrow" ?→) ("\\rightarrowtail" ?↣) ("\\rightharpoondown" ?⇁) @@ -923,9 +923,9 @@ system, including many technical ones. Examples: ("\\ldata" ?\⟪) ; fuzz/zed ("\\rdata" ?\⟫) ;; From Karl Eichwalder. - ("\\glq" ?‚) + ("\\glq" ?\‚) ("\\grq" ?‘) - ("\\glqq" ?„) ("\\\"`" ?„) + ("\\glqq" ?\„) ("\\\"`" ?\„) ("\\grqq" ?“) ("\\\"'" ?“) ("\\flq" ?‹) ("\\frq" ?›) From f1b3343e3dcd5a2aa865a92cf6cf9e7efebb1a35 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jan 2026 12:54:30 +0200 Subject: [PATCH 265/325] ; Safer 'x-display-monitor-attributes-list' * src/xfns.c (Fx_display_monitor_attributes_list): Don't access more elements in monitor_frames than there are monitors reported by 'gdk_display_get_n_monitors' or 'gdk_screen_get_n_monitors'. (Bug#79941) --- src/xfns.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/xfns.c b/src/xfns.c index 70a4b6d5509..f960f36e24d 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -6648,7 +6648,8 @@ Internal use only, use `display-monitor-attributes-list' instead. */) #else i = gdk_screen_get_monitor_at_window (gscreen, gwin); #endif - ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i))); + if (0 <= i && i < n_monitors) + ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i))); } } From 21455197343ff912d9544b4663ad383009a816e5 Mon Sep 17 00:00:00 2001 From: "Jacob S. Gordon" Date: Thu, 15 Jan 2026 04:20:00 -0500 Subject: [PATCH 266/325] ; calendar-bahai: Move tests and convert to ERT * lisp/calendar/cal-bahai.el (calendar-bahai--nawruz-reference-dates) (calendar-bahai--twin-birthdays-reference-dates): Move to test file. (calendar-bahai--verify-nawruz) (calendar-bahai--verify-twin-birthdays): Remove and adapt contents in test file. (calendar-bahai-verify-calculations, calendar-bahai-run-tests): Remove. * test/lisp/calendar/cal-bahai-tests.el: Add file. (calendar-bahai--nawruz-reference-dates) (calendar-bahai--twin-birthdays-reference-dates): Add test data. (calendar-bahai-verify-nawruz, calendar-bahai-verify-twin-birthdays): Create ERT tests. (Bug#80207) --- lisp/calendar/cal-bahai.el | 226 -------------------------- test/lisp/calendar/cal-bahai-tests.el | 137 ++++++++++++++++ 2 files changed, 137 insertions(+), 226 deletions(-) create mode 100644 test/lisp/calendar/cal-bahai-tests.el diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 1e3f0400d12..ad0379bb731 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -571,232 +571,6 @@ Prefix argument ARG will make the entry nonmarking." "Bahá’í calendar equivalent of date diary entry." (format "Bahá’í date: %s" (calendar-bahai-date-string date))) - -;;; ====================================================================== -;;; Verification and Testing -;;; ====================================================================== - -;; The following code verifies the astronomical calculations against -;; official dates published by the Bahá’í World Centre. -;; -;; BACKGROUND: 2014 Calendar Reform -;; -------------------------------- -;; On 10 July 2014, the Universal House of Justice announced provisions -;; for the uniform implementation of the Badí' calendar, effective from -;; Naw-Rúz 172 BE (March 2015). The key provisions are: -;; -;; 1. NAW-RÚZ DETERMINATION: -;; "The Festival of Naw-Rúz falleth on the day that the sun entereth -;; the sign of Aries, even should this occur no more than one minute -;; before sunset." Tehran is the reference point for determining the -;; moment of the vernal equinox. If the equinox occurs before sunset -;; in Tehran, that day is Naw-Rúz; otherwise, the following day is. -;; -;; 2. TWIN HOLY BIRTHDAYS: -;; "They will now be observed on the first and the second day -;; following the occurrence of the eighth new moon after Naw-Rúz, -;; as determined in advance by astronomical tables using Ṭihrán as -;; the point of reference." -;; -;; VERIFICATION APPROACH -;; --------------------- -;; The functions below compare calculated dates against official data -;; from the Bahá’í World Centre, covering the 50-year period from -;; 172 BE (2015 CE) to 221 BE (2064 CE). This data was extracted from -;; the official ICS calendar file distributed by the Bahá’í World Centre. -;; -;; The verification confirms: -;; - Naw-Rúz dates: Calculated using `solar-equinoxes/solstices' for the -;; vernal equinox and `solar-sunrise-sunset' for Tehran sunset times. -;; - Twin Holy Birthdays: Calculated using `lunar-new-moon-on-or-after' -;; to find the eighth new moon after Naw-Rúz. -;; -;; To run the verification: -;; M-x calendar-bahai-verify-calculations RET - -(defconst calendar-bahai--nawruz-reference-dates - '((2015 3 21) (2016 3 20) (2017 3 20) (2018 3 21) (2019 3 21) - (2020 3 20) (2021 3 20) (2022 3 21) (2023 3 21) (2024 3 20) - (2025 3 20) (2026 3 21) (2027 3 21) (2028 3 20) (2029 3 20) - (2030 3 20) (2031 3 21) (2032 3 20) (2033 3 20) (2034 3 20) - (2035 3 21) (2036 3 20) (2037 3 20) (2038 3 20) (2039 3 21) - (2040 3 20) (2041 3 20) (2042 3 20) (2043 3 21) (2044 3 20) - (2045 3 20) (2046 3 20) (2047 3 21) (2048 3 20) (2049 3 20) - (2050 3 20) (2051 3 21) (2052 3 20) (2053 3 20) (2054 3 20) - (2055 3 21) (2056 3 20) (2057 3 20) (2058 3 20) (2059 3 20) - (2060 3 20) (2061 3 20) (2062 3 20) (2063 3 20) (2064 3 20)) - "Official Naw-Rúz dates from the Bahá’í World Centre (2015-2064). -Each entry is (GREGORIAN-YEAR MONTH DAY). These dates are extracted -from the official ICS calendar file and serve as the authoritative -reference for verifying the astronomical calculations. - -The dates show that Naw-Rúz falls on March 20 or 21, depending on -when the vernal equinox occurs relative to sunset in Tehran.") - -(defconst calendar-bahai--twin-birthdays-reference-dates - '(;; (GREG-YEAR BAB-MONTH BAB-DAY BAHA-MONTH BAHA-DAY) - (2015 11 13 11 14) (2016 11 1 11 2) (2017 10 21 10 22) - (2018 11 9 11 10) (2019 10 29 10 30) (2020 10 18 10 19) - (2021 11 6 11 7) (2022 10 26 10 27) (2023 10 16 10 17) - (2024 11 2 11 3) (2025 10 22 10 23) (2026 11 10 11 11) - (2027 10 30 10 31) (2028 10 19 10 20) (2029 11 7 11 8) - (2030 10 28 10 29) (2031 10 17 10 18) (2032 11 4 11 5) - (2033 10 24 10 25) (2034 11 12 11 13) (2035 11 1 11 2) - (2036 10 20 10 21) (2037 11 8 11 9) (2038 10 29 10 30) - (2039 10 19 10 20) (2040 11 6 11 7) (2041 10 26 10 27) - (2042 10 15 10 16) (2043 11 3 11 4) (2044 10 22 10 23) - (2045 11 10 11 11) (2046 10 30 10 31) (2047 10 20 10 21) - (2048 11 7 11 8) (2049 10 28 10 29) (2050 10 17 10 18) - (2051 11 5 11 6) (2052 10 24 10 25) (2053 11 11 11 12) - (2054 11 1 11 2) (2055 10 21 10 22) (2056 11 8 11 9) - (2057 10 29 10 30) (2058 10 18 10 19) (2059 11 6 11 7) - (2060 10 25 10 26) (2061 10 14 10 15) (2062 11 2 11 3) - (2063 10 23 10 24) (2064 11 10 11 11)) - "Official Twin Holy Birthday dates from the Bahá’í World Centre (2015-2064). -Each entry is (GREGORIAN-YEAR BAB-MONTH BAB-DAY BAHA-MONTH BAHA-DAY). - -The Birth of the Báb and the Birth of Bahá’u’lláh are celebrated on -consecutive days, determined by the eighth new moon after Naw-Rúz. -These dates move through the Gregorian calendar, typically falling -between mid-October and mid-November (Bahá’í months of Mashíyyat, -\\='Ilm, and Qudrat).") - -(defun calendar-bahai--verify-nawruz () - "Verify Naw-Rúz calculations against official reference dates. -Returns a plist with :total, :correct, and :errors keys." - (let ((total 0) - (correct 0) - (errors nil)) - (dolist (entry calendar-bahai--nawruz-reference-dates) - (let* ((greg-year (nth 0 entry)) - (expected-month (nth 1 entry)) - (expected-day (nth 2 entry)) - (expected (list expected-month expected-day greg-year)) - (computed (calendar-bahai-nawruz-for-gregorian-year greg-year))) - (setq total (1+ total)) - (if (equal computed expected) - (setq correct (1+ correct)) - (push (list greg-year expected computed) errors)))) - (list :total total :correct correct :errors (nreverse errors)))) - -(defun calendar-bahai--verify-twin-birthdays () - "Verify Twin Holy Birthday calculations against official reference dates. -Returns a plist with :total, :bab-correct, :baha-correct, and :errors keys." - (let ((total 0) - (bab-correct 0) - (baha-correct 0) - (errors nil)) - (dolist (entry calendar-bahai--twin-birthdays-reference-dates) - (let* ((greg-year (nth 0 entry)) - (bahai-year (- greg-year (1- 1844))) - (expected-bab (list (nth 1 entry) (nth 2 entry) greg-year)) - (expected-baha (list (nth 3 entry) (nth 4 entry) greg-year))) - ;; Only verify from reform year onwards - (when (>= bahai-year calendar-bahai-reform-year) - (setq total (1+ total)) - (let* ((computed (calendar-bahai-twin-holy-birthdays-for-year bahai-year)) - (computed-bab (car computed)) - (computed-baha (cadr computed))) - (if (equal computed-bab expected-bab) - (setq bab-correct (1+ bab-correct)) - (push (list greg-year "Báb" expected-bab computed-bab) errors)) - (if (equal computed-baha expected-baha) - (setq baha-correct (1+ baha-correct)) - (push (list greg-year "Bahá’u’lláh" expected-baha computed-baha) - errors)))))) - (list :total total - :bab-correct bab-correct - :baha-correct baha-correct - :errors (nreverse errors)))) - -(defun calendar-bahai-verify-calculations () - "Verify Bahá’í calendar calculations against official reference dates. -This function compares the astronomical calculations for Naw-Rúz and -the Twin Holy Birthdays against official dates from the Bahá’í World -Centre for the period 172-221 BE (2015-2064 CE). - -The verification tests: -1. Naw-Rúz dates - calculated from the vernal equinox relative to - sunset in Tehran. -2. Birth of the Báb dates - the first day following the eighth new - moon after Naw-Rúz. -3. Birth of Bahá’u’lláh dates - the second day following the eighth - new moon after Naw-Rúz. - -Results are displayed in the *Bahá’í Calendar Verification* buffer." - (interactive) - (let* ((nawruz-results (calendar-bahai--verify-nawruz)) - (twin-results (calendar-bahai--verify-twin-birthdays)) - (buf (get-buffer-create "*Bahá’í Calendar Verification*"))) - (with-current-buffer buf - (erase-buffer) - - (insert "This report verifies the astronomical calculations against\n") - (insert "official dates from the Bahá’í World Centre (172-221 BE).\n\n") - - ;; Naw-Rúz results - (insert "───────────────────────────────────────────────────────────────\n") - (insert "NAW-RÚZ VERIFICATION\n") - (insert "───────────────────────────────────────────────────────────────\n") - (insert (format " Total years tested: %d\n" (plist-get nawruz-results :total))) - (insert (format " Correct: %d\n" (plist-get nawruz-results :correct))) - (insert (format " Errors: %d\n" - (length (plist-get nawruz-results :errors)))) - (when (plist-get nawruz-results :errors) - (insert "\n Discrepancies:\n") - (dolist (err (plist-get nawruz-results :errors)) - (insert (format " %d: expected %S, calculated %S\n" - (nth 0 err) (nth 1 err) (nth 2 err))))) - (insert "\n") - - ;; Twin Holy Birthdays results - (insert "───────────────────────────────────────────────────────────────\n") - (insert "TWIN HOLY BIRTHDAYS VERIFICATION\n") - (insert "───────────────────────────────────────────────────────────────\n") - (insert (format " Total years tested: %d\n" - (plist-get twin-results :total))) - (insert (format " Birth of Báb correct: %d\n" - (plist-get twin-results :bab-correct))) - (insert (format " Birth of Bahá’u’lláh correct: %d\n" - (plist-get twin-results :baha-correct))) - (insert (format " Errors: %d\n" - (length (plist-get twin-results :errors)))) - (when (plist-get twin-results :errors) - (insert "\n Discrepancies:\n") - (dolist (err (plist-get twin-results :errors)) - (insert (format " %d %s: expected %S, calculated %S\n" - (nth 0 err) (nth 1 err) (nth 2 err) (nth 3 err))))) - (insert "\n") - - ;; Summary - (insert "───────────────────────────────────────────────────────────────\n") - (insert "SUMMARY\n") - (insert "───────────────────────────────────────────────────────────────\n") - (let ((total-errors (+ (length (plist-get nawruz-results :errors)) - (length (plist-get twin-results :errors))))) - (if (zerop total-errors) - (progn - (insert " All calculations match official dates!\n\n") - (insert " The astronomical algorithms correctly compute:\n") - (insert " • Naw-Rúz from the vernal equinox/sunset in Tehran\n") - (insert " • Twin Holy Birthdays from the 8th new moon after Naw-Rúz\n")) - (insert (format " ✗ Total discrepancies: %d\n" total-errors)) - (insert " Review the errors above for details.\n")))) - - (display-buffer buf) - ;; Return results for programmatic use - (list :nawruz nawruz-results :twin-birthdays twin-results))) - -(defun calendar-bahai-run-tests () - "Run verification tests and return t if all pass, nil otherwise. -This function is suitable for use in automated testing." - (let* ((nawruz-results (calendar-bahai--verify-nawruz)) - (twin-results (calendar-bahai--verify-twin-birthdays)) - (nawruz-ok (zerop (length (plist-get nawruz-results :errors)))) - (twin-ok (zerop (length (plist-get twin-results :errors))))) - (and nawruz-ok twin-ok))) - - (provide 'cal-bahai) ;;; cal-bahai.el ends here diff --git a/test/lisp/calendar/cal-bahai-tests.el b/test/lisp/calendar/cal-bahai-tests.el new file mode 100644 index 00000000000..bd95cbc4bcc --- /dev/null +++ b/test/lisp/calendar/cal-bahai-tests.el @@ -0,0 +1,137 @@ +;;; cal-bahai-tests.el --- tests for the Bahá’í calendar. -*- lexical-binding: t; -*- + +;; Copyright (C) 2026 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; Keywords: calendar +;; Human-Keywords: Bahá’í calendar, Bahá’í, Baha'i, Bahai, calendar, diary +;; Package: calendar + +;; 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: + +;; The following code verifies the astronomical calculations against +;; official dates published by the Bahá’í World Centre. +;; +;; BACKGROUND: 2014 Calendar Reform +;; -------------------------------- +;; On 10 July 2014, the Universal House of Justice announced provisions +;; for the uniform implementation of the Badí' calendar, effective from +;; Naw-Rúz 172 BE (March 2015). The key provisions are: +;; +;; 1. NAW-RÚZ DETERMINATION: +;; "The Festival of Naw-Rúz falleth on the day that the sun entereth +;; the sign of Aries, even should this occur no more than one minute +;; before sunset." Tehran is the reference point for determining the +;; moment of the vernal equinox. If the equinox occurs before sunset +;; in Tehran, that day is Naw-Rúz; otherwise, the following day is. +;; +;; 2. TWIN HOLY BIRTHDAYS: +;; "They will now be observed on the first and the second day +;; following the occurrence of the eighth new moon after Naw-Rúz, +;; as determined in advance by astronomical tables using Ṭihrán as +;; the point of reference." +;; +;; VERIFICATION APPROACH +;; --------------------- +;; The functions below compare calculated dates against official data +;; from the Bahá’í World Centre, covering the 50-year period from +;; 172 BE (2015 CE) to 221 BE (2064 CE). This data was extracted from +;; the official ICS calendar file distributed by the Bahá’í World Centre. +;; +;; The verification confirms: +;; - Naw-Rúz dates: Calculated using `solar-equinoxes/solstices' for the +;; vernal equinox and `solar-sunrise-sunset' for Tehran sunset times. +;; - Twin Holy Birthdays: Calculated using `lunar-new-moon-on-or-after' +;; to find the eighth new moon after Naw-Rúz. + +;;; Code: + +(require 'ert) +(require 'cal-bahai) + +(defconst calendar-bahai--nawruz-reference-dates + '((2015 3 21) (2016 3 20) (2017 3 20) (2018 3 21) (2019 3 21) + (2020 3 20) (2021 3 20) (2022 3 21) (2023 3 21) (2024 3 20) + (2025 3 20) (2026 3 21) (2027 3 21) (2028 3 20) (2029 3 20) + (2030 3 20) (2031 3 21) (2032 3 20) (2033 3 20) (2034 3 20) + (2035 3 21) (2036 3 20) (2037 3 20) (2038 3 20) (2039 3 21) + (2040 3 20) (2041 3 20) (2042 3 20) (2043 3 21) (2044 3 20) + (2045 3 20) (2046 3 20) (2047 3 21) (2048 3 20) (2049 3 20) + (2050 3 20) (2051 3 21) (2052 3 20) (2053 3 20) (2054 3 20) + (2055 3 21) (2056 3 20) (2057 3 20) (2058 3 20) (2059 3 20) + (2060 3 20) (2061 3 20) (2062 3 20) (2063 3 20) (2064 3 20)) + "Official Naw-Rúz dates from the Bahá’í World Centre (2015-2064). +Each entry is (GREGORIAN-YEAR MONTH DAY). These dates are extracted +from the official ICS calendar file and serve as the authoritative +reference for verifying the astronomical calculations. + +The dates show that Naw-Rúz falls on March 20 or 21, depending on +when the vernal equinox occurs relative to sunset in Tehran.") + +(defconst calendar-bahai--twin-birthdays-reference-dates + '(;; (GREG-YEAR BAB-MONTH BAB-DAY BAHA-MONTH BAHA-DAY) + (2015 11 13 11 14) (2016 11 1 11 2) (2017 10 21 10 22) + (2018 11 9 11 10) (2019 10 29 10 30) (2020 10 18 10 19) + (2021 11 6 11 7) (2022 10 26 10 27) (2023 10 16 10 17) + (2024 11 2 11 3) (2025 10 22 10 23) (2026 11 10 11 11) + (2027 10 30 10 31) (2028 10 19 10 20) (2029 11 7 11 8) + (2030 10 28 10 29) (2031 10 17 10 18) (2032 11 4 11 5) + (2033 10 24 10 25) (2034 11 12 11 13) (2035 11 1 11 2) + (2036 10 20 10 21) (2037 11 8 11 9) (2038 10 29 10 30) + (2039 10 19 10 20) (2040 11 6 11 7) (2041 10 26 10 27) + (2042 10 15 10 16) (2043 11 3 11 4) (2044 10 22 10 23) + (2045 11 10 11 11) (2046 10 30 10 31) (2047 10 20 10 21) + (2048 11 7 11 8) (2049 10 28 10 29) (2050 10 17 10 18) + (2051 11 5 11 6) (2052 10 24 10 25) (2053 11 11 11 12) + (2054 11 1 11 2) (2055 10 21 10 22) (2056 11 8 11 9) + (2057 10 29 10 30) (2058 10 18 10 19) (2059 11 6 11 7) + (2060 10 25 10 26) (2061 10 14 10 15) (2062 11 2 11 3) + (2063 10 23 10 24) (2064 11 10 11 11)) + "Official Twin Holy Birthday dates from the Bahá’í World Centre (2015-2064). +Each entry is (GREGORIAN-YEAR BAB-MONTH BAB-DAY BAHA-MONTH BAHA-DAY). + +The Birth of the Báb and the Birth of Bahá’u’lláh are celebrated on +consecutive days, determined by the eighth new moon after Naw-Rúz. +These dates move through the Gregorian calendar, typically falling +between mid-October and mid-November (Bahá’í months of Mashíyyat, +\\='Ilm, and Qudrat).") + +(ert-deftest calendar-bahai-verify-nawruz () + "Verify Naw-Rúz calculations against official reference dates." + (pcase-dolist (`(,greg-year ,expected-month ,expected-day) + calendar-bahai--nawruz-reference-dates) + (let* ((expected (list expected-month expected-day greg-year)) + (computed (calendar-bahai-nawruz-for-gregorian-year greg-year))) + (should (equal computed expected))))) + +(ert-deftest calendar-bahai-verify-twin-birthdays () + "Verify Twin Holy Birthday calculations against official reference dates." + (pcase-dolist (`(,greg-year ,bab-month ,bab-day ,baha-month ,baha-day) + calendar-bahai--twin-birthdays-reference-dates) + (let* ((bahai-year (- greg-year (1- 1844))) + (expected-bab (list bab-month bab-day greg-year)) + (expected-baha (list baha-month baha-day greg-year))) + ;; Only verify from reform year onwards + (when (>= bahai-year calendar-bahai-reform-year) + (pcase-let* ((`(,computed-bab ,computed-baha) + (calendar-bahai-twin-holy-birthdays-for-year bahai-year))) + (should (equal computed-bab expected-bab)) + (should (equal computed-baha expected-baha))))))) + +(provide 'cal-bahai-tests) +;;; cal-bahai-tests.el ends here From e8f26d554b64ed63fe2b7f110d5247648b7322ed Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 7 Jan 2026 17:39:16 +0100 Subject: [PATCH 267/325] Support cons cell for 'line-spacing' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * etc/NEWS: Announce the change. * src/dispextern.h (struct glyph_row): Add 'extra_line_spacing_above' member. (struct it): Add 'extra_line_spacing_above' member. * src/frame.h (struct frame): Add 'extra_line_spacing_above' member. Update comment for 'extra_line_spacing.' * src/buffer.c (syms_of_buffer): Update the docstring of 'line-spacing' to describe the cons cell usage. * src/buffer.h (struct buffer): Update comment for 'extra_line_spacing'. * src/frame.c (gui_set_line_spacing): Handle cons cell value for 'line-spacing'. Calculate and set 'extra_line_spacing_above' for both integer and float pairs. * src/xdisp.c (init_iterator): Initialize 'extra_line_spacing_above' from buffer or frame 'line-spacing', handling cons cells for both integer and float values. (gui_produce_glyphs): Use 'extra_line_spacing_above' to distribute spacing between ascent and descent. Update 'max_extra_line_spacing' calculation. (resize_mini_window): Take line spacing into account when resizing the mini window. Pass height of a single line to 'grow_mini_window' and 'shrink_mini_window'. * src/window.c (grow_mini_window, shrink_mini_window): Add unit argument which defines height of a single line. * src/window.h (grow_mini_window, shrink_mini_window): Adjust function prototypes accordingly with unit argument. * lisp/subr.el (total-line-spacing): New function to calculate total spacing from a number or cons cell. (posn-col-row): Use total-line-spacing. * lisp/simple.el (default-line-height): Use 'total-line-spacing'. * lisp/textmodes/picture.el (picture-mouse-set-point): Use 'total-line-spacing'. * lisp/window.el (window-default-line-height): Use 'total-line-spacing'. (window--resize-mini-window): Take 'line-spacing' into account. * test/lisp/subr-tests.el (total-line-spacing): New test. * test/src/buffer-tests.el (test-line-spacing): New test. * doc/emacs/display.texi (Display Custom): Document that 'line-spacing' can be a cons cell. (Line Height): Document the new cons cell format for 'line-spacing' to allow vertical centering. Co-authored-by: Przemysław Alexander Kamiński Co-authored-by: Daniel Mendler --- doc/emacs/display.texi | 10 ++++++ doc/lispref/display.texi | 11 +++--- etc/NEWS | 6 ++++ lisp/simple.el | 8 ++--- lisp/subr.el | 13 +++++-- lisp/textmodes/picture.el | 4 +-- lisp/window.el | 16 ++++++--- src/buffer.c | 7 ++-- src/buffer.h | 5 ++- src/dispextern.h | 7 ++++ src/frame.c | 50 ++++++++++++++++++++++++--- src/frame.h | 9 ++++- src/window.c | 15 ++++---- src/window.h | 4 +-- src/xdisp.c | 73 ++++++++++++++++++++++++++++++++------- test/lisp/subr-tests.el | 15 ++++++++ test/src/buffer-tests.el | 18 ++++++++++ 17 files changed, 224 insertions(+), 47 deletions(-) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 0cda594d5b1..dde6cc4f1b6 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -2351,6 +2351,16 @@ of lines which are a multiple of certain numbers. Customize @code{display-line-numbers-minor-tick} respectively to set those numbers. +@vindex line-spacing + The variable @code{line-spacing} controls the vertical spacing between +lines. It can be set to an integer (specifying pixels) or a float +(specifying spacing relative to the default frame font height). You can +also set this variable to a cons cell of integers or floats, such as +@code{(@var{top} . @var{bottom})}. When set to a cons cell, the spacing +is distributed above and below the line, allowing for text to be +vertically centered within the line height. See also @ref{Line Height,,, +elisp, The Emacs Lisp Reference Manual}. + @vindex visible-bell If the variable @code{visible-bell} is non-@code{nil}, Emacs attempts to make the whole screen blink when it would normally make an audible bell diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index b74e4b9632f..1d037807070 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2582,10 +2582,13 @@ the spacing relative to the frame's default line height. @vindex line-spacing You can specify the line spacing for all lines in a buffer via the -buffer-local @code{line-spacing} variable. An integer specifies -the number of pixels put below lines. A floating-point number -specifies the spacing relative to the default frame line height. This -overrides line spacings specified for the frame. +buffer-local @code{line-spacing} variable. An integer specifies the +number of pixels put below lines. A floating-point number specifies the +spacing relative to the default frame line height. A cons cell of +integers or floating-point numbers specifies the spacing put above and +below the line, allowing for vertically centering text. This overrides +line spacings specified for the frame. + @kindex line-spacing @r{(text property)} Finally, a newline can have a @code{line-spacing} text or overlay diff --git a/etc/NEWS b/etc/NEWS index 594c0d45322..ceaf682e2ab 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -82,6 +82,12 @@ other directory on your system. You can also invoke the * Changes in Emacs 31.1 +** 'line-spacing' now supports specifying spacing above the line. +Previously, only spacing below the line could be specified. The variable +can now be set to a cons cell to specify spacing both above and below +the line, which allows for vertically centering text. + ++++ ** 'prettify-symbols-mode' attempts to ignore undisplayable characters. Previously, such characters would be rendered as, e.g., white boxes. diff --git a/lisp/simple.el b/lisp/simple.el index 53f11e4eeee..99930c3090c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7875,10 +7875,10 @@ This function uses the definition of the default face for the currently selected frame." (let ((dfh (default-font-height)) (lsp (if (display-graphic-p) - (or line-spacing - (default-value 'line-spacing) - (frame-parameter nil 'line-spacing) - 0) + (total-line-spacing (or line-spacing + (default-value 'line-spacing) + (frame-parameter nil 'line-spacing) + 0)) 0))) (if (floatp lsp) (setq lsp (truncate (* (frame-char-height) lsp)))) diff --git a/lisp/subr.el b/lisp/subr.el index d307a07f05b..40325c30326 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2027,8 +2027,9 @@ and `event-end' functions." (let* ((spacing (when (display-graphic-p frame) (or (with-current-buffer (window-buffer (frame-selected-window frame)) - line-spacing) - (frame-parameter frame 'line-spacing))))) + (total-line-spacing)) + (total-line-spacing + (frame-parameter frame 'line-spacing)))))) (cond ((floatp spacing) (setq spacing (truncate (* spacing (frame-char-height frame))))) @@ -7936,4 +7937,12 @@ and return the value found in PLACE instead." ,(funcall setter val) ,val))))) +(defun total-line-spacing (&optional line-spacing-param) + "Return numeric value of line-spacing, summing it if it's a cons. + When LINE-SPACING-PARAM is provided, calculate from it instead." + (let ((v (or line-spacing-param line-spacing))) + (pcase v + ((pred numberp) v) + (`(,above . ,below) (+ above below))))) + ;;; subr.el ends here diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 8b75b7c52a8..b23b1a1d0ed 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -235,8 +235,8 @@ Use \"\\[command-apropos] picture-movement\" to see commands which control motio (char-ht (frame-char-height frame)) (spacing (when (display-graphic-p frame) (or (with-current-buffer (window-buffer window) - line-spacing) - (frame-parameter frame 'line-spacing))))) + (total-line-spacing)) + (total-line-spacing (frame-parameter frame 'line-spacing)))))) (cond ((floatp spacing) (setq spacing (truncate (* spacing char-ht)))) ((null spacing) diff --git a/lisp/window.el b/lisp/window.el index 98722e909a6..7d866d6475d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2850,9 +2850,15 @@ as small) as possible, but don't signal an error." (let* ((frame (window-frame window)) (root (frame-root-window frame)) (height (window-pixel-height window)) - (min-height (+ (frame-char-height frame) - (- (window-pixel-height window) - (window-body-height window t)))) + ;; Take line-spacing into account if the line-spacing is + ;; configured as a cons cell with above > 0 to prevent + ;; mini-window jiggling. + (ls (or (buffer-local-value 'line-spacing (window-buffer window)) + (frame-parameter frame 'line-spacing))) + (min-height (+ (if (and (consp ls) (> (car ls) 0)) + (window-default-line-height window) + (frame-char-height frame)) + (- height (window-body-height window t)))) (max-delta (- (window-pixel-height root) (window-min-size root nil nil t)))) ;; Don't make mini window too small. @@ -9906,8 +9912,8 @@ face on WINDOW's frame." (buffer (window-buffer window)) (space-height (or (and (display-graphic-p frame) - (or (buffer-local-value 'line-spacing buffer) - (frame-parameter frame 'line-spacing))) + (total-line-spacing (or (buffer-local-value 'line-spacing buffer) + (frame-parameter frame 'line-spacing)))) 0))) (+ font-height (if (floatp space-height) diff --git a/src/buffer.c b/src/buffer.c index fec30d4f0e9..3d85d784f1c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5875,12 +5875,15 @@ cursor's appearance is instead controlled by the variable `cursor-in-non-selected-windows'. */); DEFVAR_PER_BUFFER ("line-spacing", - &BVAR (current_buffer, extra_line_spacing), Qnumberp, + &BVAR (current_buffer, extra_line_spacing), Qnil, doc: /* Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. If value is a floating point number, it specifies the spacing relative -to the default frame line height. A value of nil means add no extra space. */); +to the default frame line height. +If value is a cons cell containing a pair of floats or integers, +it is interpreted as space above and below the line, respectively. +A value of nil means add no extra space. */); DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil, diff --git a/src/buffer.h b/src/buffer.h index 34fe308b671..403b249df6f 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -575,7 +575,10 @@ struct buffer Lisp_Object cursor_type_; /* An integer > 0 means put that number of pixels below text lines - in the display of this buffer. */ + in the display of this buffer. + A float ~ 1.0 means add extra number of pixels below text lines + relative to the line height. + A cons means put car spacing above and cdr spacing below the line. */ Lisp_Object extra_line_spacing_; #ifdef HAVE_TREE_SITTER diff --git a/src/dispextern.h b/src/dispextern.h index d325e185c5a..30785b9ccdf 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -960,6 +960,9 @@ struct glyph_row in last row when checking if row is fully visible. */ int extra_line_spacing; + /* Part of extra_line_spacing that should go above the line. */ + int extra_line_spacing_above; + /* First position in this row. This is the text position, including overlay position information etc, where the display of this row started, and can thus be less than the position of the first @@ -2772,6 +2775,10 @@ struct it window systems only.) */ int extra_line_spacing; + /* Default amount of additional space in pixels above lines (for + window systems only). */ + int extra_line_spacing_above; + /* Max extra line spacing added in this row. */ int max_extra_line_spacing; diff --git a/src/frame.c b/src/frame.c index 033215a76ec..ba342b15723 100644 --- a/src/frame.c +++ b/src/frame.c @@ -5454,18 +5454,60 @@ void gui_set_line_spacing (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (NILP (new_value)) - f->extra_line_spacing = 0; + { + f->extra_line_spacing = 0; + f->extra_line_spacing_above = 0; + } else if (RANGED_FIXNUMP (0, new_value, INT_MAX)) - f->extra_line_spacing = XFIXNAT (new_value); + { + f->extra_line_spacing = XFIXNAT (new_value); + f->extra_line_spacing_above = 0; + } else if (FLOATP (new_value)) { - int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f) + 0.5; + int new_spacing = XFLOAT_DATA (new_value) * FRAME_LINE_HEIGHT (f); - if (new_spacing >= 0) + if (new_spacing >= 0) { f->extra_line_spacing = new_spacing; + f->extra_line_spacing_above = 0; + } else signal_error ("Invalid line-spacing", new_value); } + else if (CONSP (new_value)) + { + Lisp_Object above = XCAR (new_value); + Lisp_Object below = XCDR (new_value); + + /* Integer pair case. */ + if (RANGED_FIXNUMP (0, above, INT_MAX) + && RANGED_FIXNUMP (0, below, INT_MAX)) + { + f->extra_line_spacing = XFIXNAT (above) + XFIXNAT (below); + f->extra_line_spacing_above = XFIXNAT (above); + } + + /* Float pair case. */ + else if (FLOATP (XCAR (new_value)) + && FLOATP (XCDR (new_value))) + { + int new_spacing = (XFLOAT_DATA (above) + XFLOAT_DATA (below)) * FRAME_LINE_HEIGHT (f); + int spacing_above = XFLOAT_DATA (above) * FRAME_LINE_HEIGHT (f); + if(new_spacing >= 0 && spacing_above >= 0) + { + f->extra_line_spacing = new_spacing; + f->extra_line_spacing_above = spacing_above; + } + else + signal_error ("Invalid line-spacing", new_value); + } + + /* Unmatched pair case. */ + else + { + signal_error ("Invalid line-spacing", new_value); + } + } else signal_error ("Invalid line-spacing", new_value); if (FRAME_VISIBLE_P (f)) diff --git a/src/frame.h b/src/frame.h index c369a848b7c..091b112e8b9 100644 --- a/src/frame.h +++ b/src/frame.h @@ -718,9 +718,16 @@ struct frame frame parameter. 0 means don't do gamma correction. */ double gamma; - /* Additional space to put between text lines on this frame. */ + /* Additional space to put below text lines on this frame. + Also takes part in line height calculation. */ int extra_line_spacing; + /* Amount of space (included in extra_line_spacing) that goes ABOVE + line line. + IMPORTANT: Don't use this for line height calculations. + (5 . 20) means that extra_line_spacing is 25 with 5 above. */ + int extra_line_spacing_above; + /* All display backends seem to need these two pixel values. */ unsigned long background_pixel; unsigned long foreground_pixel; diff --git a/src/window.c b/src/window.c index 497c587b167..c4f2e4e491f 100644 --- a/src/window.c +++ b/src/window.c @@ -5894,11 +5894,11 @@ resize_mini_window_apply (struct window *w, int delta) * line of text. */ void -grow_mini_window (struct window *w, int delta) +grow_mini_window (struct window *w, int delta, int unit) { struct frame *f = XFRAME (w->frame); int old_height = window_body_height (w, WINDOW_BODY_IN_PIXELS); - int min_height = FRAME_LINE_HEIGHT (f); + int min_height = unit; eassert (MINI_WINDOW_P (w)); @@ -5926,7 +5926,7 @@ grow_mini_window (struct window *w, int delta) resize_mini_window_apply (w, -XFIXNUM (grow)); } FRAME_WINDOWS_FROZEN (f) - = window_body_height (w, WINDOW_BODY_IN_PIXELS) > FRAME_LINE_HEIGHT (f); + = window_body_height (w, WINDOW_BODY_IN_PIXELS) > unit; } /** @@ -5936,11 +5936,10 @@ grow_mini_window (struct window *w, int delta) * line of text. */ void -shrink_mini_window (struct window *w) +shrink_mini_window (struct window *w, int unit) { struct frame *f = XFRAME (w->frame); - int delta = (window_body_height (w, WINDOW_BODY_IN_PIXELS) - - FRAME_LINE_HEIGHT (f)); + int delta = (window_body_height (w, WINDOW_BODY_IN_PIXELS) - unit); eassert (MINI_WINDOW_P (w)); @@ -5959,10 +5958,10 @@ shrink_mini_window (struct window *w) else if (delta < 0) /* delta can be less than zero after adding horizontal scroll bar. */ - grow_mini_window (w, -delta); + grow_mini_window (w, -delta, unit); FRAME_WINDOWS_FROZEN (f) - = window_body_height (w, WINDOW_BODY_IN_PIXELS) > FRAME_LINE_HEIGHT (f); + = window_body_height (w, WINDOW_BODY_IN_PIXELS) > unit; } DEFUN ("resize-mini-window-internal", Fresize_mini_window_internal, diff --git a/src/window.h b/src/window.h index 5a75f62cc6e..1b4939b40a6 100644 --- a/src/window.h +++ b/src/window.h @@ -1126,8 +1126,8 @@ extern Lisp_Object window_from_coordinates (struct frame *, int, int, extern void resize_frame_windows (struct frame *, int, bool); extern void restore_window_configuration (Lisp_Object); extern void delete_all_child_windows (Lisp_Object); -extern void grow_mini_window (struct window *, int); -extern void shrink_mini_window (struct window *); +extern void grow_mini_window (struct window *, int, int); +extern void shrink_mini_window (struct window *, int); extern int window_relative_x_coord (struct window *, enum window_part, int); void run_window_change_functions (void); diff --git a/src/xdisp.c b/src/xdisp.c index a295131a311..fa826c366dd 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -3316,13 +3316,50 @@ init_iterator (struct it *it, struct window *w, if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) { + Lisp_Object line_space_above; + Lisp_Object line_space_below; + if (FIXNATP (BVAR (current_buffer, extra_line_spacing))) - it->extra_line_spacing = XFIXNAT (BVAR (current_buffer, extra_line_spacing)); + { + it->extra_line_spacing = XFIXNAT (BVAR (current_buffer, extra_line_spacing)); + it->extra_line_spacing_above = 0; + } else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) - it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) - * FRAME_LINE_HEIGHT (it->f)); + { + it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) + * FRAME_LINE_HEIGHT (it->f)); + it->extra_line_spacing_above = 0; + } + else if (CONSP (BVAR (current_buffer, extra_line_spacing))) + { + line_space_above = XCAR (BVAR (current_buffer, extra_line_spacing)); + line_space_below = XCDR (BVAR (current_buffer, extra_line_spacing)); + /* Integer pair case. */ + if (FIXNATP (line_space_above) && FIXNATP (line_space_below)) + { + int line_space_total = XFIXNAT (line_space_below) + XFIXNAT (line_space_above); + it->extra_line_spacing = line_space_total; + it->extra_line_spacing_above = XFIXNAT (line_space_above); + } + /* Float pair case. */ + else if (FLOATP (line_space_above) && FLOATP (line_space_below)) + { + double line_space_total = XFLOAT_DATA (line_space_above) + XFLOAT_DATA (line_space_below); + it->extra_line_spacing = (line_space_total * FRAME_LINE_HEIGHT (it->f)); + it->extra_line_spacing_above = (XFLOAT_DATA (line_space_above) * FRAME_LINE_HEIGHT (it->f)); + } + /* Invalid cons. */ + else + { + it->extra_line_spacing = 0; + it->extra_line_spacing_above = 0; + } + } else if (it->f->extra_line_spacing > 0) - it->extra_line_spacing = it->f->extra_line_spacing; + { + it->extra_line_spacing = it->f->extra_line_spacing; + it->extra_line_spacing_above = it->f->extra_line_spacing_above; + } } /* If realized faces have been removed, e.g. because of face @@ -13157,7 +13194,7 @@ resize_mini_window (struct window *w, bool exact_p) else { struct it it; - int unit = FRAME_LINE_HEIGHT (f); + int unit; int height, max_height; struct text_pos start; struct buffer *old_current_buffer = NULL; @@ -13171,6 +13208,10 @@ resize_mini_window (struct window *w, bool exact_p) init_iterator (&it, w, BEGV, BEGV_BYTE, NULL, DEFAULT_FACE_ID); + /* Unit includes line spacing if line spacing is added above */ + unit = FRAME_LINE_HEIGHT (f) + + (it.extra_line_spacing_above ? it.extra_line_spacing : 0); + /* Compute the max. number of lines specified by the user. */ if (FLOATP (Vmax_mini_window_height)) max_height = XFLOAT_DATA (Vmax_mini_window_height) * windows_height; @@ -13203,7 +13244,10 @@ resize_mini_window (struct window *w, bool exact_p) } else height = it.current_y + it.max_ascent + it.max_descent; - height -= min (it.extra_line_spacing, it.max_extra_line_spacing); + + /* Remove final line spacing in the mini-window */ + if (!it.extra_line_spacing_above) + height -= min (it.extra_line_spacing, it.max_extra_line_spacing); /* Compute a suitable window start. */ if (height > max_height) @@ -13241,13 +13285,13 @@ resize_mini_window (struct window *w, bool exact_p) /* Let it grow only, until we display an empty message, in which case the window shrinks again. */ if (height > old_height) - grow_mini_window (w, height - old_height); + grow_mini_window (w, height - old_height, unit); else if (height < old_height && (exact_p || BEGV == ZV)) - shrink_mini_window (w); + shrink_mini_window (w, unit); } else if (height != old_height) /* Always resize to exact size needed. */ - grow_mini_window (w, height - old_height); + grow_mini_window (w, height - old_height, unit); if (old_current_buffer) set_buffer_internal (old_current_buffer); @@ -24068,6 +24112,7 @@ append_space_for_newline (struct it *it, bool default_face_p) { Lisp_Object height, total_height; int extra_line_spacing = it->extra_line_spacing; + int extra_line_spacing_above = it->extra_line_spacing_above; int boff = font->baseline_offset; if (font->vertical_centering) @@ -24109,7 +24154,7 @@ append_space_for_newline (struct it *it, bool default_face_p) if (!NILP (total_height)) spacing = calc_line_height_property (it, total_height, font, - boff, false); + boff, false); else { spacing = get_it_property (it, Qline_spacing); @@ -24121,11 +24166,13 @@ append_space_for_newline (struct it *it, bool default_face_p) extra_line_spacing = XFIXNUM (spacing); if (!NILP (total_height)) extra_line_spacing -= (it->phys_ascent + it->phys_descent); + } } if (extra_line_spacing > 0) { - it->descent += extra_line_spacing; + it->descent += (extra_line_spacing - extra_line_spacing_above); + it->ascent += extra_line_spacing_above; if (extra_line_spacing > it->max_extra_line_spacing) it->max_extra_line_spacing = extra_line_spacing; } @@ -33138,6 +33185,7 @@ void gui_produce_glyphs (struct it *it) { int extra_line_spacing = it->extra_line_spacing; + int extra_line_spacing_above = it->extra_line_spacing_above; it->glyph_not_available_p = false; @@ -33891,7 +33939,8 @@ gui_produce_glyphs (struct it *it) if (extra_line_spacing > 0) { - it->descent += extra_line_spacing; + it->descent += extra_line_spacing - extra_line_spacing_above; + it->ascent += extra_line_spacing_above; if (extra_line_spacing > it->max_extra_line_spacing) it->max_extra_line_spacing = extra_line_spacing; } diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 1a64cbff0a1..4d9237f08b6 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1694,5 +1694,20 @@ final or penultimate step during initialization.")) (should (equal (funcall (subr--identity #'any) #'minusp ls) '(-1 -2 -3))) (should (equal (funcall (subr--identity #'any) #'stringp ls) nil)))) +(ert-deftest total-line-spacing () + (progn + (let ((line-spacing 10)) + (should (equal (total-line-spacing) line-spacing) )) + (let ((line-spacing 0.8)) + (should (equal (total-line-spacing) 0.8))) + (let ((line-spacing '(10 . 5))) + (should (equal (total-line-spacing) 15))) + (let ((line-spacing '(0.3 . 0.4))) + (should (equal (total-line-spacing) 0.7))) + (should (equal (total-line-spacing 10) 10)) + (should (equal (total-line-spacing 0.3) 0.3)) + (should (equal (total-line-spacing '(1 . 3)) 4)) + (should (equal (total-line-spacing '(0.1 . 0.1 )) 0.2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 9ed76a42603..5f534ed513a 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -8650,4 +8650,22 @@ Finally, kill the buffer and its temporary file." (should (= (point-min) 1)) (should (= (point-max) 5001)))) +(ert-deftest test-line-spacing () + "Test `line-spacing' impact on text size" + (skip-unless (display-graphic-p)) + (let* + ((size-with-text (lambda (ls) + (with-temp-buffer + (setq-local line-spacing ls) + (insert "X\nX") + (cdr (buffer-text-pixel-size)))))) + (cl-loop for x from 0 to 50 + for y from 0 to 50 + do + (ert-info ((format "((linespacing '(%d . %d)) == (linespacing %d)" x y (+ x y)) + :prefix "Linespace check: ") + (should (= + (funcall size-with-text (+ x y)) + (funcall size-with-text (cons x y)))))))) + ;;; buffer-tests.el ends here From 3ce57b05a236a94b2938d513764adbffacfba2f4 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jan 2026 13:39:23 +0200 Subject: [PATCH 268/325] ; Fix last change. --- etc/NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/etc/NEWS b/etc/NEWS index ceaf682e2ab..465df9c4ddb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -82,6 +82,7 @@ other directory on your system. You can also invoke the * Changes in Emacs 31.1 ++++ ** 'line-spacing' now supports specifying spacing above the line. Previously, only spacing below the line could be specified. The variable can now be set to a cons cell to specify spacing both above and below From dea8f11c09daf5a769f331735b1f136434214c33 Mon Sep 17 00:00:00 2001 From: Manuel Giraud Date: Thu, 8 Jan 2026 19:23:47 +0100 Subject: [PATCH 269/325] Document 'C-u M-x compile' (bug#80156) * doc/emacs/building.texi (Compilation): Document 'C-u M-x compile'. --- doc/emacs/building.texi | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index e90fdce7598..2fd3ccc6d87 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -64,6 +64,12 @@ named @file{*compilation*}. The current buffer's default directory is used as the working directory for the execution of the command, so by default compilation takes place in that directory. + When invoked with a prefix argument, the @file{*compilation*} buffer +is using Comint mode as its major mode (@pxref{Shell Mode}). By default +Comint mode has the nice property of looking for any credential prompts +in its contents and make Emacs asks for a password if this happens. +This is useful should the compilation command need such a credential. + @vindex compile-command The default compilation command is @samp{make -k}, which is usually correct for programs compiled using the @command{make} utility (the From e1d65b3c2284517ad2cb172ca7b435b8c1475c5e Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Wed, 21 Jan 2026 17:38:17 +0800 Subject: [PATCH 270/325] Fix inconsistent definition and usage of 'calendar-buffer' * lisp/calendar/calendar.el (calendar-buffer): Define it as a variable. * lisp/calendar/diary-lib.el (diary-mark-entries): Set 'calendar-buffer' as a string. (bug#79994) --- lisp/calendar/calendar.el | 2 +- lisp/calendar/diary-lib.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 2da45c18880..42fc210c1e1 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1098,7 +1098,7 @@ Otherwise, use symbolic time zones like \"CET\"." (defconst calendar-first-date-row 3 "First row in the calendar with actual dates.") -(defconst calendar-buffer "*Calendar*" +(defvar calendar-buffer "*Calendar*" "Name of the buffer used for the calendar.") (defun calendar-get-buffer () diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index baa361bd707..36f9b0ef13b 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1402,7 +1402,7 @@ marks. This is intended to deal with deleted diary entries." (diary-buffer (find-buffer-visiting diary-file)) ;; Record current calendar buffer in case this function is ;; called in a calendar-mode buffer not named `calendar-buffer'. - (calendar-buffer (calendar-get-buffer)) + (calendar-buffer (buffer-name (calendar-get-buffer))) ;; Dynamically bound in diary-include-files. (d-incp (and (boundp 'diary-including) diary-including)) file-glob-attrs temp-buff) From f800f2300bf810f907e20ea5a21243a3325890af Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 24 Jan 2026 15:39:11 +0200 Subject: [PATCH 271/325] Fix support of listing switches with whitespace in Dired * lisp/dired.el (dired-sort-by-date-regexp) (dired-sort-by-name-regexp): Allow quoted arguments with embedded whitespace, per the doc string of 'dired-listing-switches'. (Bug#80200) --- lisp/dired.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/dired.el b/lisp/dired.el index b987b85c3c7..7f598433a9d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -5038,12 +5038,16 @@ format, use `\\[universal-argument] \\[dired]'.") ;; `dired-ls-sorting-switches' after -t overrides -t. "[^ " dired-ls-sorting-switches "]*" "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t" - dired-ls-sorting-switches "]+\\)\\)* *$") + dired-ls-sorting-switches "]+\\|" + ;; Allow quoted strings + "\"[^\"]*\"\\)\\)* *$") "Regexp recognized by Dired to set `by date' mode.") (defvar dired-sort-by-name-regexp (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|" - "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$") + "-[^- t" dired-ls-sorting-switches "]+[^- tSXU]+\\|" + ;; Allow quoted strings + "\"[^\"]*\"\\)\\)* *$") "Regexp recognized by Dired to set `by name' mode.") (defvar dired-sort-inhibit nil From db413c9da7adc2b0d94158be3d39f9034163cff9 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 21 Jan 2026 11:10:54 +0100 Subject: [PATCH 272/325] Improve animation cache documentation * doc/lispref/display.texi (Image Cache): Document animation cache argument that clear-image-cache gained in Emacs 29 (bug#56546, bug#66221). * lisp/image.el (image-animate-timeout): Note limitation of clear-image-cache with ImageMagick. * src/image.c (Fclear_image_cache): Rename animation-cache argument to animation-filter and expand its description for clarity. (struct anim_cache, anim_create_cache, image_prune_animation_caches): Improve commentary. (mark_image_cache): Replace stale commentary that referred to forall_images_in_image_cache with description of mark_image_cache. [HAVE_IMAGEMAGICK] (struct animation_cache): Mention lack of clear-image-cache support in commentary. --- doc/lispref/display.texi | 12 +++++++- lisp/image.el | 3 +- src/image.c | 59 +++++++++++++++++++++++++--------------- 3 files changed, 50 insertions(+), 24 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 1d037807070..4211b435db5 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7415,7 +7415,7 @@ period much shorter than @code{image-cache-eviction-delay} (see below), you can opt to flush unused images yourself, instead of waiting for Emacs to do it automatically. -@defun clear-image-cache &optional filter +@defun clear-image-cache &optional filter animation-filter This function clears an image cache, removing all the images stored in it. If @var{filter} is omitted or @code{nil}, it clears the cache for the selected frame. If @var{filter} is a frame, it clears the cache @@ -7423,6 +7423,16 @@ for that frame. If @var{filter} is @code{t}, all image caches are cleared. Otherwise, @var{filter} is taken to be a file name, and all images associated with that file name are removed from all image caches. + +This function also clears the image animation cache, which is a separate +cache that Emacs maintains for animated multi-frame images +(@pxref{Multi-Frame Images}). If @var{animation-filter} is omitted or +@code{nil}, it clears the animation cache in addition to the image +caches selected by @var{filter}. Otherwise, this function removes the +image with specification @code{eq} to @var{animation-filter} only from +the animation cache, and does not clear any image caches. This can help +reduce memory usage after an animation is stopped but the image is still +displayed. @end defun If an image in the image cache has not been displayed for a specified diff --git a/lisp/image.el b/lisp/image.el index 6048caea0be..a15d66c5a81 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -33,7 +33,7 @@ (declare-function image-flush "image.c" (spec &optional frame)) (declare-function clear-image-cache "image.c" - (&optional filter animation-cache)) + (&optional filter animation-filter)) (defconst image-type-header-regexps `(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm) @@ -1053,6 +1053,7 @@ for the animation speed. A negative value means to animate in reverse." ;; keep updating it. This helps stop unbounded RAM usage when ;; doing, for instance, `g' in an eww buffer with animated ;; images. + ;; FIXME: This doesn't currently support ImageMagick. (clear-image-cache nil image) (let* ((time (prog1 (current-time) (image-show-frame image n t))) diff --git a/src/image.c b/src/image.c index f55596cd1ba..f5db851cfbd 100644 --- a/src/image.c +++ b/src/image.c @@ -2427,23 +2427,27 @@ clear_image_caches (Lisp_Object filter) DEFUN ("clear-image-cache", Fclear_image_cache, Sclear_image_cache, 0, 2, 0, - doc: /* Clear the image cache. + doc: /* Clear the image and animation caches. FILTER nil or a frame means clear all images in the selected frame. FILTER t means clear the image caches of all frames. Anything else means clear only those images that refer to FILTER, which is then usually a filename. -This function also clears the image animation cache. If -ANIMATION-CACHE is non-nil, only the image spec `eq' with -ANIMATION-CACHE is removed, and other image cache entries are not -evicted. */) - (Lisp_Object filter, Lisp_Object animation_cache) +This function also clears the image animation cache. +ANIMATION-FILTER nil means clear all animation cache entries. +Otherwise, clear the image spec `eq' to ANIMATION-FILTER only +from the animation cache, and do not clear any image caches. +This can help reduce memory usage after an animation is stopped +but the image is still displayed. */) + (Lisp_Object filter, Lisp_Object animation_filter) { - if (!NILP (animation_cache)) + if (!NILP (animation_filter)) { - CHECK_CONS (animation_cache); + /* IMAGEP? */ + CHECK_CONS (animation_filter); #if defined (HAVE_WEBP) || defined (HAVE_GIF) - anim_prune_animation_cache (XCDR (animation_cache)); + /* FIXME: Implement the ImageMagick case. */ + anim_prune_animation_cache (XCDR (animation_filter)); #endif return Qnil; } @@ -3683,6 +3687,8 @@ cache_image (struct frame *f, struct image *img) struct anim_cache { + /* 'Key' of this cache entry. + Typically the cdr (plist) of an image spec. */ Lisp_Object spec; /* For webp, this will be an iterator, and for libgif, a gif handle. */ void *handle; @@ -3690,18 +3696,26 @@ struct anim_cache void *temp; /* A function to call to free the handle. */ void (*destructor) (void *); - int index, width, height, frames; + /* Current frame index, and total number of frames. Note that + different image formats may start at different indices. */ + int index, frames; + /* Animation frame dimensions. */ + int width, height; /* This is used to be able to say something about the cache size. - We don't actually know how much memory the different libraries - actually use here (since these cache structures are opaque), so - this is mostly just the size of the original image file. */ + We don't know how much memory the different libraries actually + use here (since these cache structures are opaque), so this is + mostly just the size of the original image file. */ intmax_t byte_size; + /* Last time this cache entry was updated. */ struct timespec update_time; struct anim_cache *next; }; static struct anim_cache *anim_cache = NULL; +/* Return a new animation cache entry for image SPEC (which need not be + an image specification, and is typically its cdr/plist). + Freed only by pruning the cache. */ static struct anim_cache * anim_create_cache (Lisp_Object spec) { @@ -3773,11 +3787,7 @@ anim_get_animation_cache (Lisp_Object spec) #endif /* HAVE_WEBP || HAVE_GIF */ -/* Call FN on every image in the image cache of frame F. Used to mark - Lisp Objects in the image cache. */ - /* Mark Lisp objects in image IMG. */ - static void mark_image (struct image *img) { @@ -3788,7 +3798,8 @@ mark_image (struct image *img) mark_object (img->lisp_data); } - +/* Mark every image in image cache C, as well as the global animation + cache. */ void mark_image_cache (struct image_cache *c) { @@ -10884,7 +10895,7 @@ imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent]) } /* Animated images (e.g., GIF89a) are composed from one "master image" - (which is the first one, and then there's a number of images that + (which is the first one), and then there's a number of images that follow. If following images have non-transparent colors, these are composed "on top" of the master image. So, in general, one has to compute all the preceding images to be able to display a particular @@ -10893,7 +10904,10 @@ imagemagick_filename_hint (Lisp_Object spec, char hint_buffer[MaxTextExtent]) Computing all the preceding images is too slow, so we maintain a cache of previously computed images. We have to maintain a cache separate from the image cache, because the images may be scaled - before display. */ + before display. + + FIXME: Consolidate this with the GIF and WebP anim_cache. + Not just for DRY, but for Fclear_image_cache too. */ struct animation_cache { @@ -12898,11 +12912,12 @@ lookup_image_type (Lisp_Object type) return NULL; } -/* Prune the animation caches. If CLEAR, remove all animation cache - entries. */ +/* Prune old entries from the animation cache. + If CLEAR, remove all animation cache entries. */ void image_prune_animation_caches (bool clear) { + /* FIXME: Consolidate these animation cache implementations. */ #if defined (HAVE_WEBP) || defined (HAVE_GIF) anim_prune_animation_cache (clear? Qt: Qnil); #endif From 72c53dcb13e13c170d3094cdabc58a22da806838 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Fri, 16 Jan 2026 08:32:03 +0100 Subject: [PATCH 273/325] Improve (WebP) image animation This adds support for animations with heterogeneous frame durations without sacrificing CPU (bug#47895), and plugs a memory leak in and speeds up WebP animations (bug#66221). * lisp/image.el (image-animate): No need to stash image-multi-frame-p data here, as image-animate-timeout now refetches it for each animation frame. (image-show-frame): Fetch image-multi-frame-p anew when checking bounds; a cached value risks going stale. This is not on the hot path for animations, and is mainly used when framewise stepping through an animation interactively. (image-animate-timeout): Fetch current frame duration anew but do so before image-show-frame to ensure an image cache hit (bug#47895, bug#66221). Include time taken by local arithmetic in 'time-to-load-image'. Update commentary. * src/image.c (parse_image_spec): Simplify using FIXNATP. (filter_image_spec): Remove check for :animate-multi-frame-data as it is no longer used by image.el. [HAVE_ANIMATION && HAVE_GIF] (struct gif_anim_handle): [HAVE_ANIMATION && HAVE_WEBP] (struct webp_anim_handle): New structures formalizing animation cache handles, and allowing for more than two custom fields per image type. (struct anim_cache): Replace generic handle and temp pointers with a union of gif_anim_handle and webp_anim_handle. All uses updated. Update destructor signature accordingly. (anim_create_cache): Use xzalloc to zero-initialize both integer and pointer fields. Initialize frames, width, height to -1 for consistency with index. Mark as ATTRIBUTE_MALLOC. (anim_prune_animation_cache): Check whether destructor (not handle) is null before calling it. (gif_clear_image): Note in commentary that WebP also uses it. (gif_destroy): Free pixmap here now that prune_anim_cache no longer does it automatically. Remove unused gif_err variable. (gif_load): Avoid UB from casting destructor to a different type. Don't redundantly check for null before xfree. Change default frame delay from 15fps to t, which image-multi-frame-p will translate into image-default-frame-delay, which the user can control. [HAVE_WEBP && WINDOWSNT] (init_webp_functions): Reconcile library definitions with current webp_load implementation. (webp_destroy): Free owned copy of input WebP bitstream contents. (webp_load): Ownership of both input and decoded memory is a function of :data vs :file and animated vs still. Make this and transfers of ownership to animation cache clearer by using distinct copy/view variables. Also make resource freeing clearer by using a single unconditional cleanup and exit path. Check animation cache early to avoid rereading bitstream and reparsing headers on each call. Remove redundant call to WebPGetInfo since WebPGetFeatures does the same thing. Check more libwebpdemux return values for failure and fix file name reported in error messages. Remove unset local variable 'file'. If requested :index is ahead, fast-forward instead of restarting from first frame. If requested :index is behind, reset animation decoder to first frame instead of deleting and recreating it. Reuse animation decoder's own WebPAnimInfo and WebPDemuxer instance instead of creating and deleting a separate WebPDemuxer. Fix leak when copying :data to animation cache. Fix frame duration calculation, and return each frame's own duration now that image.el supports it. Return t as a default frame duration, as per gif_load. Consistently use WebPBitstreamFeatures to simplify control flow. Don't pollute lisp_data image-metadata for still images with animation-related properties. (image_types) [HAVE_WEBP]: Use gif_clear_image to clear lisp_data for consistency with GIF code. (syms_of_image): Remove QCanimate_multi_frame_data; no longer used. --- lisp/image.el | 27 ++- src/image.c | 522 +++++++++++++++++++++++++++++--------------------- 2 files changed, 320 insertions(+), 229 deletions(-) diff --git a/lisp/image.el b/lisp/image.el index a15d66c5a81..dbfbc266445 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -953,9 +953,6 @@ displayed." (when position (plist-put (cdr image) :animate-position (set-marker (make-marker) position (current-buffer)))) - ;; Stash the data about the animation here so that we don't - ;; trigger image recomputation unnecessarily later. - (plist-put (cdr image) :animate-multi-frame-data animation) (run-with-timer 0.2 nil #'image-animate-timeout image (or index 0) (car animation) 0 limit (+ (float-time) 0.2))))) @@ -986,9 +983,7 @@ Frames are indexed from 0. Optional argument NOCHECK non-nil means do not check N is within the range of frames present in the image." (unless nocheck (if (< n 0) (setq n 0) - (setq n (min n (1- (car (or (plist-get (cdr image) - :animate-multi-frame-data) - (image-multi-frame-p image)))))))) + (setq n (min n (1- (car (image-multi-frame-p image))))))) (plist-put (cdr image) :index n) (force-window-update (plist-get (cdr image) :animate-buffer))) @@ -1005,10 +1000,8 @@ multiplication factor for the current value." (* value (image-animate-get-speed image)) value))) -;; FIXME? The delay may not be the same for different sub-images, -;; hence we need to call image-multi-frame-p to return it. -;; But it also returns count, so why do we bother passing that as an -;; argument? +;; FIXME: The count argument is redundant; the value is also given by +;; the call to `image-multi-frame-p'. (defun image-animate-timeout (image n count time-elapsed limit target-time) "Display animation frame N of IMAGE. N=0 refers to the initial animation frame. @@ -1055,14 +1048,18 @@ for the animation speed. A negative value means to animate in reverse." ;; images. ;; FIXME: This doesn't currently support ImageMagick. (clear-image-cache nil image) - (let* ((time (prog1 (current-time) - (image-show-frame image n t))) + (let* ((time (current-time)) + ;; Each animation frame can have its own duration, so + ;; (re)fetch its `image-metadata'. Do so before + ;; `image-show-frame' to avoid an image cache miss per + ;; animation frame (bug#47895, bug#66221). + (multi (prog1 (image-multi-frame-p image) + (image-show-frame image n t))) (speed (image-animate-get-speed image)) - (time-to-load-image (time-since time)) (stated-delay-time - (/ (or (cdr (plist-get (cdr image) :animate-multi-frame-data)) - image-default-frame-delay) + (/ (or (cdr multi) image-default-frame-delay) (float (abs speed)))) + (time-to-load-image (time-since time)) ;; Subtract off the time we took to load the image from the ;; stated delay time. (delay (max (float-time (time-subtract stated-delay-time diff --git a/src/image.c b/src/image.c index f5db851cfbd..59be186a839 100644 --- a/src/image.c +++ b/src/image.c @@ -1568,7 +1568,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, /* Unlike the other integer-related cases, this one does not verify that VALUE fits in 'int'. This is because callers want EMACS_INT. */ - if (!FIXNUMP (value) || XFIXNUM (value) < 0) + if (!FIXNATP (value)) return false; break; @@ -2268,8 +2268,7 @@ filter_image_spec (Lisp_Object spec) breaks the image cache. Filter those out. */ if (!(EQ (key, QCanimate_buffer) || EQ (key, QCanimate_tardiness) - || EQ (key, QCanimate_position) - || EQ (key, QCanimate_multi_frame_data))) + || EQ (key, QCanimate_position))) { out = Fcons (value, out); out = Fcons (key, out); @@ -3682,6 +3681,27 @@ cache_image (struct frame *f, struct image *img) #if defined (HAVE_WEBP) || defined (HAVE_GIF) +# ifdef HAVE_GIF +struct gif_anim_handle +{ + struct GifFileType *gif; + unsigned long *pixmap; +}; +# endif /* HAVE_GIF */ + +# ifdef HAVE_WEBP +struct webp_anim_handle +{ + /* Decoder iterator+compositor. */ + struct WebPAnimDecoder *dec; + /* Owned copy of input WebP bitstream data consumed by decoder, + which it must outlive unchanged. */ + uint8_t *contents; + /* Timestamp in milliseconds of last decoded frame. */ + int timestamp; +}; +# endif /* HAVE_WEBP */ + /* To speed animations up, we keep a cache (based on EQ-ness of the image spec/object) where we put the animator iterator. */ @@ -3690,12 +3710,20 @@ struct anim_cache /* 'Key' of this cache entry. Typically the cdr (plist) of an image spec. */ Lisp_Object spec; - /* For webp, this will be an iterator, and for libgif, a gif handle. */ - void *handle; - /* If we need to maintain temporary data of some sort. */ - void *temp; + /* Image type dependent animation handle (e.g., WebP iterator), freed + by 'destructor'. The union allows maintaining multiple fields per + image type and image frame without further heap allocations. */ + union anim_handle + { +# ifdef HAVE_GIF + struct gif_anim_handle gif; +# endif /* HAVE_GIF */ +# ifdef HAVE_WEBP + struct webp_anim_handle webp; +# endif /* HAVE_WEBP */ + } handle; /* A function to call to free the handle. */ - void (*destructor) (void *); + void (*destructor) (union anim_handle *); /* Current frame index, and total number of frames. Note that different image formats may start at different indices. */ int index, frames; @@ -3716,17 +3744,15 @@ static struct anim_cache *anim_cache = NULL; /* Return a new animation cache entry for image SPEC (which need not be an image specification, and is typically its cdr/plist). Freed only by pruning the cache. */ -static struct anim_cache * +static ATTRIBUTE_MALLOC struct anim_cache * anim_create_cache (Lisp_Object spec) { - struct anim_cache *cache = xmalloc (sizeof (struct anim_cache)); - cache->handle = NULL; - cache->temp = NULL; - - cache->index = -1; - cache->next = NULL; + struct anim_cache *cache = xzalloc (sizeof *cache); cache->spec = spec; - cache->byte_size = 0; + cache->index = -1; + cache->frames = -1; + cache->width = -1; + cache->height = -1; return cache; } @@ -3748,10 +3774,8 @@ anim_prune_animation_cache (Lisp_Object clear) || (NILP (clear) && timespec_cmp (old, cache->update_time) > 0) || EQ (clear, cache->spec)) { - if (cache->handle) - cache->destructor (cache); - if (cache->temp) - xfree (cache->temp); + if (cache->destructor) + cache->destructor (&cache->handle); *pcache = cache->next; xfree (cache); } @@ -9629,7 +9653,8 @@ static const struct image_keyword gif_format[GIF_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -/* Free X resources of GIF image IMG which is used on frame F. */ +/* Free X resources of GIF image IMG which is used on frame F. + Also used by other image types. */ static void gif_clear_image (struct frame *f, struct image *img) @@ -9821,11 +9846,15 @@ static const int interlace_increment[] = {8, 8, 4, 2}; #define GIF_LOCAL_DESCRIPTOR_EXTENSION 249 +/* Release gif_anim_handle resources. */ static void -gif_destroy (struct anim_cache* cache) +gif_destroy (union anim_handle *handle) { - int gif_err; - gif_close (cache->handle, &gif_err); + struct gif_anim_handle *h = &handle->gif; + gif_close (h->gif, NULL); + h->gif = NULL; + xfree (h->pixmap); + h->pixmap = NULL; } static bool @@ -9842,6 +9871,7 @@ gif_load (struct frame *f, struct image *img) EMACS_INT idx = -1; int gif_err; struct anim_cache* cache = NULL; + struct gif_anim_handle *anim_handle = NULL; /* Which sub-image are we to display? */ Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); intmax_t byte_size = 0; @@ -9852,12 +9882,15 @@ gif_load (struct frame *f, struct image *img) { /* If this is an animated image, create a cache for it. */ cache = anim_get_animation_cache (XCDR (img->spec)); + anim_handle = &cache->handle.gif; /* We have an old cache entry, so use it. */ - if (cache->handle) + if (anim_handle->gif) { - gif = cache->handle; - pixmap = cache->temp; - /* We're out of sync, so start from the beginning. */ + gif = anim_handle->gif; + pixmap = anim_handle->pixmap; + /* We're out of sync, so start from the beginning. + FIXME: Can't we fast-forward like webp_load does when + idx > cache->index, instead of restarting? */ if (cache->index != idx - 1) cache->index = -1; } @@ -10014,10 +10047,10 @@ gif_load (struct frame *f, struct image *img) } /* It's an animated image, so initialize the cache. */ - if (cache && !cache->handle) + if (cache && !anim_handle->gif) { - cache->handle = gif; - cache->destructor = (void (*)(void *)) &gif_destroy; + anim_handle->gif = gif; + cache->destructor = gif_destroy; cache->width = width; cache->height = height; cache->byte_size = byte_size; @@ -10046,8 +10079,8 @@ gif_load (struct frame *f, struct image *img) if (!pixmap) { pixmap = xmalloc (width * height * sizeof (unsigned long)); - if (cache) - cache->temp = pixmap; + if (anim_handle) + anim_handle->pixmap = pixmap; } /* Clear the part of the screen image not covered by the image. @@ -10100,7 +10133,7 @@ gif_load (struct frame *f, struct image *img) int start_frame = 0; /* We have animation data in the cache. */ - if (cache && cache->temp) + if (cache && anim_handle->pixmap) { start_frame = cache->index + 1; if (start_frame > idx) @@ -10260,11 +10293,16 @@ gif_load (struct frame *f, struct image *img) delay |= ext->Bytes[1]; } } + /* FIXME: Expose this via a nicer interface (bug#66221#122). */ img->lisp_data = list2 (Qextension_data, img->lisp_data); + /* We used to return a default delay of 1/15th of a second. + Meanwhile browsers have settled on 1/10th of a second. + For consistency across image types and to afford user + configuration, we now return a non-nil nonnumeric value that + image-multi-frame-p turns into image-default-frame-delay. */ img->lisp_data = Fcons (Qdelay, - /* Default GIF delay is 1/15th of a second. */ - Fcons (make_float (delay? delay / 100.0: 1.0 / 15), + Fcons (delay ? make_float (delay / 100.0) : Qt, img->lisp_data)); } @@ -10275,8 +10313,7 @@ gif_load (struct frame *f, struct image *img) if (!cache) { - if (pixmap) - xfree (pixmap); + xfree (pixmap); if (gif_close (gif, &gif_err) == GIF_ERROR) { #if HAVE_GIFERRORSTRING @@ -10302,13 +10339,12 @@ gif_load (struct frame *f, struct image *img) return true; gif_error: - if (pixmap) - xfree (pixmap); + xfree (pixmap); gif_close (gif, NULL); - if (cache) + if (anim_handle) { - cache->handle = NULL; - cache->temp = NULL; + anim_handle->gif = NULL; + anim_handle->pixmap = NULL; } return false; } @@ -10381,7 +10417,6 @@ webp_image_p (Lisp_Object object) /* WebP library details. */ -DEF_DLL_FN (int, WebPGetInfo, (const uint8_t *, size_t, int *, int *)); /* WebPGetFeatures is a static inline function defined in WebP's decode.h. Since we cannot use that with dynamically-loaded libwebp DLL, we instead load the internal function it calls and redirect to @@ -10392,16 +10427,16 @@ DEF_DLL_FN (uint8_t *, WebPDecodeRGBA, (const uint8_t *, size_t, int *, int *)); DEF_DLL_FN (uint8_t *, WebPDecodeRGB, (const uint8_t *, size_t, int *, int *)); DEF_DLL_FN (void, WebPFree, (void *)); DEF_DLL_FN (uint32_t, WebPDemuxGetI, (const WebPDemuxer *, WebPFormatFeature)); -DEF_DLL_FN (WebPDemuxer *, WebPDemuxInternal, - (const WebPData *, int, WebPDemuxState *, int)); -DEF_DLL_FN (void, WebPDemuxDelete, (WebPDemuxer *)); +DEF_DLL_FN (int, WebPAnimDecoderGetInfo, + (const WebPAnimDecoder* dec, WebPAnimInfo* info)); DEF_DLL_FN (int, WebPAnimDecoderGetNext, (WebPAnimDecoder *, uint8_t **, int *)); DEF_DLL_FN (WebPAnimDecoder *, WebPAnimDecoderNewInternal, (const WebPData *, const WebPAnimDecoderOptions *, int)); -DEF_DLL_FN (int, WebPAnimDecoderOptionsInitInternal, - (WebPAnimDecoderOptions *, int)); DEF_DLL_FN (int, WebPAnimDecoderHasMoreFrames, (const WebPAnimDecoder *)); +DEF_DLL_FN (void, WebPAnimDecoderReset, (WebPAnimDecoder *)); +DEF_DLL_FN (const WebPDemuxer *, WebPAnimDecoderGetDemuxer, + (const WebPAnimDecoder *)); DEF_DLL_FN (void, WebPAnimDecoderDelete, (WebPAnimDecoder *)); static bool @@ -10413,60 +10448,61 @@ init_webp_functions (void) && (library2 = w32_delayed_load (Qwebpdemux)))) return false; - LOAD_DLL_FN (library1, WebPGetInfo); LOAD_DLL_FN (library1, WebPGetFeaturesInternal); LOAD_DLL_FN (library1, WebPDecodeRGBA); LOAD_DLL_FN (library1, WebPDecodeRGB); LOAD_DLL_FN (library1, WebPFree); LOAD_DLL_FN (library2, WebPDemuxGetI); - LOAD_DLL_FN (library2, WebPDemuxInternal); - LOAD_DLL_FN (library2, WebPDemuxDelete); + LOAD_DLL_FN (library2, WebPAnimDecoderGetInfo); LOAD_DLL_FN (library2, WebPAnimDecoderGetNext); LOAD_DLL_FN (library2, WebPAnimDecoderNewInternal); - LOAD_DLL_FN (library2, WebPAnimDecoderOptionsInitInternal); LOAD_DLL_FN (library2, WebPAnimDecoderHasMoreFrames); + LOAD_DLL_FN (library2, WebPAnimDecoderReset); + LOAD_DLL_FN (library2, WebPAnimDecoderGetDemuxer); LOAD_DLL_FN (library2, WebPAnimDecoderDelete); return true; } -#undef WebPGetInfo #undef WebPGetFeatures #undef WebPDecodeRGBA #undef WebPDecodeRGB #undef WebPFree #undef WebPDemuxGetI -#undef WebPDemux -#undef WebPDemuxDelete +#undef WebPAnimDecoderGetInfo #undef WebPAnimDecoderGetNext #undef WebPAnimDecoderNew -#undef WebPAnimDecoderOptionsInit #undef WebPAnimDecoderHasMoreFrames +#undef WebPAnimDecoderReset +#undef WebPAnimDecoderGetDemuxer #undef WebPAnimDecoderDelete -#define WebPGetInfo fn_WebPGetInfo #define WebPGetFeatures(d,s,f) \ fn_WebPGetFeaturesInternal(d,s,f,WEBP_DECODER_ABI_VERSION) #define WebPDecodeRGBA fn_WebPDecodeRGBA #define WebPDecodeRGB fn_WebPDecodeRGB #define WebPFree fn_WebPFree #define WebPDemuxGetI fn_WebPDemuxGetI -#define WebPDemux(d) \ - fn_WebPDemuxInternal(d,0,NULL,WEBP_DEMUX_ABI_VERSION) -#define WebPDemuxDelete fn_WebPDemuxDelete +#define WebPAnimDecoderGetInfo fn_WebPAnimDecoderGetInfo #define WebPAnimDecoderGetNext fn_WebPAnimDecoderGetNext #define WebPAnimDecoderNew(d,o) \ fn_WebPAnimDecoderNewInternal(d,o,WEBP_DEMUX_ABI_VERSION) -#define WebPAnimDecoderOptionsInit(o) \ - fn_WebPAnimDecoderOptionsInitInternal(o,WEBP_DEMUX_ABI_VERSION) #define WebPAnimDecoderHasMoreFrames fn_WebPAnimDecoderHasMoreFrames +#define WebPAnimDecoderReset fn_WebPAnimDecoderReset +#define WebPAnimDecoderGetDemuxer fn_WebPAnimDecoderGetDemuxer #define WebPAnimDecoderDelete fn_WebPAnimDecoderDelete #endif /* WINDOWSNT */ +/* Release webp_anim_handle resources. */ static void -webp_destroy (struct anim_cache* cache) +webp_destroy (union anim_handle *handle) { - WebPAnimDecoderDelete (cache->handle); + struct webp_anim_handle *h = &handle->webp; + WebPAnimDecoderDelete (h->dec); + h->dec = NULL; + xfree (h->contents); + h->contents = NULL; + h->timestamp = 0; } /* Load WebP image IMG for use on frame F. Value is true if @@ -10475,171 +10511,228 @@ webp_destroy (struct anim_cache* cache) static bool webp_load (struct frame *f, struct image *img) { + /* Return value. */ + bool success = false; + /* Owned copies and borrowed views of input WebP bitstream data and + decoded image/frame, respectively. IOW, contents_cpy and + decoded_cpy must always be freed, and contents and decoded must + never be freed. */ + uint8_t *contents_cpy = NULL; + uint8_t const *contents = NULL; + uint8_t *decoded_cpy = NULL; + uint8_t *decoded = NULL; + + /* Non-nil :index suggests the image is animated; check the cache. */ + Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); + struct anim_cache *cache = (NILP (image_number) ? NULL + : anim_get_animation_cache (XCDR (img->spec))); + struct webp_anim_handle *anim_handle = cache ? &cache->handle.webp : NULL; + + /* Image spec inputs. */ + Lisp_Object specified_data = Qnil; + Lisp_Object specified_file = Qnil; + /* Size of WebP contents. */ ptrdiff_t size = 0; - uint8_t *contents; - Lisp_Object file = Qnil; - int frames = 0; - double delay = 0; - WebPAnimDecoder* anim = NULL; + /* WebP features parsed from bitstream headers. */ + WebPBitstreamFeatures features = { 0 }; - /* Open the WebP file. */ - Lisp_Object specified_file = image_spec_value (img->spec, QCfile, NULL); - Lisp_Object specified_data = image_spec_value (img->spec, QCdata, NULL); - - if (NILP (specified_data)) + if (! (anim_handle && anim_handle->dec)) + /* If there is no cache entry, read in image contents. */ { - contents = (uint8_t *) slurp_image (specified_file, &size, "WebP"); - if (contents == NULL) - return false; - } - else - { - if (!STRINGP (specified_data)) + specified_data = image_spec_value (img->spec, QCdata, NULL); + if (NILP (specified_data)) + { + /* Open the WebP file. */ + specified_file = image_spec_value (img->spec, QCfile, NULL); + contents_cpy = (uint8_t *) slurp_image (specified_file, + &size, "WebP"); + if (!contents_cpy) + goto cleanup; + contents = contents_cpy; + } + else if (STRINGP (specified_data)) + { + contents = SDATA (specified_data); + size = SBYTES (specified_data); + } + else { image_invalid_data_error (specified_data); - return false; + goto cleanup; } - contents = SDATA (specified_data); - size = SBYTES (specified_data); - } - /* Validate the WebP image header. */ - if (!WebPGetInfo (contents, size, NULL, NULL)) - { - if (!NILP (file)) - image_error ("Not a WebP file: `%s'", file); - else - image_error ("Invalid header in WebP image data"); - goto webp_error1; - } - - Lisp_Object image_number = image_spec_value (img->spec, QCindex, NULL); - ptrdiff_t idx = FIXNUMP (image_number) ? XFIXNAT (image_number) : 0; - - /* Get WebP features. */ - WebPBitstreamFeatures features; - VP8StatusCode result = WebPGetFeatures (contents, size, &features); - switch (result) - { - case VP8_STATUS_OK: - break; - case VP8_STATUS_NOT_ENOUGH_DATA: - case VP8_STATUS_OUT_OF_MEMORY: - case VP8_STATUS_INVALID_PARAM: - case VP8_STATUS_BITSTREAM_ERROR: - case VP8_STATUS_UNSUPPORTED_FEATURE: - case VP8_STATUS_SUSPENDED: - case VP8_STATUS_USER_ABORT: - default: - /* Error out in all other cases. */ - if (!NILP (file)) - image_error ("Error when interpreting WebP image data: `%s'", file); - else - image_error ("Error when interpreting WebP image data"); - goto webp_error1; - } - - uint8_t *decoded = NULL; - int width, height; - - if (features.has_animation) - { - /* Animated image. */ - int timestamp; - - struct anim_cache* cache = anim_get_animation_cache (XCDR (img->spec)); - /* Get the next frame from the animation cache. */ - if (cache->handle && cache->index == idx - 1) + /* Get WebP features. This can return various error codes while + validating WebP headers, but we (currently) only distinguish + success. */ + if (WebPGetFeatures (contents, size, &features) != VP8_STATUS_OK) { - WebPAnimDecoderGetNext (cache->handle, &decoded, ×tamp); - delay = timestamp; - cache->index++; - anim = cache->handle; - width = cache->width; - height = cache->height; - frames = cache->frames; + image_error (NILP (specified_data) + ? "Error parsing WebP headers from file: `%s'" + : "Error parsing WebP headers from image data", + specified_file); + goto cleanup; + } + } + + /* Dimensions of still image or animation frame. */ + int width = -1; + int height = -1; + /* Number of animation frames. */ + int frames = -1; + /* Current animation frame's duration in ms. */ + int duration = -1; + + if ((anim_handle && anim_handle->dec) || features.has_animation) + /* Animated image. */ + { + if (!cache) + /* If the lookup was initially skipped due to the absence of an + :index, do it now. */ + { + cache = anim_get_animation_cache (XCDR (img->spec)); + anim_handle = &cache->handle.webp; + } + + if (anim_handle->dec) + /* If WebPGetFeatures was skipped, get the already parsed + features from the cached decoder. */ + { + WebPDemuxer const *dmux + = WebPAnimDecoderGetDemuxer (anim_handle->dec); + uint32_t const flags = WebPDemuxGetI (dmux, WEBP_FF_FORMAT_FLAGS); + features.has_alpha = !!(flags & ALPHA_FLAG); + features.has_animation = !!(flags & ANIMATION_FLAG); } else + /* If there was no decoder in the cache, create one now. */ { - /* Start a new cache entry. */ - if (cache->handle) - WebPAnimDecoderDelete (cache->handle); + /* If the data is from a Lisp string, copy it over so that it + doesn't get garbage-collected. If it's fresh from a file, + then another copy isn't needed to keep it alive. Either + way, ownership transfers to the anim cache which frees + memory during pruning. */ + anim_handle->contents = (STRINGP (specified_data) + ? (uint8_t *) xlispstrdup (specified_data) + : contents_cpy); + contents_cpy = NULL; + contents = anim_handle->contents; + cache->destructor = webp_destroy; - WebPData webp_data; - if (NILP (specified_data)) - /* If we got the data from a file, then we don't need to - copy the data. */ - webp_data.bytes = cache->temp = contents; - else - /* We got the data from a string, so copy it over so that - it doesn't get garbage-collected. */ + /* The WebPData docs can be interpreted as requiring it be + allocated, initialized, and cleared via its dedicated API. + However that seems to apply mostly to the mux API that we + don't use; the demux API we use treats WebPData as + read-only POD, so this should be fine. */ + WebPData const webp_data = { .bytes = contents, .size = size }; + /* We could ask for multithreaded decoding here. */ + anim_handle->dec = WebPAnimDecoderNew (&webp_data, NULL); + if (!anim_handle->dec) { - webp_data.bytes = xmalloc (size); - memcpy ((void*) webp_data.bytes, contents, size); + image_error (NILP (specified_data) + ? "Error parsing WebP file: `%s'" + : "Error parsing WebP image data", + specified_file); + goto cleanup; } - /* In any case, we release the allocated memory when we - purge the anim cache. */ - webp_data.size = size; - - /* This is used just for reporting by `image-cache-size'. */ - cache->byte_size = size; /* Get the width/height of the total image. */ - WebPDemuxer* demux = WebPDemux (&webp_data); - cache->width = width = WebPDemuxGetI (demux, WEBP_FF_CANVAS_WIDTH); - cache->height = height = WebPDemuxGetI (demux, - WEBP_FF_CANVAS_HEIGHT); - cache->frames = frames = WebPDemuxGetI (demux, WEBP_FF_FRAME_COUNT); - cache->destructor = (void (*)(void *)) webp_destroy; - WebPDemuxDelete (demux); + WebPAnimInfo info; + if (!WebPAnimDecoderGetInfo (anim_handle->dec, &info)) + { + image_error (NILP (specified_data) + ? ("Error getting global animation info " + "from WebP file: `%s'") + : ("Error getting global animation info " + "from WebP image data"), + specified_file); + goto cleanup; + } - WebPAnimDecoderOptions dec_options; - WebPAnimDecoderOptionsInit (&dec_options); - anim = WebPAnimDecoderNew (&webp_data, &dec_options); + /* Other libwebp[demux] APIs (and WebPAnimInfo internally) + store these values as int, so this should be safe. */ + cache->width = info.canvas_width; + cache->height = info.canvas_height; + cache->frames = info.frame_count; + /* This is used just for reporting by `image-cache-size'. */ + cache->byte_size = size; + } - cache->handle = anim; - cache->index = idx; + width = cache->width; + height = cache->height; + frames = cache->frames; - while (WebPAnimDecoderHasMoreFrames (anim)) { - WebPAnimDecoderGetNext (anim, &decoded, ×tamp); - /* Each frame has its own delay, but we don't really support - that. So just use the delay from the first frame. */ - if (delay == 0) - delay = timestamp; - /* Stop when we get to the desired index. */ - if (idx-- == 0) - break; - } + /* Desired frame number. */ + EMACS_INT idx = (FIXNUMP (image_number) + ? min (XFIXNAT (image_number), frames) : 0); + if (cache->index >= idx) + /* The decoder cannot rewind (nor be queried for the last + frame's decoded pixels and timestamp), so restart from + the first frame. We could avoid restarting when + cache->index == idx by adding more fields to + webp_anim_handle, but it may not be worth it. */ + { + WebPAnimDecoderReset (anim_handle->dec); + anim_handle->timestamp = 0; + cache->index = -1; + } + + /* Decode until desired frame number. */ + for (; + (cache->index < idx + && WebPAnimDecoderHasMoreFrames (anim_handle->dec)); + cache->index++) + { + int timestamp; + if (!WebPAnimDecoderGetNext (anim_handle->dec, &decoded, ×tamp)) + { + image_error (NILP (specified_data) + ? "Error decoding frame #%d from WebP file: `%s'" + : "Error decoding frame #%d from WebP image data", + cache->index + 1, specified_file); + goto cleanup; + } + eassert (anim_handle->timestamp >= 0); + eassert (timestamp >= anim_handle->timestamp); + duration = timestamp - anim_handle->timestamp; + anim_handle->timestamp = timestamp; } } else + /* Non-animated image. */ { - /* Non-animated image. */ + /* Could performance be improved by using the 'advanced' + WebPDecoderConfig API to request scaling/cropping as + appropriate for Emacs frame and image dimensions, + similarly to the SVG code? */ if (features.has_alpha) /* Linear [r0, g0, b0, a0, r1, g1, b1, a1, ...] order. */ - decoded = WebPDecodeRGBA (contents, size, &width, &height); + decoded_cpy = WebPDecodeRGBA (contents, size, &width, &height); else /* Linear [r0, g0, b0, r1, g1, b1, ...] order. */ - decoded = WebPDecodeRGB (contents, size, &width, &height); + decoded_cpy = WebPDecodeRGB (contents, size, &width, &height); + decoded = decoded_cpy; } if (!decoded) { - image_error ("Error when decoding WebP image data"); - goto webp_error1; + image_error (NILP (specified_data) + ? "Error decoding WebP file: `%s'" + : "Error decoding WebP image data", + specified_file); + goto cleanup; } if (!(width <= INT_MAX && height <= INT_MAX && check_image_size (f, width, height))) { image_size_error (); - goto webp_error2; + goto cleanup; } /* Create the x image and pixmap. */ Emacs_Pix_Container ximg; if (!image_create_x_image_and_pixmap (f, img, width, height, 0, &ximg, false)) - goto webp_error2; + goto cleanup; /* Find the background to use if the WebP image contains an alpha channel. */ @@ -10676,7 +10769,7 @@ webp_load (struct frame *f, struct image *img) img->corners[RIGHT_CORNER] = img->corners[LEFT_CORNER] + width; - uint8_t *p = decoded; + uint8_t const *p = decoded; for (int y = 0; y < height; ++y) { for (int x = 0; x < width; ++x) @@ -10684,7 +10777,7 @@ webp_load (struct frame *f, struct image *img) int r, g, b; /* The WebP alpha channel allows 256 levels of partial transparency. Blend it with the background manually. */ - if (features.has_alpha || anim) + if (features.has_alpha || features.has_animation) { float a = (float) p[3] / UINT8_MAX; r = (int)(a * p[0] + (1 - a) * bg_color.red) << 8; @@ -10714,29 +10807,31 @@ webp_load (struct frame *f, struct image *img) img->width = width; img->height = height; - /* Return animation data. */ - img->lisp_data = Fcons (Qcount, - Fcons (make_fixnum (frames), - img->lisp_data)); - img->lisp_data = Fcons (Qdelay, - Fcons (make_float (delay / 1000), - img->lisp_data)); + if (features.has_animation) + /* Return animation metadata. */ + { + eassert (frames > 0); + eassert (duration >= 0); + img->lisp_data = Fcons (Qcount, + Fcons (make_fixnum (frames), + img->lisp_data)); + /* WebP spec: interpretation of no/small frame duration is + implementation-defined. In practice browsers and libwebp tools + map small durations to 100ms to protect against annoying + images. For consistency across image types and user + configurability, we return a non-nil nonnumeric value that + image-multi-frame-p turns into image-default-frame-delay. */ + img->lisp_data + = Fcons (Qdelay, + Fcons (duration ? make_float (duration / 1000.0) : Qt, + img->lisp_data)); + } - /* Clean up. */ - if (!anim) - WebPFree (decoded); - if (NILP (specified_data) && !anim) - xfree (contents); - return true; - - webp_error2: - if (!anim) - WebPFree (decoded); - - webp_error1: - if (NILP (specified_data)) - xfree (contents); - return false; + success = true; + cleanup: + WebPFree (decoded_cpy); + xfree (contents_cpy); + return success; } #endif /* HAVE_WEBP */ @@ -12879,7 +12974,7 @@ static struct image_type const image_types[] = IMAGE_TYPE_INIT (init_xpm_functions) }, #endif #if defined HAVE_WEBP - { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image, + { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, gif_clear_image, IMAGE_TYPE_INIT (init_webp_functions) }, #endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, @@ -13159,7 +13254,6 @@ non-numeric, there is no explicit limit on the size of images. */); DEFSYM (QCanimate_buffer, ":animate-buffer"); DEFSYM (QCanimate_tardiness, ":animate-tardiness"); DEFSYM (QCanimate_position, ":animate-position"); - DEFSYM (QCanimate_multi_frame_data, ":animate-multi-frame-data"); defsubr (&Simage_transforms_p); From 2092516a74da7abb7ffeb3ba1ba14e0a79aaaca4 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 17 Jan 2026 11:55:46 +0100 Subject: [PATCH 274/325] Clarify libwebp configuration checks * configure.ac [HAVE_WEBP]: Explicitly check for both libwebpdemux and libwebp (where the former depends on the latter), since we use both (bug#57420, bug#61988, bug#66221). Check for WebPDecodeRGBA as a representative of libwebp and libwebpdecoder now that we no longer use WebPGetInfo elsewhere. Prepend WEBP_LIBS to LIBS as per AC_CHECK_LIB. Clarify commentary. --- configure.ac | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/configure.ac b/configure.ac index 4615717094b..0d7c58d8020 100644 --- a/configure.ac +++ b/configure.ac @@ -3596,21 +3596,25 @@ if test "${with_webp}" != "no"; then || test "${HAVE_BE_APP}" = "yes" || test "${HAVE_PGTK}" = "yes" \ || test "${REALLY_ANDROID}" = "yes"; then WEBP_REQUIRED=0.6.0 - WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED" + # Definitions from webp/decode.h are in libwebp, and those from + # webp/demux.h in libwebpdemux, which depends on libwebp. + WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED libwebp >= $WEBP_REQUIRED" EMACS_CHECK_MODULES([WEBP], [$WEBP_MODULE]) - # WebPGetInfo is sometimes not present inside libwebpdemux, so - # if it does not link, also check for libwebpdecoder. + # If for some reason we still don't have functions from + # webp/decode.h, try libwebpdecoder as well, which is the + # decoder-only subset of libwebp (bug#61988, bug#66221). OLD_CFLAGS=$CFLAGS OLD_LIBS=$LIBS CFLAGS="$CFLAGS $WEBP_CFLAGS" - LIBS="$LIBS $WEBP_LIBS" + LIBS="$WEBP_LIBS $LIBS" AS_IF([test "$REALLY_ANDROID" != "yes"], [ - AC_CHECK_FUNC([WebPGetInfo], [], - [WEBP_MODULE="$WEBP_MODULE libwebpdecoder >= $WEBP_REQUIRED" + AC_CHECK_FUNC([WebPDecodeRGBA], [], + [WEBP_MODULE="libwebpdemux >= $WEBP_REQUIRED" + WEBP_MODULE="$WEBP_MODULE libwebpdecoder >= $WEBP_REQUIRED" HAVE_WEBP=no AS_UNSET([WEBP_LIBS]) AS_UNSET([WEBP_CFLAGS]) From df9f73839e85cff8185fe1142d75fb8f98ec0bb5 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Sat, 24 Jan 2026 19:47:32 +0100 Subject: [PATCH 275/325] ; * src/pdumper.c (dump_buffer): Update hash. This follows the commit of 2026-01-24 "Support cons cell for 'line-spacing'". --- src/pdumper.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/pdumper.c b/src/pdumper.c index 9b26c80a479..151c45b3348 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2808,7 +2808,7 @@ dump_obarray (struct dump_context *ctx, Lisp_Object object) static dump_off dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer) { -#if CHECK_STRUCTS && !defined HASH_buffer_E5E54A8C3F +#if CHECK_STRUCTS && !defined HASH_buffer_418DFE6359 # error "buffer changed. See CHECK_STRUCTS comment in config.h." #endif struct buffer munged_buffer = *in_buffer; From 0b4dbd631ef6be8641566e1226f18b0a8de20e6c Mon Sep 17 00:00:00 2001 From: Po Lu Date: Sun, 25 Jan 2026 11:18:50 +0800 Subject: [PATCH 276/325] Adjust Android build system for recent changes to package requirements * m4/ndk-build.m4 (ndk_package_map): Map libwebp to webp. --- m4/ndk-build.m4 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4 index 89ae6c54ff4..12135a0d501 100644 --- a/m4/ndk-build.m4 +++ b/m4/ndk-build.m4 @@ -77,7 +77,7 @@ AS_CASE(["$ndk_ABI"], # This is a map between pkg-config style package names and Android # ones. -ndk_package_map="libwebpdemux:webpdemux libxml-2.0:libxml2" +ndk_package_map="libwebpdemux:webpdemux libwebp:webp libxml-2.0:libxml2" ndk_package_map="$ndk_package_map sqlite3:libsqlite_static_minimal" ndk_package_map="$ndk_package_map MagickWand:libmagickwand-7 lcms2:liblcms2" From 6a071ad37327eb318a1d796dd6d7d9edffd82950 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Sun, 25 Jan 2026 09:43:47 +0100 Subject: [PATCH 277/325] Add 'select-frame-by-id' and 'undelete-frame-by-id' (Bug#80192) 'select-frame-by-id' will also undelete a deleted frame ID. * lisp/frame.el (select-frame-by-id, undelete-frame-by-id): New commands. (make-frame-ids-alist, frame-by-id, frame-id-live-p) (undelete-frame-id-index): New defuns. * etc/NEWS: Announce the commands. --- etc/NEWS | 6 +++- lisp/frame.el | 97 ++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 98 insertions(+), 5 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 465df9c4ddb..9d36f6c3d96 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -514,7 +514,6 @@ These are useful if you need to detect a cloned frame or undeleted frame in hooks like 'after-make-frame-functions' and 'server-after-make-frame-hook'. ---- *** Frames now have unique ids and the new function 'frame-id'. Each non-tooltip frame is assigned a unique integer id. This allows you to unambiguously identify frames even if they share the same name or @@ -522,6 +521,11 @@ title. When 'undelete-frame-mode' is enabled, each deleted frame's id is stored for resurrection. The function 'frame-id' returns a frame's id (in C, use the frame struct member 'id'). +*** New commands 'select-frame-by-id', 'undelete-frame-by-id'. +The command 'select-frame-by-id' selects a frame by ID and undeletes it +if deleted. The command 'undelete-frame-by-id' undeletes a frame by its +ID. When called interactively, both functions prompt for an ID. + ** Mode Line +++ diff --git a/lisp/frame.el b/lisp/frame.el index 5ccfac2cadc..1e2ae5ae73c 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1385,10 +1385,30 @@ defaults to the selected frame." (push (cons (frame-parameter frame 'name) frame) alist))) (nreverse alist))) +(defun frame--make-frame-ids-alist (&optional frame) + "Return alist of frame identifiers and frames starting with FRAME. +Visible or iconified frames on the same terminal as FRAME are listed +along with frames that are undeletable. Frames with a non-nil +`no-other-frame' parameter are not listed. The optional argument FRAME +must specify a live frame and defaults to the selected frame." + (let ((frames (frame-list-1 frame)) + (terminal (frame-parameter frame 'terminal)) + alist) + (dolist (frame frames) + (when (and (frame-visible-p frame) + (eq (frame-parameter frame 'terminal) terminal) + (not (frame-parameter frame 'no-other-frame))) + (push (cons (number-to-string (frame-id frame)) frame) alist))) + (dolist (elt undelete-frame--deleted-frames) + (push (cons (number-to-string (nth 3 elt)) nil) alist)) + (nreverse alist))) + (defvar frame-name-history nil) (defun select-frame-by-name (name) "Select the frame whose name is NAME and raise it. Frames on the current terminal are checked first. +Raise the frame and give it input focus. On a text terminal, the frame +will occupy the entire terminal screen after the next redisplay. If there is no frame by that name, signal an error." (interactive (let* ((frame-names-alist (make-frame-names-alist)) @@ -1396,9 +1416,7 @@ If there is no frame by that name, signal an error." (input (completing-read (format-prompt "Select Frame" default) frame-names-alist nil t nil 'frame-name-history))) - (if (= (length input) 0) - (list default) - (list input)))) + (list (if (zerop (length input)) default input)))) (select-frame-set-input-focus ;; Prefer frames on the current display. (or (cdr (assoc name (make-frame-names-alist))) @@ -1408,6 +1426,45 @@ If there is no frame by that name, signal an error." (throw 'done frame)))) (error "There is no frame named `%s'" name)))) +(defun frame-by-id (id) + "Return the live frame object associated with ID. +Return nil if ID is not found." + (seq-find + (lambda (frame) + (eq id (frame-id frame))) + (frame-list))) + +(defun frame-id-live-p (id) + "Return non-nil if ID is associated with a live frame object. +This is useful when you have a frame ID and a potentially dead frame +reference that may have been resurrected. Also see `frame-live-p'." + (frame-live-p (frame-by-id id))) + +(defun select-frame-by-id (id) + "Select the frame whose identifier is ID and raise it. +If the frame is undeletable, undelete it. +Frames on the current terminal are checked first. +Raise the frame and give it input focus. On a text terminal, the frame +will occupy the entire terminal screen after the next redisplay. +If there is no frame with that ID, signal an error." + (interactive + (let* ((frame-ids-alist (frame--make-frame-ids-alist)) + (default (car (car frame-ids-alist))) + (input (completing-read + (format-prompt "Select Frame by ID" default) + frame-ids-alist nil t))) + (list (string-to-number + (if (zerop (length input)) default input))))) + (unless (undelete-frame-by-id id 'noerror) + (select-frame-set-input-focus + ;; Prefer frames on the current display. + (or (cdr (assq id (frame--make-frame-ids-alist))) + (catch 'done + (dolist (frame (frame-list)) + (when (eq (frame-id frame) id) + (throw 'done frame)))) + (error "There is no frame with identifier `%S'" id))))) + ;;;; Background mode. @@ -3175,7 +3232,7 @@ frame. With a numerical prefix argument ARG between 1 and 16, where 1 is most recently deleted frame, undelete the ARGth deleted frame. When called from Lisp, returns the new frame. - +Return the undeleted frame, or nil if a frame was not undeleted. An undeleted frame retains its original frame ID. See `frame-id'." (interactive "P") (if (not undelete-frame-mode) @@ -3205,6 +3262,38 @@ An undeleted frame retains its original frame ID. See `frame-id'." (window-state-put (nth 2 frame-data) (frame-root-window frame) 'safe) (select-frame-set-input-focus frame) frame)))))))) + +(defun undelete-frame-id-index (id) + "Return an `undelete-frame' index, if ID is that of an undeletable frame. +Return nil if ID is not associated with an undeletable frame." + (catch :found + (seq-do-indexed + (lambda (frame-data index) + (when (eq id (nth 3 frame-data)) + (throw :found (1+ index)))) + undelete-frame--deleted-frames))) + +(defun undelete-frame-by-id (id &optional noerror) + "Undelete the frame with the matching ID. +Return the undeleted frame if the ID is that of an undeletable frame, +otherwise, signal an error. +If NOERROR is non-nil, do not signal an error, and return nil. +Also see `undelete-frame'." + (interactive + (let* ((candidates + (mapcar (lambda (elt) + (number-to-string (nth 3 elt))) + undelete-frame--deleted-frames)) + (default (car candidates)) + (input (completing-read + (format-prompt "Undelete Frame by ID" default) + candidates nil t))) + (list (string-to-number + (if (zerop (length input)) default input))))) + (if-let* ((index (undelete-frame-id-index id))) + (undelete-frame index) + (unless noerror + (error "There is no frame with identifier `%S'" id)))) ;;; Window dividers. (defgroup window-divider nil From bbf1aab7818b8f35f1c42aaa562cb1b3d9206fc0 Mon Sep 17 00:00:00 2001 From: Martin Rudalics Date: Sun, 25 Jan 2026 09:50:35 +0100 Subject: [PATCH 278/325] ; * src/buffer.h: Mention indirect buffers in 'buffer_window_count' comment --- src/buffer.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/buffer.h b/src/buffer.h index 403b249df6f..986cc6fbede 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -1457,7 +1457,9 @@ BUF_FETCH_CHAR_AS_MULTIBYTE (struct buffer *buf, ptrdiff_t pos) : UNIBYTE_TO_CHAR (BUF_FETCH_BYTE (buf, pos))); } -/* Return number of windows showing B. */ +/* Return number of windows showing B or a buffer that has B as its base + buffer. If B is an indirect buffer, this returns buffer_window_count + of its base buffer. */ INLINE int buffer_window_count (struct buffer *b) From 2d1d2a48d138f453e316ca11557e534d998d8ae0 Mon Sep 17 00:00:00 2001 From: "F. Moukayed" Date: Mon, 13 Oct 2025 19:58:00 +0200 Subject: [PATCH 279/325] Support `undo'ing user input after messages are received * lisp/net/rcirc.el (rcirc-update-prompt): Don't track undo info. (rcirc-send-input): Clear undo list after message is sent. (rcirc-update-undo-list): Add new function (copied from erc.el). (rcirc-print): Update (shift) undo list instead of clearing it. --- lisp/net/rcirc.el | 49 +++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 43 insertions(+), 6 deletions(-) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 0ffbc915448..c067c2472bb 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1567,7 +1567,8 @@ If ALL is non-nil, update prompts in all IRC buffers." (with-rcirc-process-buffer process (mapcar 'cdr rcirc-buffer-alist)))) (rcirc-process-list)) - (let ((inhibit-read-only t) + (let ((buffer-undo-list t) + (inhibit-read-only t) (prompt (or rcirc-prompt ""))) (mapc (lambda (rep) (setq prompt @@ -1719,6 +1720,8 @@ Create the buffer if it doesn't exist." rcirc-prompt-end-marker (point)))) (dolist (line (split-string input "\n")) (rcirc-process-input-line line)) + ;; reset undo data after input is sent + (setq buffer-undo-list nil) ;; add to input-ring (save-excursion (ring-insert rcirc-input-ring input) @@ -2004,6 +2007,30 @@ PROCESS is the process object for the current connection." (> last-activity-line 0)) (- rcirc-current-line last-activity-line)))) +;; Copied from lisp/erc/erc.el (erc-update-undo-list) +(defun rcirc-update-undo-list (shift) + "Translate buffer positions in buffer-undo-list by SHIFT." + (unless (or (zerop shift) (atom buffer-undo-list)) + (let ((list buffer-undo-list) elt) + (while list + (setq elt (car list)) + (cond ((integerp elt) ; POSITION + (incf (car list) shift)) + ((or (atom elt) ; nil, EXTENT + ;; (eq t (car elt)) ; (t . TIME) + (markerp (car elt))) ; (MARKER . DISTANCE) + nil) + ((integerp (car elt)) ; (BEGIN . END) + (incf (car elt) shift) + (incf (cdr elt) shift)) + ((stringp (car elt)) ; (TEXT . POSITION) + (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift))) + ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) + (let ((cons (nthcdr 3 elt))) + (incf (car cons) shift) + (incf (cdr cons) shift)))) + (setq list (cdr list)))))) + (defvar rcirc-markup-text-functions '(rcirc-markup-attributes rcirc-color-attributes @@ -2032,13 +2059,16 @@ connection." rcirc-ignore-list)) ;; do not ignore if we sent the message (not (string= sender (rcirc-nick process)))) - (let* ((buffer (rcirc-target-buffer process sender response target text)) + (let* (preinsert-prompt-end-position + (buffer (rcirc-target-buffer process sender response target text)) (time (if-let* ((time (rcirc-get-tag "time"))) (parse-iso8601-time-string time t) (current-time))) (inhibit-read-only t)) (with-current-buffer buffer - (let ((moving (= (point) rcirc-prompt-end-marker)) + (setq preinsert-prompt-end-position (marker-position rcirc-prompt-end-marker)) + (let ((buffer-undo-list t) + (moving (= (point) rcirc-prompt-end-marker)) (old-point (point-marker))) (setq text (decode-coding-string text rcirc-decode-coding-system)) @@ -2144,9 +2174,16 @@ connection." 0) (recenter -1))))))) - ;; flush undo (can we do something smarter here?) - (buffer-disable-undo) - (buffer-enable-undo) + ;; as text is inserted before the prompt - moving it further + ;; away - the undo data for user input beyond the prompt is + ;; invalidated + ;; + ;; attempt to fix the undo data by shifting the undo positions + ;; in the undo list by the prompt's "drift", i.e. the delta + ;; between the current and previous (pre-insertion) prompt + ;; position + (rcirc-update-undo-list (- rcirc-prompt-end-marker + preinsert-prompt-end-position)) ;; record mode line activity (when (and activity From bff916d7f9bfd2c464f0fe8a6a21618d1f8ba2ac Mon Sep 17 00:00:00 2001 From: Philip Kaludercic Date: Tue, 23 Dec 2025 19:24:18 +0100 Subject: [PATCH 280/325] Have default 'compile-command' run make in parallel * lisp/progmodes/compile.el (compile-command): Change default value. (Bug#80065) --- lisp/progmodes/compile.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index d90f65e1be1..d2e92d7da8b 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -954,7 +954,11 @@ The value nil as an element means to try the default directory." (string :tag "Directory")))) ;;;###autoload -(defcustom compile-command "make -k " +(defcustom compile-command + ;; Divide by less than 2 and round up to avoid using all processors on + ;; multi-core systems, but use at least one processor on a single-core + ;; system. + (format "make -k -j%d " (ceiling (num-processors) 1.5)) "Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. From 0fcf1003013bc6af86cb54773788747fbafc6f85 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 25 Jan 2026 12:32:24 +0100 Subject: [PATCH 281/325] Use a custom buffer name for package review diffs * lisp/emacs-lisp/package.el (package-review): Specify a buffer using 'diff-no-select' instead of falling back to the default "*Diff*". (Bug#80249) --- lisp/emacs-lisp/package.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 48252c2d5b8..407c4496d81 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -774,7 +774,11 @@ attached." (delete-directory pkg-dir t) (throw 'review-failed pkg-desc)) (?d - (diff (package-desc-dir old-desc) pkg-dir (cdr package-review-diff-command) t) + (display-buffer + (diff-no-select + (package-desc-dir old-desc) pkg-dir (cdr package-review-diff-command) t + (get-buffer-create (format "*Package Review Diff: %s*" + (package-desc-full-name pkg-desc))))) t) (?m (require 'diff) ;for `diff-no-select' From fd9d685c63697aa65121c6fabcb7333f5381b5bf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 23 Jan 2026 22:05:28 +0100 Subject: [PATCH 282/325] Neater pcase predicate transform Suggested by Stefan Monnier. * lisp/emacs-lisp/pcase.el (pcase--macroexpand): Simplify. * test/lisp/emacs-lisp/pcase-tests.el (pcase-pred-equiv): New test. --- lisp/emacs-lisp/pcase.el | 14 ++++++-------- test/lisp/emacs-lisp/pcase-tests.el | 18 ++++++++++++++++++ 2 files changed, 24 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 61b8f283bd2..7bb7d4a6b27 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -525,15 +525,13 @@ how many time this CODEGEN is called." (if (pcase--self-quoting-p pat) `',pat pat)) ((memq head '(guard quote)) pat) ((eq head 'pred) - ;; Ad-hoc expansion of some predicates that are the complement of another. + ;; Ad-hoc expansion of some predicates that are complements or aliases. ;; Not required for correctness but results in better code. - (let* ((expr (cadr pat)) - (compl (assq expr '((atom . consp) - (nlistp . listp) - (identity . null))))) - (cond (compl `(,head (not ,(cdr compl)))) - ((eq expr 'not) `(,head null)) ; normalise - (t pat)))) + (let ((equiv (assq (cadr pat) '((atom . (not consp)) + (nlistp . (not listp)) + (identity . (not null)) + (not . null))))) + (if equiv `(,head ,(cdr equiv)) pat))) ((memq head '(or and)) `(,head ,@(mapcar #'pcase--macroexpand (cdr pat)))) ((eq head 'app) `(app ,(nth 1 pat) ,(pcase--macroexpand (nth 2 pat)))) (t diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index e06c1e621c2..9b8a643c731 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -192,4 +192,22 @@ (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))) (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))))) +(ert-deftest pcase-pred-equiv () + (cl-flet ((f1 (x) (pcase x ((pred atom) 1) (_ 2)))) + (should (equal (f1 'a) 1)) + (should (equal (f1 nil) 1)) + (should (equal (f1 '(a)) 2))) + (cl-flet ((f2 (x) (pcase x ((pred nlistp) 1) (_ 2)))) + (should (equal (f2 'a) 1)) + (should (equal (f2 nil) 2)) + (should (equal (f2 '(a)) 2))) + (cl-flet ((f3 (x) (pcase x ((pred identity) 1) (_ 2)))) + (should (equal (f3 'a) 1)) + (should (equal (f3 nil) 2)) + (should (equal (f3 '(a)) 1))) + (cl-flet ((f4 (x) (pcase x ((pred not) 1) (_ 2)))) + (should (equal (f4 'a) 2)) + (should (equal (f4 nil) 1)) + (should (equal (f4 '(a)) 2)))) + ;;; pcase-tests.el ends here. From 446177ce252b84a93fb10ef50069d4290de7d4c9 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Sun, 25 Jan 2026 20:04:45 +0100 Subject: [PATCH 283/325] ; Update defcustom type of 'line-spacing' * lisp/cus-start.el: Update type of `line-spacing'. (Bug#76390) --- lisp/cus-start.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 3720e267f4e..14935632b4d 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -150,7 +150,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (scroll-down-aggressively windows (choice (const :tag "off" nil) float) "21.1") - (line-spacing display (choice (const :tag "none" nil) number) + (line-spacing display + (choice (const :tag "none" nil) + number + (cons number number)) "22.1") (cursor-in-non-selected-windows cursor ,cursor-type-types nil From 821928808c4558781c58ce3dc668ff4888fb393a Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Jan 2026 14:29:47 +0200 Subject: [PATCH 284/325] ; Improve last change * lisp/cus-start.el (line-spacing): Add :tag's. (Bug#76390) --- lisp/cus-start.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 14935632b4d..6761bc8bd3f 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -151,9 +151,10 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (choice (const :tag "off" nil) float) "21.1") (line-spacing display - (choice (const :tag "none" nil) - number - (cons number number)) + (choice (const :tag "No spacing" nil) + (number :tag "Spacing below") + (cons :tag "Spacing above and below" + number number)) "22.1") (cursor-in-non-selected-windows cursor ,cursor-type-types nil From d5a0dc0bade09cebbf34c13fe4e4f8dd7e308e2a Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 26 Jan 2026 14:45:48 +0100 Subject: [PATCH 285/325] Update TUTORIAL.translators * etc/tutorials/TUTORIAL.translators (Maintainer): Add myself as TUTORIAL.fr co-maintainer. --- etc/tutorials/TUTORIAL.translators | 1 + 1 file changed, 1 insertion(+) diff --git a/etc/tutorials/TUTORIAL.translators b/etc/tutorials/TUTORIAL.translators index e81e6c665f4..2b1444b13b8 100644 --- a/etc/tutorials/TUTORIAL.translators +++ b/etc/tutorials/TUTORIAL.translators @@ -39,6 +39,7 @@ Maintainer: Mohsen BANAN * TUTORIAL.fr: Author: Éric Jacoboni Maintainer: Éric Jacoboni + Bastien Guerry * TUTORIAL.he Author: Eli Zaretskii From 9983b189356756448882b934a5c3e9c61c5438e6 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Jan 2026 16:49:01 +0200 Subject: [PATCH 286/325] Fix point-adjustment when overlays are specific to windows * src/keyboard.c (adjust_point_for_property): Consider only overlays associated with the selected window. (Bug#80255) --- src/keyboard.c | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 6a4faa7aba7..0bf134961a3 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1789,7 +1789,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay - (make_fixnum (end), Qinvisible, Qnil, &overlay)) + (make_fixnum (end), Qinvisible, + selected_window, &overlay)) && (inv = TEXT_PROP_MEANS_INVISIBLE (val))) { ellipsis = ellipsis || inv > 1 @@ -1807,7 +1808,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) TEXT_PROP_MEANS_INVISIBLE (val)) #endif && !NILP (val = get_char_property_and_overlay - (make_fixnum (beg - 1), Qinvisible, Qnil, &overlay)) + (make_fixnum (beg - 1), Qinvisible, + selected_window, &overlay)) && (inv = TEXT_PROP_MEANS_INVISIBLE (val))) { ellipsis = ellipsis || inv > 1 @@ -1874,11 +1876,11 @@ adjust_point_for_property (ptrdiff_t last_pt, bool modified) could lead to an infinite loop. */ ; else if (val = Fget_pos_property (make_fixnum (PT), - Qinvisible, Qnil), + Qinvisible, selected_window), TEXT_PROP_MEANS_INVISIBLE (val) && (val = (Fget_pos_property (make_fixnum (PT == beg ? end : beg), - Qinvisible, Qnil)), + Qinvisible, selected_window)), !TEXT_PROP_MEANS_INVISIBLE (val))) (check_composition = check_display = true, SET_PT (PT == beg ? end : beg)); From 120a451c040011925c3c736058f2ce040e04d5fc Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 26 Jan 2026 10:14:03 -0500 Subject: [PATCH 287/325] (read_char_minibuf_menu_prompt): Fix bug#80146 * src/keyboard.c (read_char_minibuf_menu_prompt): Give priority to a binding in the map over the `menu_prompt_more_char` "binding". (follow_key): Move before new first use. --- src/keyboard.c | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/keyboard.c b/src/keyboard.c index 0bf134961a3..bc36d899250 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10118,6 +10118,13 @@ read_char_x_menu_prompt (Lisp_Object map, return Qnil ; } +static Lisp_Object +follow_key (Lisp_Object keymap, Lisp_Object key) +{ + return access_keymap (get_keymap (keymap, 0, 1), + key, 1, 0, 1); +} + static Lisp_Object read_char_minibuf_menu_prompt (int commandflag, Lisp_Object map) @@ -10329,7 +10336,10 @@ read_char_minibuf_menu_prompt (int commandflag, if (!FIXNUMP (obj) || XFIXNUM (obj) == -2 || (! EQ (obj, menu_prompt_more_char) && (!FIXNUMP (menu_prompt_more_char) - || ! BASE_EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char))))))) + || ! BASE_EQ (obj, make_fixnum (Ctl (XFIXNUM (menu_prompt_more_char)))))) + /* If 'menu_prompt_more_char' collides with a binding in the + map, gives precedence to the map's binding (bug#80146). */ + || !NILP (follow_key (map, obj))) { if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); @@ -10341,13 +10351,6 @@ read_char_minibuf_menu_prompt (int commandflag, /* Reading key sequences. */ -static Lisp_Object -follow_key (Lisp_Object keymap, Lisp_Object key) -{ - return access_keymap (get_keymap (keymap, 0, 1), - key, 1, 0, 1); -} - static Lisp_Object active_maps (Lisp_Object first_event, Lisp_Object second_event) { From 3dbddb4497c6571687c5c096e8f33daa4de04a79 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Mon, 26 Jan 2026 18:33:59 +0200 Subject: [PATCH 288/325] Fix image.c compilation when HAVE_GIF is not defined * src/image.c (gif_clear_image): Make it available for other image types. (Bug#80266) --- src/image.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/image.c b/src/image.c index 59be186a839..119287db899 100644 --- a/src/image.c +++ b/src/image.c @@ -9653,6 +9653,8 @@ static const struct image_keyword gif_format[GIF_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; +#endif + /* Free X resources of GIF image IMG which is used on frame F. Also used by other image types. */ @@ -9663,6 +9665,8 @@ gif_clear_image (struct frame *f, struct image *img) image_clear_image (f, img); } +#if defined (HAVE_GIF) + /* Return true if OBJECT is a valid GIF image specification. */ static bool From b224605d305f71c798877c4228afe18ded7a39ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Mon, 26 Jan 2026 22:56:33 +0000 Subject: [PATCH 289/325] Jsonrpc: avoid redisplay_internal calls from jsonrpc-request The 'jsonrpc-request' function, when called with non-nil CANCEL-ON-INPUT, relies on 'sit-for' to stop immediately when the user inputs something into Emacs. Although this behavior is working well, it has the hitherto undiscovered side effect of invoking 'redisplay_internal', which triggers expensive operations such as fontification. This bug was noticied when using the 'breadcrumb' package in conjunction with Eglot and a narrowed buffer. To provide breadcrumbs for the current context, breadcrumb.el invokes 'imenu--make-index-alist' on a timer. That function temporarily widens the buffer and then eventually calls 'redisplay_internal' (through 'eglot-imenu', 'jsonrpc-request', and 'sit-for'). This has the effect that the temporarily widened buffer is re-rendered and displayed to the user until the LSP server answers the request and 'imenu--make-index-alist' restores the restriction, an effect that lasts between 0.5 and 2 seconds usually and is annoying and confusing. To fix this, using a non-nil NODISP argument in the 'sit-for' is not enough (though it's arguable it should be and maybe that's a separate bug). Binding 'inhibit-redisplay' to 't' around 'sit-for' seems to fix the issue robustly. * lisp/jsonrpc.el (jsonrpc-request): Bind inhibit-redisplay to t and pass NODISP to sit-for. --- lisp/jsonrpc.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el index 74a59a04095..fca00dd2fc7 100644 --- a/lisp/jsonrpc.el +++ b/lisp/jsonrpc.el @@ -488,7 +488,8 @@ to the original request (normal or error) are ignored." ,@(when (plist-member args :timeout) `(:timeout ,timeout))))) (cond (cancel-on-input (unwind-protect - (let ((inhibit-quit t)) (while (sit-for 30))) + (let ((inhibit-quit t) (inhibit-redisplay t)) + (while (sit-for 30 t))) (setq canceled t)) (when (functionp cancel-on-input) (funcall cancel-on-input (car id-and-timer))) From 53305372d04b6e9463e22ea996b0d2e6b156fbb6 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Tue, 27 Jan 2026 11:01:35 +0800 Subject: [PATCH 290/325] ; Avoid warnings when neither GIF nor WebP are supported * src/image.c (gif_clear_image): Render contingent on HAVE_GIF || HAVE_WEBP. --- src/image.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/image.c b/src/image.c index 119287db899..5a4bc3024c3 100644 --- a/src/image.c +++ b/src/image.c @@ -9655,6 +9655,8 @@ static const struct image_keyword gif_format[GIF_LAST] = #endif +#if defined HAVE_GIF || defined HAVE_WEBP + /* Free X resources of GIF image IMG which is used on frame F. Also used by other image types. */ @@ -9665,6 +9667,8 @@ gif_clear_image (struct frame *f, struct image *img) image_clear_image (f, img); } +#endif /* defined HAVE_GIF || defined HAVE_WEBP */ + #if defined (HAVE_GIF) /* Return true if OBJECT is a valid GIF image specification. */ From 99abaa70bf99de7a2f150ac9bb1e62ca6ea4d6f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Tue, 27 Jan 2026 10:23:34 +0100 Subject: [PATCH 291/325] Document frame id related commands and tweak a return value (Bug#80192) * doc/lispref/frames.texi (Input Focus): Document the commands 'select-frame-by-id' and 'undelete-frame-by-id'. * lisp/frame.el (select-frame-by-id): Clarify return value and add missing optional argument 'noerror' in sympathy with 'undelete-frame-by-id'. --- doc/lispref/frames.texi | 24 ++++++++++++++++++++++++ lisp/frame.el | 25 +++++++++++++++---------- 2 files changed, 39 insertions(+), 10 deletions(-) diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index 5bf0bfc8c10..bdd79528cac 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -109,6 +109,7 @@ must be a root frame, which means it cannot be a child frame itself descending from it. @end defun +@cindex frame identifier @defun frame-id &optional frame This function returns the unique identifier of a frame, an integer, assigned to @var{frame}. If @var{frame} is @code{nil} or unspecified, @@ -3187,6 +3188,29 @@ could switch to a different terminal without switching back when you're done. @end deffn +@deffn Command select-frame-by-id id &optional noerror +This function searches open and undeletable frames for a matching frame +identifier @var{id} (@pxref{Frames}). If found, its frame is undeleted, +if necessary, then raised, given focus, and made the selected frame. On +a text terminal, raising a frame causes it to occupy the entire terminal +display. + +This function returns the selected frame or signals an error if @var{id} +is not found, unless @var{noerror} is non-@code{nil}, in which case it +returns @code{nil}. +@end deffn + +@deffn Command undelete-frame-by-id id &optional noerror +This function searches undeletable frames for a matching frame +identifier @var{id} (@pxref{Frames}). If found, its frame is undeleted, +raised, given focus, and made the selected frame. On a text terminal, +raising a frame causes it to occupy the entire terminal display. + +This function returns the undeleted frame or signals an error if +@var{id} is not found, unless @var{noerror} is non-@code{nil}, in which +case it returns @code{nil}. +@end deffn + @cindex text-terminal focus notification Emacs cooperates with the window system by arranging to select frames as the server and window manager request. When a window system diff --git a/lisp/frame.el b/lisp/frame.el index 1e2ae5ae73c..54502837bf6 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1440,13 +1440,14 @@ This is useful when you have a frame ID and a potentially dead frame reference that may have been resurrected. Also see `frame-live-p'." (frame-live-p (frame-by-id id))) -(defun select-frame-by-id (id) +(defun select-frame-by-id (id &optional noerror) "Select the frame whose identifier is ID and raise it. If the frame is undeletable, undelete it. Frames on the current terminal are checked first. Raise the frame and give it input focus. On a text terminal, the frame will occupy the entire terminal screen after the next redisplay. -If there is no frame with that ID, signal an error." +Return the selected frame or signal an error if no frame matching ID +was found. If NOERROR is non-nil, return nil instead." (interactive (let* ((frame-ids-alist (frame--make-frame-ids-alist)) (default (car (car frame-ids-alist))) @@ -1455,15 +1456,19 @@ If there is no frame with that ID, signal an error." frame-ids-alist nil t))) (list (string-to-number (if (zerop (length input)) default input))))) + ;; `undelete-frame-by-id' returns the undeleted frame, or nil. (unless (undelete-frame-by-id id 'noerror) - (select-frame-set-input-focus - ;; Prefer frames on the current display. - (or (cdr (assq id (frame--make-frame-ids-alist))) - (catch 'done - (dolist (frame (frame-list)) - (when (eq (frame-id frame) id) - (throw 'done frame)))) - (error "There is no frame with identifier `%S'" id))))) + ;; Prefer frames on the current display. + (if-let* ((found (or (cdr (assq id (frame--make-frame-ids-alist))) + (catch 'done + (dolist (frame (frame-list)) + (when (eq (frame-id frame) id) + (throw 'done frame))))))) + (progn + (select-frame-set-input-focus found) + found) + (unless noerror + (error "There is no frame with identifier `%S'" id))))) ;;;; Background mode. From 19cd6972faab7f63388359a87b11d00b9e718855 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Tue, 27 Jan 2026 15:05:49 +0100 Subject: [PATCH 292/325] ; * lisp/files.el (file-name-version-regexp): typo in doc string --- lisp/files.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/files.el b/lisp/files.el index ec5896e8731..d4b3dd490c5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5478,7 +5478,7 @@ BACKUPNAME is the backup file name, which is the old file renamed." (defvar file-name-version-regexp "\\(?:~\\|\\.~[-[:alnum:]:#@^._]+\\(?:~[[:digit:]]+\\)?~\\)" - ;; The last ~[[:digit]]+ matches relative versions in git, + ;; The last ~[[:digit:]]+ matches relative versions in git, ;; e.g. `foo.js.~HEAD~1~'. "Regular expression matching the backup/version part of a file name. Used by `file-name-sans-versions'.") From 4fae092e2d8b20471ee1b30bf7d30d26feef0bd0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Kryger?= Date: Fri, 23 Jan 2026 16:36:37 +0000 Subject: [PATCH 293/325] Ensure skipped package-vc-tests are not installed (bug#80235) * test/lisp/emacs-lisp/package-vc-tests.el (package-vc-tests-packages): Add argument `full'. When `full' is non-nil, then return full entries. (package-vc-test-deftest): Use `pkg-arg' for the name of argument `in-body'. Call `skip-when' and `skip-unless' before `packgage-vc-tests-with-installed'. --- test/lisp/emacs-lisp/package-vc-tests.el | 148 ++++++++++++----------- 1 file changed, 79 insertions(+), 69 deletions(-) diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 150d5c4a6e0..01c08ca7d3f 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -70,20 +70,21 @@ preserve all temporary directories.") (defvar package-vc-tests-repository) (eval-and-compile - (defun package-vc-tests-packages () + (defun package-vc-tests-packages (&optional full) "Return a list of package definitions to test. When variable `package-vc-tests-packages' is bound then return its -value. If `package-vc-tests-dir' is bound then each entry is in a form -of (PKG CHECKOUT-DIR LISP-DIR INSTALL-FUN), where PKG is a package -name (a symbol), CHECKOUT-DIR is an expected checkout directory, -LISP-DIR is a directory with package's sources (relative to +value. If `package-vc-tests-dir' is bound or FULL is non nil then each +entry is in a form of (PKG CHECKOUT-DIR LISP-DIR INSTALL-FUN), where PKG +is a package name (a symbol), CHECKOUT-DIR either is nil when +`package-vc-tests-dir' is not bound or is an expected checkout +directory, LISP-DIR is a directory with package's sources (relative to CHECKOUT-DIR), and INSTALL-FUN is a function that checkouts and install the package. Otherwise each entry is in a form of PKG." (if (boundp 'package-vc-tests-packages) package-vc-tests-packages (cl-macrolet ((test-package-def (pkg checkout-dir-exp lisp-dir install-fun) - `(if (boundp 'package-vc-tests-dir) + `(if (or (boundp 'package-vc-tests-dir) full) (list ',pkg (expand-file-name (symbol-name ',pkg) @@ -91,51 +92,54 @@ the package. Otherwise each entry is in a form of PKG." ,lisp-dir #',install-fun) ',pkg))) - (list - ;; checkout and install with `package-vc-install' (on ELPA) - (test-package-def - test-package-one package-user-dir nil - package-vc-tests-install-from-elpa) - ;; checkout and install with `package-vc-install' (not on ELPA) - (test-package-def - test-package-two package-user-dir nil - package-vc-tests-install-from-spec) - ;; checkout with `package-vc-checktout' and install with - ;; `package-vc-install-from-checkout' (on ELPA) - (test-package-def - test-package-three package-vc-tests-dir nil - package-vc-tests-checkout-from-elpa-install-from-checkout) - ;; checkout with git and install with - ;; `package-vc-install-from-checkout' - (test-package-def - test-package-four package-vc-tests-dir nil - package-vc-tests-checkout-with-git-install-from-checkout) - ;; sources in "lisp" sub directory, checkout and install with - ;; `package-vc-install' (not on ELPA) - (test-package-def - test-package-five package-user-dir "lisp" - package-vc-tests-install-from-spec) - ;; sources in "lisp" sub directory, checkout with git and - ;; install with `package-vc-install-from-checkout' - (test-package-def - test-package-six package-vc-tests-dir "lisp" - package-vc-tests-checkout-with-git-install-from-checkout) - ;; sources in "src" sub directory, checkout and install with - ;; `package-vc-install' (on ELPA) - (test-package-def - test-package-seven package-user-dir "src" - package-vc-tests-install-from-elpa) - ;; sources in "src" sub directory, checkout with - ;; `package-vc-checktout' and install with - ;; `package-vc-install-from-checkout' (on ELPA) - (test-package-def - test-package-eight package-vc-tests-dir nil - package-vc-tests-checkout-from-elpa-install-from-checkout) - ;; sources in "custom-dir" sub directory, checkout and install - ;; with `package-vc-install' (on ELPA) - (test-package-def - test-package-nine package-user-dir "custom-dir" - package-vc-tests-install-from-elpa)))))) + (let* ((tests-dir (bound-and-true-p package-vc-tests-dir)) + (user-dir (and tests-dir package-user-dir))) + (list + ;; checkout and install with `package-vc-install' (on ELPA) + (test-package-def + test-package-one user-dir nil + package-vc-tests-install-from-elpa) + ;; checkout and install with `package-vc-install' (not on + ;; ELPA) + (test-package-def + test-package-two user-dir nil + package-vc-tests-install-from-spec) + ;; checkout with `package-vc-checktout' and install with + ;; `package-vc-install-from-checkout' (on ELPA) + (test-package-def + test-package-three tests-dir nil + package-vc-tests-checkout-from-elpa-install-from-checkout) + ;; checkout with git and install with + ;; `package-vc-install-from-checkout' + (test-package-def + test-package-four tests-dir nil + package-vc-tests-checkout-with-git-install-from-checkout) + ;; sources in "lisp" sub directory, checkout and install with + ;; `package-vc-install' (not on ELPA) + (test-package-def + test-package-five user-dir "lisp" + package-vc-tests-install-from-spec) + ;; sources in "lisp" sub directory, checkout with git and + ;; install with `package-vc-install-from-checkout' + (test-package-def + test-package-six tests-dir "lisp" + package-vc-tests-checkout-with-git-install-from-checkout) + ;; sources in "src" sub directory, checkout and install with + ;; `package-vc-install' (on ELPA) + (test-package-def + test-package-seven user-dir "src" + package-vc-tests-install-from-elpa) + ;; sources in "src" sub directory, checkout with + ;; `package-vc-checktout' and install with + ;; `package-vc-install-from-checkout' (on ELPA) + (test-package-def + test-package-eight tests-dir nil + package-vc-tests-checkout-from-elpa-install-from-checkout) + ;; sources in "custom-dir" sub directory, checkout and + ;; install with `package-vc-install' (on ELPA) + (test-package-def + test-package-nine user-dir "custom-dir" + package-vc-tests-install-from-elpa))))))) ;; TODO: add test for deleting packages, with asserting ;; `package-vc-selected-packages' @@ -678,27 +682,33 @@ contains key `:tags' use its value as tests tags." (error "`package-vc' tests first argument has to be a symbol")) (let ((file (or (macroexp-file-name) buffer-file-name)) (tests '()) (fn (gensym)) + (pkg-arg (car args)) + (skip-forms (take-while (lambda (form) + (memq (car-safe form) '(skip-when + skip-unless))) + body)) (tags (plist-get (cdr-safe args) :tags))) + (setq body (nthcdr (length skip-forms) body)) (dolist (pkg (package-vc-tests-packages)) (let ((name (intern (format "package-vc-tests-%s/%s" name pkg)))) (push - `(ert-set-test - ',name - (make-ert-test - :name ',name - :tags (cons 'package-vc ',tags) - :file-name ,file - :body - (lambda () - (package-vc-tests-with-installed - ',pkg (funcall ,fn ',pkg)) - nil))) + `(ert-set-test ',name + (make-ert-test + :name ',name + :tags (cons 'package-vc ',tags) + :file-name ,file + :body + (lambda () + (funcall ,fn ',pkg) + nil))) tests))) - `(let ((,fn (lambda (,(car args)) - (cl-macrolet ((skip-when (form) `(ert--skip-when ,form)) - (skip-unless (form) `(ert--skip-unless ,form))) - (lambda () ,@body))))) - ,@tests))) + `(cl-macrolet ((skip-when (form) `(ert--skip-when ,form)) + (skip-unless (form) `(ert--skip-unless ,form))) + (let ((,fn (lambda (,pkg-arg) + ,@skip-forms + (package-vc-tests-with-installed ,pkg-arg + (lambda () ,@body))))) + ,@tests)))) (package-vc-test-deftest install-post-conditions (pkg) (let ((install-begin @@ -1006,7 +1016,7 @@ contains key `:tags' use its value as tests tags." (package-vc-test-deftest pkg-spec-make-shell-command (pkg) ;; Only `package-vc-install' runs make and shell command - (skip-unless (memq (caddr (alist-get pkg package-vc-tests-packages)) + (skip-unless (memq (caddr (alist-get pkg (package-vc-tests-packages t))) '(package-vc-tests-install-from-elpa package-vc-tests-install-from-spec))) (let* ((desc (package-vc-tests-package-desc pkg t)) @@ -1024,7 +1034,7 @@ contains key `:tags' use its value as tests tags." ;; Only `package-vc-install' builds info manuals, but only when ;; executable install-info is available. (skip-unless (and (executable-find "install-info") - (memq (caddr (alist-get pkg package-vc-tests-packages)) + (memq (caddr (alist-get pkg (package-vc-tests-packages t))) '(package-vc-tests-install-from-elpa package-vc-tests-install-from-spec)))) (should-not (package-vc-tests-log-buffer-exists 'doc pkg)) From 6e2a4b8111cfb5ee66bfe24bb8411aaac8cf0bf8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 27 Jan 2026 11:17:37 -0500 Subject: [PATCH 294/325] (pcase--subtype-bitsets): Make it a bit more precise `null`, `booleanp`, and `symbolp` were treated as equivalent in `pcase--subtype-bitsets`, which was not incorrect to the extent that we currently use this table only to detect mutual-exclusion, but made it incorrect to use that same table to test things like inclusion. * lisp/emacs-lisp/cl-preloaded.el (built-in-class): New slot `non-abstract-supertype`. (cl--define-built-in-type): Add corresponding keyword argument. (symbol, boolean): Use it. * lisp/emacs-lisp/pcase.el (pcase--subtype-bitsets): Use it. * lisp/emacs-lisp/cl-macs.el (cl--transform-lambda): Require `help` before calling `help--docstring-quote`. Fixes a corner case bootstrap problem found along the way. --- lisp/emacs-lisp/cl-macs.el | 19 +++++------ lisp/emacs-lisp/cl-preloaded.el | 24 +++++++++----- lisp/emacs-lisp/pcase.el | 56 ++++++++++++++++++++++----------- 3 files changed, 64 insertions(+), 35 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 989f8f5ce20..caa02fb24b2 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -327,15 +327,16 @@ FORM is of the form (ARGS . BODY)." ;; "manual" parsing. (let ((slen (length simple-args)) (usage-str - ;; Macro expansion can take place in the middle of - ;; apparently harmless computation, so it should not - ;; touch the match-data. - (save-match-data - (help--docstring-quote - (let ((print-gensym nil) (print-quoted t) - (print-escape-newlines t)) - (format "%S" (cons 'fn (cl--make-usage-args - orig-args)))))))) + ;; Macro expansion can take place in the middle of + ;; apparently harmless computation, so it should not + ;; touch the match-data. + (save-match-data + (require 'help) + (help--docstring-quote + (let ((print-gensym nil) (print-quoted t) + (print-escape-newlines t)) + (format "%S" (cons 'fn (cl--make-usage-args + orig-args)))))))) (when (memq '&optional simple-args) (decf slen)) (setq header diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index d75a32a8d4e..f6376fbd192 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -296,10 +296,11 @@ (cl-defstruct (built-in-class (:include cl--class) + (:conc-name built-in-class--) (:noinline t) (:constructor nil) (:constructor built-in-class--make - (name docstring parent-types + (name docstring parent-types &optional non-abstract-supertype &aux (parents (mapcar (lambda (type) (or (get type 'cl--class) @@ -308,7 +309,9 @@ (:copier nil)) "Type descriptors for built-in types. The `slots' (and hence `index-table') are currently unused." - ) + ;; As a general rule, built-in types are abstract if-and-only-if they have + ;; other built-in types as subtypes. But there are a few exceptions. + (non-abstract-supertype nil :read-only t)) (defmacro cl--define-built-in-type (name parents &optional docstring &rest slots) ;; `slots' is currently unused, but we could make it take @@ -322,19 +325,22 @@ The `slots' (and hence `index-table') are currently unused." (let ((predicate (intern-soft (format (if (string-match "-" (symbol-name name)) "%s-p" "%sp") - name)))) + name))) + (nas nil)) (unless (fboundp predicate) (setq predicate nil)) (while (keywordp (car slots)) (let ((kw (pop slots)) (val (pop slots))) (pcase kw (:predicate (setq predicate val)) + (:non-abstract-supertype (setq nas val)) (_ (error "Unknown keyword arg: %S" kw))))) `(progn ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate) ;; (message "Missing predicate for: %S" name) nil) (put ',name 'cl--class - (built-in-class--make ',name ,docstring ',parents))))) + (built-in-class--make ',name ,docstring ',parents + ,@(if nas '(t))))))) ;; FIXME: Our type DAG has various quirks: ;; - Some `keyword's are also `symbol-with-pos' but that's not reflected @@ -381,6 +387,7 @@ regardless if `funcall' would accept to call them." "Abstract supertype of both `number's and `marker's.") (cl--define-built-in-type symbol atom "Type of symbols." + :non-abstract-supertype t ;; Example of slots we could document. It would be desirable to ;; have some way to extract this from the C code, or somehow keep it ;; in sync (probably not for `cons' and `symbol' but for things like @@ -411,7 +418,8 @@ The size depends on the Emacs version and compilation options. For this build of Emacs it's %dbit." (1+ (logb (1+ most-positive-fixnum))))) (cl--define-built-in-type boolean (symbol) - "Type of the canonical boolean values, i.e. either nil or t.") + "Type of the canonical boolean values, i.e. either nil or t." + :non-abstract-supertype t) (cl--define-built-in-type symbol-with-pos (symbol) "Type of symbols augmented with source-position information.") (cl--define-built-in-type vector (array)) @@ -450,9 +458,9 @@ The fields are used as follows: 5 [iform] The interactive form (if present)") (cl--define-built-in-type byte-code-function (compiled-function closure) "Type of functions that have been byte-compiled.") -(cl--define-built-in-type subr (atom) - "Abstract type of functions compiled to machine code.") -(cl--define-built-in-type module-function (function) +(cl--define-built-in-type subr (atom) ;Beware: not always a function. + "Abstract type of functions and special forms compiled to machine code.") +(cl--define-built-in-type module-function (compiled-function) "Type of functions provided via the module API.") (cl--define-built-in-type interpreted-function (closure) "Type of functions that have not been compiled.") diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7bb7d4a6b27..6126679e870 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -662,13 +662,22 @@ recording whether the var has been referenced by earlier parts of the match." (lambda (x y) (> (length (nth 2 x)) (length (nth 2 y)))))) + ;; We presume that the "fundamental types" (i.e. the built-in types + ;; that have no subtypes) are all mutually exclusive and give them + ;; one bit each in bitsets. + ;; The "non-abstract-supertypes" also get their own bit. + ;; All other built-in types are abstract, so they don't need their + ;; own bits (they are faithfully modeled by the set of bits + ;; corresponding to their subtypes). (let ((bitsets (make-hash-table)) (i 1)) (dolist (x built-in-types) ;; Don't dedicate any bit to those predicates which already ;; have a bitset, since it means they're already represented ;; by their subtypes. - (unless (and (nth 1 x) (gethash (nth 1 x) bitsets)) + (unless (and (nth 1 x) (gethash (nth 1 x) bitsets) + (not (built-in-class--non-abstract-supertype + (get (nth 0 x) 'cl--class)))) (dolist (parent (nth 2 x)) (let ((pred (nth 1 (assq parent built-in-types)))) (unless (or (eq parent t) (null pred)) @@ -676,24 +685,35 @@ recording whether the var has been referenced by earlier parts of the match." bitsets)))) (setq i (+ i i)))) + ;; (cl-assert (= (1- i) (apply #'logior (map-values bitsets)))) + ;; Extra predicates that don't have matching types. - (dolist (pred-types '((functionp cl-functionp consp symbolp) - (keywordp symbolp) - (characterp fixnump) - (natnump integerp) - (facep symbolp stringp) - (plistp listp) - (cl-struct-p recordp) - ;; ;; FIXME: These aren't quite in the same - ;; ;; category since they'll signal errors. - (fboundp symbolp) - )) - (puthash (car pred-types) - (apply #'logior - (mapcar (lambda (pred) - (gethash pred bitsets)) - (cdr pred-types))) - bitsets)) + ;; Beware: For these predicates, the bitsets are conservative + ;; approximations (so, e.g., it wouldn't be correct to use one of + ;; them after a `!' since the negation would be an unsound + ;; under-approximation). + (let ((all (1- i))) + (dolist (pred-types '((functionp cl-functionp consp symbolp) + (keywordp symbolp) + (nlistp ! listp) + (characterp fixnump) + (natnump integerp) + (facep symbolp stringp) + (plistp listp) + (cl-struct-p recordp) + ;; ;; FIXME: These aren't quite in the same + ;; ;; category since they'll signal errors. + (fboundp symbolp) + )) + (let* ((types (cdr pred-types)) + (neg (when (eq '! (car types)) (setq types (cdr types)))) + (bitset (apply #'logior + (mapcar (lambda (pred) + (gethash pred bitsets)) + types)))) + (puthash (car pred-types) + (if neg (- all bitset) bitset) + bitsets)))) bitsets))) (defconst pcase--subtype-bitsets From 7fa90d50c6570e396f69c6b4ce0df68d6f79122d Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 27 Jan 2026 18:25:05 +0100 Subject: [PATCH 295/325] Organize tramp-adb-handle-make-process a little bit better * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): Call `tramp-taint-remote-process-buffer' where it belongs to. --- lisp/net/tramp-adb.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 1def3aa3791..5bcb92536fd 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -882,8 +882,8 @@ will be used." ;; is deleted. The temporary file will exist ;; until the process is deleted. (when (bufferp stderr) + (tramp-taint-remote-process-buffer stderr) (ignore-errors - (tramp-taint-remote-process-buffer stderr) (with-current-buffer stderr (insert-file-contents-literally remote-tmpstderr 'visit))) From 50bb4ae1eb8a4a2395e4bfd02130021e90d842ab Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 27 Jan 2026 18:39:47 +0100 Subject: [PATCH 296/325] ; * test/src/process-tests.el: Instrument for bug#80166. --- test/src/process-tests.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 2f3dd4b8043..29e9d3323ce 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -106,6 +106,9 @@ process to complete." (looking-at "hello stdout!"))) (should (with-current-buffer stderr-buffer (goto-char (point-min)) + ;; Instrument for bug#80166. + (when (getenv "EMACS_EMBA_CI") + (message "stderr\n%s" (buffer-string)) (looking-at "hello stderr!")))))) (ert-deftest process-test-stderr-filter () From d09cedc9bf2addd4ca0be7d63af8434067ab71bf Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 27 Jan 2026 18:49:37 +0100 Subject: [PATCH 297/325] ; Instrument filenotify test * test/lisp/filenotify-tests.el (file-notify-test08-backup): Instrument test. --- test/lisp/filenotify-tests.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 7a68e637653..fc826aba8d4 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -1256,6 +1256,10 @@ delivered." :tags '(:expensive-test) (skip-unless (file-notify--test-local-enabled)) + (let ((file-notify-debug ;; Temporarily. + (or file-notify-debug + (getenv "EMACS_EMBA_CI")))) + (with-file-notify-test (write-region "any text" nil file-notify--test-tmpfile nil 'no-message) (should @@ -1334,7 +1338,7 @@ delivered." (file-notify--rm-descriptor file-notify--test-desc) ;; The environment shall be cleaned up. - (file-notify--test-cleanup-p)))) + (file-notify--test-cleanup-p))))) (file-notify--deftest-remote file-notify-test08-backup "Check that backup keeps file notification for remote files.") From 32cffe17077b1bce3131e7b4606b8930c0e35bb7 Mon Sep 17 00:00:00 2001 From: Daniel Mendler Date: Wed, 28 Jan 2026 04:32:46 +0200 Subject: [PATCH 298/325] Customizable xref-references-in-directory backend Optionally use find and grep directly instead of going through the Semantic framework (bug#80246). * lisp/progmodes/project.el (project--vc-ignores): Require 'vc' to ensure that vc-default-ignore-completion-table is available. * lisp/progmodes/xref.el (xref-references-in-directory-function): New user option. (xref-references-in-directory): Call it. (xref-references-in-directory-grep): Implementation based on find/grep. (xref-references-in-directory-semantic): Implementation using Semantic. (xref-matches-in-directory): Add new argument DELIMITED. Co-authored-by: Dmitry Gutov --- lisp/progmodes/project.el | 1 + lisp/progmodes/xref.el | 44 ++++++++++++++++++++++++++++++++------- 2 files changed, 38 insertions(+), 7 deletions(-) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 35840024326..997c876b1fa 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -841,6 +841,7 @@ See `project-vc-extra-root-markers' for the marker value format.") (project--value-in-dir 'project-vc-ignores dir))) (defun project--vc-ignores (dir backend extra-ignores) + (require 'vc) (append (when backend (delq diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 22797335b10..df9e00a0d36 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -269,9 +269,7 @@ To create an xref object, call `xref-make'.") The result must be a list of xref objects. If no references can be found, return nil. -The default implementation uses `semantic-symref-tool-alist' to -find a search tool; by default, this uses \"find | grep\" in the -current project's main and external roots." +The default implementation uses `xref-references-in-directory'." (mapcan (lambda (dir) (message "Searching %s..." dir) @@ -1793,15 +1791,43 @@ and just use etags." (declare-function grep-expand-template "grep") (defvar ede-minor-mode) ;; ede.el +(defcustom xref-references-in-directory-function + #'xref-references-in-directory-semantic + "Function to find all references to a symbol in a directory. +It should take two string arguments: SYMBOL and DIR. +And return a list of xref values representing all code references to +SYMBOL in files under DIR." + :type '(choice + (const :tag "Using Grep via Find" xref-references-in-directory-grep) + (const :tag "Using Semantic Symbol Reference API" + xref-references-in-directory-semantic) + function) + :version "31.1") + ;;;###autoload (defun xref-references-in-directory (symbol dir) "Find all references to SYMBOL in directory DIR. +See `xref-references-in-directory-function' for the implementation. +Return a list of xref values." + (cl-assert (directory-name-p dir)) + (funcall xref-references-in-directory-function symbol dir)) + +(defun xref-references-in-directory-grep (symbol dir) + "Find all references to SYMBOL in directory DIR using find and grep. +Return a list of xref values. The files in DIR are filtered according +to its project's list of ignore patterns (as returned by +`project-ignores'), or the default ignores if there is no project." + (let ((ignores (project-ignores (project-current nil dir) dir))) + (xref-matches-in-directory (regexp-quote symbol) "*" dir ignores + 'symbol))) + +(defun xref-references-in-directory-semantic (symbol dir) + "Find all references to SYMBOL in directory DIR. Return a list of xref values. This function uses the Semantic Symbol Reference API, see `semantic-symref-tool-alist' for details on which tools are used, and when." - (cl-assert (directory-name-p dir)) (require 'semantic/symref) (defvar semantic-symref-tool) @@ -1831,12 +1857,13 @@ and when." "27.1") ;;;###autoload -(defun xref-matches-in-directory (regexp files dir ignores) +(defun xref-matches-in-directory (regexp files dir ignores &optional delimited) "Find all matches for REGEXP in directory DIR. Return a list of xref values. Only files matching some of FILES and none of IGNORES are searched. FILES is a string with glob patterns separated by spaces. -IGNORES is a list of glob patterns for files to ignore." +IGNORES is a list of glob patterns for files to ignore. +If DELIMITED is `symbol', only select matches that span full symbols." ;; DIR can also be a regular file for now; let's not advertise that. (grep-compute-defaults) (defvar grep-find-template) @@ -1855,6 +1882,9 @@ IGNORES is a list of glob patterns for files to ignore." (local-dir (directory-file-name (file-name-unquote (file-local-name (expand-file-name dir))))) + (hits-regexp (if (eq delimited 'symbol) + (format "\\_<%s\\_>" regexp) + regexp)) (buf (get-buffer-create " *xref-grep*")) (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) (status nil) @@ -1877,7 +1907,7 @@ IGNORES is a list of glob patterns for files to ignore." (concat local-dir (substring (match-string file-group) 1)) (buffer-substring-no-properties (point) (line-end-position))) hits))) - (xref--convert-hits (nreverse hits) regexp))) + (xref--convert-hits (nreverse hits) hits-regexp))) (define-obsolete-function-alias 'xref-collect-matches From 69dc5d3f0ed04d3c0b08b8e09efe62a279fa8962 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 28 Jan 2026 01:06:57 -0800 Subject: [PATCH 299/325] Fix tree-sitter traversal slowness (bug#80108) * configure.ac (LIBSYSTEMD_CFLAGS): Increase minimal required tree-sitter version to 0.20.10. * src/treesit.c (treesit_traverse_sibling_helper): When traversing forward, use the new function ts_tree_cursor_goto_previous_sibling. --- configure.ac | 32 ++++---------------------------- src/treesit.c | 48 ++++++------------------------------------------ 2 files changed, 10 insertions(+), 70 deletions(-) diff --git a/configure.ac b/configure.ac index 0d7c58d8020..420ab6dabe6 100644 --- a/configure.ac +++ b/configure.ac @@ -4069,39 +4069,15 @@ TREE_SITTER_OBJ= NEED_DYNLIB=no if test "${with_tree_sitter}" != "no"; then - dnl Tree-sitter 0.20.2 added support to change the malloc it uses - dnl at runtime, we need that feature. However, tree-sitter's - dnl Makefile has problems, until that's fixed, all tree-sitter - dnl libraries distributed are versioned 0.6.3. We try to - dnl accept a tree-sitter library that has incorrect version as long - dnl as it supports changing malloc. - EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.20.2], + dnl Tree-sitter 0.20.10 added ts_tree_cursor_goto_previous_sibling, we + dnl need it for a more efficient implementation for traversing the + dnl parse tree backwards (bug#80108). + EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.20.10], [HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no]) if test "${HAVE_TREE_SITTER}" = yes; then AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.]) NEED_DYNLIB=yes - else - EMACS_CHECK_MODULES([TREE_SITTER], [tree-sitter >= 0.6.3], - [HAVE_TREE_SITTER=yes], [HAVE_TREE_SITTER=no]) - if test "${HAVE_TREE_SITTER}" = yes; then - OLD_CFLAGS=$CFLAGS - OLD_LIBS=$LIBS - CFLAGS="$CFLAGS $TREE_SITTER_CFLAGS" - LIBS="$TREE_SITTER_LIBS $LIBS" - AC_CHECK_FUNCS([ts_set_allocator]) - CFLAGS=$OLD_CFLAGS - LIBS=$OLD_LIBS - if test "$ac_cv_func_ts_set_allocator" = yes; then - AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.]) - NEED_DYNLIB=yes - else - AC_MSG_ERROR([Tree-sitter library exists but its version is too old]); - TREE_SITTER_CFLAGS= - TREE_SITTER_LIBS= - fi - fi fi - # Windows loads tree-sitter dynamically if test "${opsys}" = "mingw32"; then TREE_SITTER_LIBS= diff --git a/src/treesit.c b/src/treesit.c index ae73885e71d..e9ae1ad3605 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -4278,50 +4278,14 @@ treesit_traverse_sibling_helper (TSTreeCursor *cursor, } else /* Backward. */ { - /* Go to first child and go through each sibling, until we find - the one just before the starting node. */ - TSNode start = ts_tree_cursor_current_node (cursor); - if (!ts_tree_cursor_goto_parent (cursor)) - return false; - treesit_assume_true (ts_tree_cursor_goto_first_child (cursor)); - - /* Now CURSOR is at the first child. If we started at the first - child, then there is no further siblings. */ - TSNode first_child = ts_tree_cursor_current_node (cursor); - if (ts_node_eq (first_child, start)) - return false; - - /* PROBE is always DELTA siblings ahead of CURSOR. */ - TSTreeCursor probe = ts_tree_cursor_copy (cursor); - /* This is position of PROBE minus position of CURSOR. */ - ptrdiff_t delta = 0; - TSNode probe_node; - TSNode cursor_node; - while (ts_tree_cursor_goto_next_sibling (&probe)) + if (!named) + return ts_tree_cursor_goto_previous_sibling (cursor); + /* Else named... */ + while (ts_tree_cursor_goto_previous_sibling (cursor)) { - /* Move PROBE forward, if it equals to the starting node, - CURSOR points to the node we want (prev valid sibling of - the starting node). */ - delta++; - probe_node = ts_tree_cursor_current_node (&probe); - - /* PROBE matched, depending on NAMED, return true/false. */ - if (ts_node_eq (probe_node, start)) - { - ts_tree_cursor_delete (&probe); - cursor_node = ts_tree_cursor_current_node (cursor); - ts_tree_cursor_delete (&probe); - return (!named || (named && ts_node_is_named (cursor_node))); - } - - /* PROBE didn't match, move CURSOR forward to PROBE's - position, but if we are looking for named nodes, only - move CURSOR to PROBE if PROBE is at a named node. */ - if (!named || (named && ts_node_is_named (probe_node))) - for (; delta > 0; delta--) - treesit_assume_true (ts_tree_cursor_goto_next_sibling (cursor)); + if (ts_node_is_named (ts_tree_cursor_current_node (cursor))) + return true; } - ts_tree_cursor_delete (&probe); return false; } } From 89dad017639265c313fd0e90f02e00c2a1cfea84 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Wed, 28 Jan 2026 09:01:42 +0100 Subject: [PATCH 300/325] ; Fix last change to test/src/process-tests.el. --- test/src/process-tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 29e9d3323ce..2cc5b37b187 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -108,7 +108,7 @@ process to complete." (goto-char (point-min)) ;; Instrument for bug#80166. (when (getenv "EMACS_EMBA_CI") - (message "stderr\n%s" (buffer-string)) + (message "stderr\n%s" (buffer-string))) (looking-at "hello stderr!")))))) (ert-deftest process-test-stderr-filter () From f9080e9bc08367b2bdc8779975dd7d7945f36859 Mon Sep 17 00:00:00 2001 From: "Basil L. Contovounesios" Date: Tue, 27 Jan 2026 15:13:15 +0100 Subject: [PATCH 301/325] Always unset lisp_data when freeing images Historically only the GIF code did this (since it stores animation metadata in lisp_data), and recently the WebP code followed suit. The benefit of clearing lisp_data is not 100% clear (to me: bug#66221#41), but it probably can't hurt, so do it unconditionally for all image types to simplify conditional compilation and avoid warnings (bug#80266). * src/image.c (image_clear_image): Set lisp_data to nil. [HAVE_GIF || HAVE_WEBP] (gif_clear_image): [HAVE_IMAGEMAGICK] (imagemagick_clear_image): Remove, replacing all uses with image_clear_image. --- src/image.c | 34 ++++------------------------------ 1 file changed, 4 insertions(+), 30 deletions(-) diff --git a/src/image.c b/src/image.c index 5a4bc3024c3..ccbf5db028f 100644 --- a/src/image.c +++ b/src/image.c @@ -2131,6 +2131,7 @@ image_clear_image_1 (struct frame *f, struct image *img, int flags) static void image_clear_image (struct frame *f, struct image *img) { + img->lisp_data = Qnil; block_input (); image_clear_image_1 (f, img, (CLEAR_IMAGE_PIXMAP @@ -9653,24 +9654,6 @@ static const struct image_keyword gif_format[GIF_LAST] = {":background", IMAGE_STRING_OR_NIL_VALUE, 0} }; -#endif - -#if defined HAVE_GIF || defined HAVE_WEBP - -/* Free X resources of GIF image IMG which is used on frame F. - Also used by other image types. */ - -static void -gif_clear_image (struct frame *f, struct image *img) -{ - img->lisp_data = Qnil; - image_clear_image (f, img); -} - -#endif /* defined HAVE_GIF || defined HAVE_WEBP */ - -#if defined (HAVE_GIF) - /* Return true if OBJECT is a valid GIF image specification. */ static bool @@ -10900,15 +10883,6 @@ static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] = {":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0} }; -/* Free X resources of imagemagick image IMG which is used on frame F. */ - -static void -imagemagick_clear_image (struct frame *f, - struct image *img) -{ - image_clear_image (f, img); -} - /* Return true if OBJECT is a valid IMAGEMAGICK image specification. Do this by calling parse_image_spec and supplying the keywords that identify the IMAGEMAGICK format. */ @@ -12954,7 +12928,7 @@ static struct image_type const image_types[] = #endif #ifdef HAVE_IMAGEMAGICK { SYMBOL_INDEX (Qimagemagick), imagemagick_image_p, imagemagick_load, - imagemagick_clear_image }, + image_clear_image }, #endif #ifdef HAVE_RSVG { SYMBOL_INDEX (Qsvg), svg_image_p, svg_load, image_clear_image, @@ -12965,7 +12939,7 @@ static struct image_type const image_types[] = IMAGE_TYPE_INIT (init_png_functions) }, #endif #if defined HAVE_GIF - { SYMBOL_INDEX (Qgif), gif_image_p, gif_load, gif_clear_image, + { SYMBOL_INDEX (Qgif), gif_image_p, gif_load, image_clear_image, IMAGE_TYPE_INIT (init_gif_functions) }, #endif #if defined HAVE_TIFF @@ -12982,7 +12956,7 @@ static struct image_type const image_types[] = IMAGE_TYPE_INIT (init_xpm_functions) }, #endif #if defined HAVE_WEBP - { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, gif_clear_image, + { SYMBOL_INDEX (Qwebp), webp_image_p, webp_load, image_clear_image, IMAGE_TYPE_INIT (init_webp_functions) }, #endif { SYMBOL_INDEX (Qxbm), xbm_image_p, xbm_load, image_clear_image }, From 8c84a2ae71665f0f45adfe96d55a66bd944d343c Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 28 Jan 2026 12:43:38 +0100 Subject: [PATCH 302/325] New Tramp test * test/lisp/net/tramp-tests.el (tramp-test45-force-remote-file-error): New test. --- test/lisp/net/tramp-tests.el | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 20e76e5fe9b..bbfe15d2f59 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -8259,6 +8259,42 @@ process sentinels. They shall not disturb each other." ;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests ;; 'unstable) +;; This test is inspired by Bug#49954 and Bug#60534. +(ert-deftest tramp-test45-force-remote-file-error () + "Force `remote-file-error'." + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) + ;; It shall run only if selected explicitly. + (skip-unless + (eq (ert--stats-selector ert--current-run-stats) + (ert-test-name (ert--stats-current-test ert--current-run-stats)))) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (let ((default-directory ert-remote-temporary-file-directory) + ;; Do not cache Tramp properties. + (remote-file-name-inhibit-cache t) + (p (start-file-process-shell-command + "test" (generate-new-buffer "test" 'inhibit-buffer-hooks) + "while true; do echo test; sleep 0.2; done"))) + + (set-process-filter + p (lambda (&rest _) + (message "filter %s" default-directory) + (directory-files default-directory) + (dired-uncache default-directory))) + + (run-at-time + 0 0.2 (lambda () + (message "timer %s" default-directory) + (directory-files default-directory) + (dired-uncache default-directory))) + + (while t + (accept-process-output) + (message "main %s" default-directory) + (directory-files default-directory) + (dired-uncache default-directory)))) + (ert-deftest tramp-test46-dired-compress-file () "Check that Tramp (un)compresses normal files." (skip-unless (tramp--test-enabled)) From 08b7739cf12a2a40f4445565f21e4fc3d4739b99 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Wed, 28 Jan 2026 14:09:12 +0200 Subject: [PATCH 303/325] ; Fix MS-Windows build broken by recent treesit.c changes * src/treesit.c (ts_tree_cursor_copy) [WINDOWSNT]: Remove, as it is no longer used. (ts_tree_cursor_goto_previous_sibling) [WINDOWSNT]: Add. (Bug#80108) --- src/treesit.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/treesit.c b/src/treesit.c index e9ae1ad3605..231da968fe1 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -81,11 +81,11 @@ along with GNU Emacs. If not, see . */ #undef ts_query_predicates_for_pattern #undef ts_query_string_value_for_id #undef ts_set_allocator -#undef ts_tree_cursor_copy #undef ts_tree_cursor_current_node #undef ts_tree_cursor_delete #undef ts_tree_cursor_goto_first_child #undef ts_tree_cursor_goto_first_child_for_byte +#undef ts_tree_cursor_goto_previous_sibling #undef ts_tree_cursor_goto_next_sibling #undef ts_tree_cursor_goto_parent #undef ts_tree_cursor_new @@ -153,12 +153,12 @@ DEF_DLL_FN (const char *, ts_query_string_value_for_id, (const TSQuery *, uint32_t, uint32_t *)); DEF_DLL_FN (void, ts_set_allocator, (void *(*)(size_t), void *(*)(size_t, size_t), void *(*)(void *, size_t), void (*)(void *))); -DEF_DLL_FN (TSTreeCursor, ts_tree_cursor_copy, (const TSTreeCursor *)); DEF_DLL_FN (TSNode, ts_tree_cursor_current_node, (const TSTreeCursor *)); DEF_DLL_FN (void, ts_tree_cursor_delete, (const TSTreeCursor *)); DEF_DLL_FN (bool, ts_tree_cursor_goto_first_child, (TSTreeCursor *)); DEF_DLL_FN (int64_t, ts_tree_cursor_goto_first_child_for_byte, (TSTreeCursor *, uint32_t)); DEF_DLL_FN (bool, ts_tree_cursor_goto_next_sibling, (TSTreeCursor *)); +DEF_DLL_FN (bool, ts_tree_cursor_goto_previous_sibling, (TSTreeCursor *)); DEF_DLL_FN (bool, ts_tree_cursor_goto_parent, (TSTreeCursor *)); DEF_DLL_FN (TSTreeCursor, ts_tree_cursor_new, (TSNode)); DEF_DLL_FN (void, ts_tree_delete, (TSTree *)); @@ -221,12 +221,12 @@ init_treesit_functions (void) LOAD_DLL_FN (library, ts_query_predicates_for_pattern); LOAD_DLL_FN (library, ts_query_string_value_for_id); LOAD_DLL_FN (library, ts_set_allocator); - LOAD_DLL_FN (library, ts_tree_cursor_copy); LOAD_DLL_FN (library, ts_tree_cursor_current_node); LOAD_DLL_FN (library, ts_tree_cursor_delete); LOAD_DLL_FN (library, ts_tree_cursor_goto_first_child); LOAD_DLL_FN (library, ts_tree_cursor_goto_first_child_for_byte); LOAD_DLL_FN (library, ts_tree_cursor_goto_next_sibling); + LOAD_DLL_FN (library, ts_tree_cursor_goto_previous_sibling); LOAD_DLL_FN (library, ts_tree_cursor_goto_parent); LOAD_DLL_FN (library, ts_tree_cursor_new); LOAD_DLL_FN (library, ts_tree_delete); @@ -283,12 +283,12 @@ init_treesit_functions (void) #define ts_query_predicates_for_pattern fn_ts_query_predicates_for_pattern #define ts_query_string_value_for_id fn_ts_query_string_value_for_id #define ts_set_allocator fn_ts_set_allocator -#define ts_tree_cursor_copy fn_ts_tree_cursor_copy #define ts_tree_cursor_current_node fn_ts_tree_cursor_current_node #define ts_tree_cursor_delete fn_ts_tree_cursor_delete #define ts_tree_cursor_goto_first_child fn_ts_tree_cursor_goto_first_child #define ts_tree_cursor_goto_first_child_for_byte fn_ts_tree_cursor_goto_first_child_for_byte #define ts_tree_cursor_goto_next_sibling fn_ts_tree_cursor_goto_next_sibling +#define ts_tree_cursor_goto_previous_sibling fn_ts_tree_cursor_goto_previous_sibling #define ts_tree_cursor_goto_parent fn_ts_tree_cursor_goto_parent #define ts_tree_cursor_new fn_ts_tree_cursor_new #define ts_tree_delete fn_ts_tree_delete From 43d6907ad9c8fae70d885132a552fe3672f498e8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 28 Jan 2026 16:13:47 +0000 Subject: [PATCH 304/325] Move outstanding changes commands from 'o' to 'T' The main reason for this is that then these commands can have the same bindings in VC-Dir buffers that they have under vc-prefix-map. 'T' is a good mnemonic for "Topic" and a serviceable mnemonic for "outsTanding". * lisp/vc/vc-hooks.el (vc-prefix-map): Move 'o' to 'T'. * lisp/vc/vc-dir.el (vc-dir-mode-map): New 'T' bindings. --- doc/emacs/maintaining.texi | 3 +++ doc/emacs/vc1-xtra.texi | 24 ++++++++++++------------ etc/NEWS | 3 ++- lisp/vc/vc-dir.el | 2 ++ lisp/vc/vc-hooks.el | 4 ++-- 5 files changed, 21 insertions(+), 15 deletions(-) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index f1090d4b43f..aebe31b478e 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1712,6 +1712,9 @@ Do an incremental regular expression search on the fileset Apart from acting on multiple files, these commands behave much like their single-buffer counterparts (@pxref{Search}). +@c Outstanding changes commands under 'T' are not mentioned because +@c these are an advanced feature documented only in vc1-xtra.texi. + The VC Directory buffer additionally defines some branch-related commands starting with the prefix @kbd{b}: diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 8ffd6506dbe..655402b61ba 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -298,11 +298,11 @@ yet merged into the target branch. @cindex outstanding changes @table @kbd -@item C-x v o = +@item C-x v T = Display diffs of changes to the VC fileset since the merge base of this branch and its upstream counterpart (@code{vc-diff-outgoing-base}). -@item C-x v o D +@item C-x v T D Display all changes since the merge base of this branch and its upstream counterpart (@code{vc-root-diff-outgoing-base}). @end table @@ -321,17 +321,17 @@ unpushed commits and uncommitted changes in your working tree. In many cases the reason these changes are not pushed yet is that they are not finished: the changes committed so far don't make sense in isolation. -@kindex C-x v o = +@kindex C-x v T = @findex vc-diff-outgoing-base -@kindex C-x v o D +@kindex C-x v T D @findex vc-root-diff-outgoing-base -Type @kbd{C-x v o D} (@code{vc-root-diff-outgoing-base}) to display a +Type @kbd{C-x v T D} (@code{vc-root-diff-outgoing-base}) to display a summary of all these changes, committed and uncommitted. This summary is in the form of a diff of what committing and pushing (@pxref{Pulling / Pushing}) all these changes would do to the upstream repository. You -can use @kbd{C-x v o =} (@code{vc-diff-outgoing-base}) instead to limit +can use @kbd{C-x v T =} (@code{vc-diff-outgoing-base}) instead to limit the display of changes to the current VC fileset. (The difference -between @w{@kbd{C-x v o D}} and @w{@kbd{C-x v o =}} is like the +between @w{@kbd{C-x v T D}} and @w{@kbd{C-x v T =}} is like the difference between @kbd{C-x v D} and @kbd{C-x v =} (@pxref{Old Revisions}).)@footnote{Another point of comparison is that these commands are like @w{@kbd{C-x v O =}} (@code{vc-fileset-diff-outgoing}) @@ -359,12 +359,12 @@ upstream repository's development trunk. That means committed changes on the topic branch that haven't yet been merged into the trunk, plus uncommitted changes. -When the current branch is a topic branch and you type @kbd{C-x v o D}, +When the current branch is a topic branch and you type @kbd{C-x v T D}, Emacs displays a summary of all the changes that are outstanding against the trunk to which the current branch will be merged. This summary is in the form of a diff of what committing and pushing all the changes, @emph{and} subsequently merging the topic branch, would do to the trunk. -As above, you can use @kbd{C-x v o =} instead to limit the display of +As above, you can use @kbd{C-x v T =} instead to limit the display of changes to the current VC fileset. This functionality relies on Emacs correctly detecting whether the @@ -379,7 +379,7 @@ The variables @code{vc-trunk-branch-regexps} and @code{vc-topic-branch-regexps} contain lists of regular expressions matching the names of branches that should always be considered trunk and topic branches, respectively. You can also specify prefix arguments -to @kbd{C-x v o D} and @kbd{C-x v o =}. Here is a summary of how to use +to @kbd{C-x v T D} and @kbd{C-x v T =}. Here is a summary of how to use these controls: @enumerate @@ -425,7 +425,7 @@ described. E.g., if the value of @code{vc-trunk-branch-regexps} is branch. @item -Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v o @dots{}}}, +Supply a double prefix argument, i.e. @w{@kbd{C-u C-u C-x v T @dots{}}}, and Emacs will treat the current branch as a trunk, no matter what. This is useful when you simply want to obtain a diff of all outgoing changes (@pxref{VC Change Log}) plus uncommitted changes. @@ -433,7 +433,7 @@ changes (@pxref{VC Change Log}) plus uncommitted changes. @item @cindex outgoing base, version control Finally, you can take full manual control by supplying a single prefix -argument, i.e. @w{@kbd{C-u C-x v o @dots{}}}. Emacs will prompt you for +argument, i.e. @w{@kbd{C-u C-x v T @dots{}}}. Emacs will prompt you for the @dfn{outgoing base}, which is the upstream location for which the changes are destined once they are no longer outstanding. diff --git a/etc/NEWS b/etc/NEWS index 9d36f6c3d96..65c8c62dec5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2746,11 +2746,12 @@ current VC fileset. +++ *** New commands to report diffs of outstanding changes. -'C-x v o =' ('vc-diff-outgoing-base') and 'C-x v o D' +'C-x v T =' ('vc-diff-outgoing-base') and 'C-x v T D' ('vc-root-diff-outgoing-base') report diffs of changes since the merge base with the remote branch, including uncommitted changes. They are useful to view all outstanding (unmerged, unpushed) changes on the current branch. +They are also available as 'T =' and 'T D' in VC-Dir buffers. +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 303cfd93ba2..b9176d8a2f6 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -397,6 +397,8 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and (define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp) (define-key map "G" #'vc-dir-ignore) (define-key map "@" #'vc-revert) + (define-key map "T=" #'vc-diff-outgoing-base) + (define-key map "TD" #'vc-root-diff-outgoing-base) (let ((branch-map (make-sparse-keymap))) (define-key map "b" branch-map) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index e867654409c..a6e07e02de9 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1018,8 +1018,8 @@ In the latter case, VC mode is deactivated for this buffer." "O" #'vc-root-log-outgoing "M L" #'vc-log-mergebase "M D" #'vc-diff-mergebase - "o =" #'vc-diff-outgoing-base - "o D" #'vc-root-diff-outgoing-base + "T =" #'vc-diff-outgoing-base + "T D" #'vc-root-diff-outgoing-base "m" #'vc-merge "r" #'vc-retrieve-tag "s" #'vc-create-tag From b370a076b92dae176d772ba70894b0f6e963bb1b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Kryger?= Date: Tue, 27 Jan 2026 11:45:28 +0000 Subject: [PATCH 305/325] Create package-vc-tests repositories once per tests run (bug#80235) * test/lisp/emacs-lisp/package-vc-tests.el (package-vc-tests-repos): New variable. (package-vc-tests-create-repository): Add argument `repos-dir'. (package-vc-tests-make-temp-dir): Create a temporary directory with prefix. (package-vc-with-tests-environment): Use `package-vc-tests-make-temp-dir' to create a temporary directory for package test. Use `package-vc-tests-repos' to cache test package repository. (package-vc-tests-preserve-pkg-artifacts-p): Detect when to preserve package temporary files. (package-vc-tests-environment-tear-down): Use `package-vc-tests-preserve-pkg-artifacts-p'. Use plural there are more than one buffer. Report temporary directory with test repository. (package-vc-tests-add-ert-run-tests-listener): Wrap listener in args with custom functionality for `package-vc-tests'. On tests run start reset `package-vc-tests-repos' cache. On tests run end delete temporary directories. --- test/lisp/emacs-lisp/package-vc-tests.el | 126 +++++++++++++++++------ 1 file changed, 97 insertions(+), 29 deletions(-) diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 01c08ca7d3f..38ecb338da5 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -65,6 +65,8 @@ of symbols, then preserve temporary directories and buffers for each package that matches a symbol in the list. When this variable is t then preserve all temporary directories.") +(defvar package-vc-tests-repos (make-hash-table)) + (defvar package-vc-tests-dir) (defvar package-vc-tests-packages) (defvar package-vc-tests-repository) @@ -169,12 +171,11 @@ When LISP-DIR is non-nil place the NAME file under LISP-DIR." (error "Failed to invoke sed on %s" in-file)) (vc-git-command nil 0 nil "add" "."))) -(defun package-vc-tests-create-repository (suffix &optional lisp-dir) - "Create a test package repository with SUFFIX. +(defun package-vc-tests-create-repository (suffix repos-dir &optional lisp-dir) + "Create a test package repository with SUFFIX in REPOS-DIR. If LISP-DIR is non-nil place sources of the package in LISP-DIR." (let* ((name (format "test-package-%s" suffix)) - (repo-dir (expand-file-name (file-name-concat "repo" name) - package-vc-tests-dir))) + (repo-dir (expand-file-name name repos-dir))) (make-directory (expand-file-name (or lisp-dir ".") repo-dir) t) (let ((default-directory repo-dir) (process-environment @@ -399,6 +400,11 @@ names." (not (member lisp-dir '("lisp" "src"))) (list :lisp-dir lisp-dir))))) +(defun package-vc-tests-make-temp-dir (prefix) + "Create temp directory with PREFIX." + (expand-file-name + (make-temp-file prefix t (format-time-string "-%Y%m%d.%H%M%S.%3N")))) + (defun package-vc-with-tests-environment (pkg function) "Call FUNCTION with no arguments within a test environment set up for PKG." ;; Create a test package sources repository, based on skeleton files @@ -406,10 +412,7 @@ names." ;; that: ;; (let* ((package-vc-tests-dir - (expand-file-name - (make-temp-file "package-vc-tests-" - t - (format-time-string "-%Y%m%d.%H%M%S.%3N")))) + (package-vc-tests-make-temp-dir "package-vc-tests-")) ;; - packages are installed into test directory (package-user-dir (expand-file-name "elpa" package-vc-tests-dir)) @@ -428,13 +431,25 @@ names." (package-vc-tests-packages (package-vc-tests-packages)) ;; - create a test package bundle (package-vc-tests-repository - (let* ((pkg-name (symbol-name pkg)) - (suffix (and (string-match - (rx ?- (group (1+ (not ?-))) eos) - pkg-name) - (match-string 1 pkg-name)))) - (package-vc-tests-create-repository - suffix (cadr (alist-get pkg package-vc-tests-packages))))) + (or + (gethash pkg package-vc-tests-repos) + (let* ((pkg-name (symbol-name pkg)) + (suffix (and (string-match + (rx ?- (group (1+ (not ?-))) eos) + pkg-name) + (match-string 1 pkg-name))) + (repos-dir + (or (gethash 'repos-dir package-vc-tests-repos) + (puthash 'repos-dir + (package-vc-tests-make-temp-dir + "package-vc-tests-repos-") + package-vc-tests-repos)))) + (puthash pkg + (package-vc-tests-create-repository + suffix + repos-dir + (cadr (alist-get pkg package-vc-tests-packages))) + package-vc-tests-repos)))) ;; - find all packages that are present in a test ELPA (package-vc-tests-elpa-packages (cl-loop @@ -495,6 +510,12 @@ names." (package-vc-allow-build-commands t)) (funcall function))) +(defun package-vc-tests-preserve-pkg-artifacts-p (pkg) + "Return non nil if files and buffers for PKG should be preserved." + (or (memq package-vc-tests-preserve-artifacts `(t ,pkg)) + (and (listp package-vc-tests-preserve-artifacts) + (memq pkg package-vc-tests-preserve-artifacts)))) + (defun package-vc-tests-environment-tear-down (pkg) "Tear down test environment for PKG. Unbind package defined symbols, and remove package defined features and @@ -538,27 +559,74 @@ when PKG matches `package-vc-tests-preserve-artifacts'." (package-vc-tests-log-buffer-name pkg type))) '(doc make))))) - (if (or (memq package-vc-tests-preserve-artifacts `(t ,pkg)) - (and (listp package-vc-tests-preserve-artifacts) - (memq pkg package-vc-tests-preserve-artifacts))) + (if (package-vc-tests-preserve-pkg-artifacts-p pkg) (let ((buffers - (mapconcat (lambda (buffer) - (with-current-buffer buffer - (let* ((old-name (buffer-name)) - (new-name (make-temp-name - (string-trim old-name)))) - (rename-buffer new-name) - (concat old-name " -> " new-name)))) - buffers - ", "))) + (if buffers + (format " and %s: %s" + (if (cdr buffers) "buffers" "buffer") + (mapconcat + (lambda (buffer) + (with-current-buffer buffer + (let* ((old-name (buffer-name)) + (new-name (make-temp-name + (string-trim old-name)))) + (rename-buffer new-name) + (format "`%s' -> `%s'" + old-name new-name)))) + buffers + ", ")) + "")) + (repo-dir (car (gethash pkg package-vc-tests-repos)))) (message - "package-vc-tests: preserving temporary directory: %s%s" + "package-vc-tests: preserving temporary %s: %s%s%s" + (if repo-dir "directories" "directory") package-vc-tests-dir - (and buffers (format " and buffers: %s" buffers)))) + (if repo-dir (format " and %s" repo-dir) "") + buffers)) (delete-directory package-vc-tests-dir t) (dolist (buffer buffers) (kill-buffer buffer))))) +;; Tests create a repository for a package only once per a tests run. +;; The repository location is cached in `package-vc-tests-repos'. To +;; support development, clear the cache on start of each tests run, such +;; that the package repository contains files from the source code. +;; When tests run completes delete repositories accounting for +;; `package-vc-tests-preserve-artifacts', which see. + +(defun package-vc-tests-add-ert-run-tests-listener (args) + "Add `package-vc-tests' repositories cleanup to listener in ARGS." + (if-let* ((listener (cadr args)) + ((functionp listener))) + (cl-list* + (car args) + (lambda (event-type &rest event-args) + (cl-case event-type + (run-started + (clrhash package-vc-tests-repos)) + (run-ended + (when-let* ((repos-dir (gethash 'repos-dir + package-vc-tests-repos)) + ((file-directory-p repos-dir))) + (if package-vc-tests-preserve-artifacts + (progn + (dolist (pkg (package-vc-tests-packages)) + (unless + (package-vc-tests-preserve-pkg-artifacts-p pkg) + (when-let* ((repo-dir + (car (gethash pkg package-vc-tests-repos))) + ((file-directory-p repo-dir))) + (delete-directory repo-dir t)))) + (when (directory-empty-p repos-dir) + (delete-directory repos-dir))) + (delete-directory repos-dir t))))) + (apply listener (cons event-type event-args))) + (drop 2 args)) + args)) + +(advice-add #'ert-run-tests + :filter-args #'package-vc-tests-add-ert-run-tests-listener) + (defun package-vc-tests-with-installed (pkg function) "Call FUNCTION with PKG installed in a test environment. FUNCTION should have no arguments." From fbe4d649c30234a143dc092ff4931e56f74de073 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 28 Jan 2026 13:43:36 -0500 Subject: [PATCH 306/325] (loaddefs-generate--make-autoload): Try harder to find `autoload-macro` * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--make-autoload): Try and (auto)load the macro in case that defines `autoload-macro`. Simplify the code for the `loaddefs--defining-macros` case. --- lisp/emacs-lisp/loaddefs-gen.el | 27 +++++++-------------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index ede9a9fe8a0..60d250b564f 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -155,7 +155,10 @@ scanning for autoloads and will be in the `load-path'." ;; employing :autoload-end to omit unneeded forms). (defconst loaddefs--defining-macros '( transient-define-prefix transient-define-suffix transient-define-infix - transient-define-argument transient-define-group)) + transient-define-argument + ;; FIXME: How can this one make sense? It doesn't put anything + ;; into `symbol-function'! + transient-define-group)) (defvar loaddefs--load-error-files nil) (defun loaddefs-generate--make-autoload (form file &optional expansion) @@ -237,7 +240,7 @@ expand)' among their `declare' forms." (push file loaddefs--load-error-files) ; do not attempt again (warn "loaddefs-gen: load error\n\t%s" e))))) (and (macrop car) - (eq 'expand (function-get car 'autoload-macro)) + (eq 'expand (function-get car 'autoload-macro 'macro)) (setq expand (let ((load-true-file-name file) (load-file-name file)) (macroexpand-1 form))) @@ -249,12 +252,7 @@ expand)' among their `declare' forms." ;; directly. ((memq car loaddefs--defining-macros) (let* ((name (nth 1 form)) - (args (pcase car - ((or 'transient-define-prefix 'transient-define-suffix - 'transient-define-infix 'transient-define-argument - 'transient-define-group) - (nth 2 form)) - (_ t))) + (args (nth 2 form)) (body (nthcdr (or (function-get car 'doc-string-elt) 3) form)) (doc (if (stringp (car body)) (pop body)))) ;; Add the usage form at the end where describe-function-1 @@ -263,18 +261,7 @@ expand)' among their `declare' forms." ;; `define-generic-mode' quotes the name, so take care of that (loaddefs-generate--shorten-autoload `(autoload ,(if (listp name) name (list 'quote name)) - ,file ,doc - ,(or (and (memq car '( transient-define-prefix - transient-define-suffix - transient-define-infix - transient-define-argument - transient-define-group)) - t) - (and (eq (car-safe (car body)) 'interactive) - ;; List of modes or just t. - (or (if (nthcdr 2 (car body)) - (list 'quote (nthcdr 2 (car body))) - t)))))))) + ,file ,doc t)))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) From d44b855b0ccb9d97261735316b25cbccbb150550 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 28 Jan 2026 21:55:40 +0200 Subject: [PATCH 307/325] xref-matches-in-directory: Don't error on "Binary file ... matches" * lisp/progmodes/xref.el (xref-matches-in-directory): Consider the "Binary file ... matches" message (bug#80246). --- lisp/progmodes/xref.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index df9e00a0d36..d2817a95b17 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1900,7 +1900,9 @@ If DELIMITED is `symbol', only select matches that span full symbols." ;; exit with non-zero. "No matches" and "Grep program not found" ;; are all the same to it. (when (and (/= (point-min) (point-max)) - (not (looking-at grep-re))) + (not (looking-at grep-re)) + ;; See also this check in `xref-matches-in-files'. + (not (looking-at ".*[bB]inary file.* matches"))) (user-error "Search failed with status %d: %s" status (buffer-string))) (while (re-search-forward grep-re nil t) (push (list (string-to-number (match-string line-group)) From dfc2a66ad8fc0892bbe66ddd32fec34d8dfa1821 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Wed, 28 Jan 2026 23:48:04 +0200 Subject: [PATCH 308/325] xref-matches-in-directory and xref-matches-in-files: More consistency * lisp/progmodes/xref.el (xref--parse-hits, xref--sort-hits): Extract from xref-matches-in-directory and xref-matches-in-files. Use in both for better consistency between these functions. --- lisp/progmodes/xref.el | 78 +++++++++++++++++++++--------------------- 1 file changed, 39 insertions(+), 39 deletions(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index d2817a95b17..d2dd4167725 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1894,22 +1894,9 @@ If DELIMITED is `symbol', only select matches that span full symbols." (setq default-directory dir) (setq status (process-file-shell-command command nil t)) - (goto-char (point-min)) - ;; Can't use the exit status: Grep exits with 1 to mean "no - ;; matches found". Find exits with 1 if any of the invocations - ;; exit with non-zero. "No matches" and "Grep program not found" - ;; are all the same to it. - (when (and (/= (point-min) (point-max)) - (not (looking-at grep-re)) - ;; See also this check in `xref-matches-in-files'. - (not (looking-at ".*[bB]inary file.* matches"))) - (user-error "Search failed with status %d: %s" status (buffer-string))) - (while (re-search-forward grep-re nil t) - (push (list (string-to-number (match-string line-group)) - (concat local-dir (substring (match-string file-group) 1)) - (buffer-substring-no-properties (point) (line-end-position))) - hits))) - (xref--convert-hits (nreverse hits) hits-regexp))) + (setq hits (xref--parse-hits grep-re line-group file-group status + local-dir))) + (xref--convert-hits (xref--sort-hits hits) hits-regexp))) (define-obsolete-function-alias 'xref-collect-matches @@ -2035,29 +2022,42 @@ to control which program to use when looking for matches." nil shell-command-switch command)))) - (goto-char (point-min)) - (when (and (/= (point-min) (point-max)) - (not (looking-at grep-re)) - ;; TODO: Show these matches as well somehow? - ;; Matching both Grep's and Ripgrep 13's messages. - (not (looking-at ".*[bB]inary file.* matches"))) - (user-error "Search failed with status %d: %s" status - (buffer-substring (point-min) (line-end-position)))) - (while (re-search-forward grep-re nil t) - (push (list (string-to-number (match-string line-group)) - (match-string file-group) - (buffer-substring-no-properties (point) (line-end-position))) - hits))) - ;; By default, ripgrep's output order is non-deterministic - ;; (https://github.com/BurntSushi/ripgrep/issues/152) - ;; because it does the search in parallel. - ;; Grep's output also comes out in seemingly arbitrary order, - ;; though stable one. Let's sort both for better UI. - (setq hits - (sort (nreverse hits) - (lambda (h1 h2) - (string< (cadr h1) (cadr h2))))) - (xref--convert-hits hits regexp))) + (setq hits (xref--parse-hits grep-re line-group file-group status))) + (xref--convert-hits (xref--sort-hits hits) regexp))) + +(defun xref--parse-hits ( grep-re line-group file-group status + &optional parent-dir) + (let (hits) + (goto-char (point-min)) + ;; Can't use the exit status: Grep exits with 1 to mean "no + ;; matches found". Find exits with 1 if any of the invocations + ;; exit with non-zero. "No matches" and "Grep program not found" + ;; are all the same to it. + (when (and (/= (point-min) (point-max)) + (not (looking-at grep-re)) + ;; TODO: Show these matches as well somehow? + ;; Matching both Grep's and Ripgrep 13's messages. + (not (looking-at ".*[bB]inary file.* matches"))) + (user-error "Search failed with status %d: %s" status + (buffer-substring (point-min) (line-end-position)))) + (while (re-search-forward grep-re nil t) + (push (list (string-to-number (match-string line-group)) + (if parent-dir + (concat parent-dir (substring (match-string file-group) 1)) + (match-string file-group)) + (buffer-substring-no-properties (point) (line-end-position))) + hits)) + (nreverse hits))) + +(defun xref--sort-hits (hits) + ;; By default, ripgrep's output order is non-deterministic + ;; (https://github.com/BurntSushi/ripgrep/issues/152) + ;; because it does the search in parallel. + ;; Grep's output also comes out in seemingly arbitrary order, + ;; though stable one. Let's sort both for better UI. + (sort hits + (lambda (h1 h2) + (string< (cadr h1) (cadr h2))))) (defun xref--process-file-region ( start end program &optional buffer display From f949d5ab62fbd21ff310b79cf7df3d806ab081c3 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 29 Jan 2026 11:20:48 +0800 Subject: [PATCH 309/325] ; Update Android dependencies --- admin/download-android-deps.sh | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/admin/download-android-deps.sh b/admin/download-android-deps.sh index e40392381d7..9223ba86f06 100644 --- a/admin/download-android-deps.sh +++ b/admin/download-android-deps.sh @@ -61,7 +61,7 @@ download_tarball () # 1c8f3b0cbad474da0ab09018c4ecf2119ac4a52d pixman-0.38.4-emacs.tar.gz # b687c8439d51634d921674dd009645e24873ca36 rsvg-2.40.21-emacs.tar.gz # eda251614598aacb06f5984a0a280833de456b29 tiff-4.5.1-emacs.tar.gz -# c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b tree-sitter-0.20.7-emacs.tar.gz +# 4cbc3ae7ae600db3787619d7994c659d9253a752 tree-sitter-0.26.3-emacs.tar.gz download_tarball "giflib-5.2.1-emacs.tar.gz" "giflib-5.2.1" \ "a407c568961d729bb2d0175a34e0d4ed4a269978" @@ -90,8 +90,8 @@ download_tarball "libtasn1-4.19.0-emacs.tar.gz" "libtasn1-4.19.0" \ "fdc827211075d9b70a8ba6ceffa02eb48d6741e9" download_tarball "libselinux-3.6-emacs.tar.gz" "libselinux-3.6" \ "8361966e19fe25ae987b08799f1442393ae6366b" -download_tarball "tree-sitter-0.20.7-emacs.tar.gz" "tree-sitter-0.20.7" \ - "c00d0ea9c6e848f5cce350cb3ed742024f2bdb8b" +download_tarball "tree-sitter-0.26.3-emacs.tar.gz" "tree-sitter-0.26.3" \ + "4cbc3ae7ae600db3787619d7994c659d9253a752" download_tarball "harfbuzz-7.1.0-emacs.tar.gz" "harfbuzz-7.1.0" \ "22dc71d503ab2eb263dc8411de9da1db144520f5" download_tarball "tiff-4.5.1-emacs.tar.gz" "tiff-4.5.1" \ From 1bbc7d955adc18cbcb92904bd3ecf0179104ad54 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 29 Jan 2026 11:25:57 +0800 Subject: [PATCH 310/325] ; Update Android dependencies again --- admin/download-android-deps.sh | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/admin/download-android-deps.sh b/admin/download-android-deps.sh index 9223ba86f06..f2578e284d9 100644 --- a/admin/download-android-deps.sh +++ b/admin/download-android-deps.sh @@ -61,7 +61,7 @@ download_tarball () # 1c8f3b0cbad474da0ab09018c4ecf2119ac4a52d pixman-0.38.4-emacs.tar.gz # b687c8439d51634d921674dd009645e24873ca36 rsvg-2.40.21-emacs.tar.gz # eda251614598aacb06f5984a0a280833de456b29 tiff-4.5.1-emacs.tar.gz -# 4cbc3ae7ae600db3787619d7994c659d9253a752 tree-sitter-0.26.3-emacs.tar.gz +# 9d032de89c874354c22d304f7e968f4ca6de8c0a tree-sitter-0.26.3-emacs.tar.gz download_tarball "giflib-5.2.1-emacs.tar.gz" "giflib-5.2.1" \ "a407c568961d729bb2d0175a34e0d4ed4a269978" @@ -91,7 +91,7 @@ download_tarball "libtasn1-4.19.0-emacs.tar.gz" "libtasn1-4.19.0" \ download_tarball "libselinux-3.6-emacs.tar.gz" "libselinux-3.6" \ "8361966e19fe25ae987b08799f1442393ae6366b" download_tarball "tree-sitter-0.26.3-emacs.tar.gz" "tree-sitter-0.26.3" \ - "4cbc3ae7ae600db3787619d7994c659d9253a752" + "9d032de89c874354c22d304f7e968f4ca6de8c0a" download_tarball "harfbuzz-7.1.0-emacs.tar.gz" "harfbuzz-7.1.0" \ "22dc71d503ab2eb263dc8411de9da1db144520f5" download_tarball "tiff-4.5.1-emacs.tar.gz" "tiff-4.5.1" \ From 80551807d4bad5fd9f03255b2bdb369ce5f78a7c Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Jan 2026 10:29:40 +0200 Subject: [PATCH 311/325] ; Fix package-vc-tests for older versions of Git * test/lisp/emacs-lisp/package-vc-tests.el (package-vc-tests-create-repository): Fix commands for older versions of Git. --- test/lisp/emacs-lisp/package-vc-tests.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/lisp/emacs-lisp/package-vc-tests.el b/test/lisp/emacs-lisp/package-vc-tests.el index 38ecb338da5..5ae36e79bcc 100644 --- a/test/lisp/emacs-lisp/package-vc-tests.el +++ b/test/lisp/emacs-lisp/package-vc-tests.el @@ -184,7 +184,8 @@ If LISP-DIR is non-nil place sources of the package in LISP-DIR." (format "GIT_AUTHOR_NAME=%s" name) (format "GIT_COMMITTER_NAME=%s" name)) process-environment))) - (vc-git-command nil 0 nil "init" "-b" "master") + (vc-git-command nil 0 nil "init") + (vc-git-command nil 0 nil "checkout" "-b" "master") (package-vc-tests-add suffix "test-package-SUFFIX-lib-v0.1.el.in" lisp-dir) (package-vc-tests-add From 792097d74761bf844c12b8f5916df19e252d5d1b Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Jan 2026 13:38:22 +0200 Subject: [PATCH 312/325] Avoid interference between child frame deletion and recentering * src/frame.c (delete_frame) [HAVE_X_WINDOWS]: Block input while child frame is displayed, and process the X events triggered by that later. Patch by Byakuren (https://web.liminal.cafe/~byakuren/). (Bug#76186) Copyright-paperwork-exempt: yes --- src/frame.c | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/src/frame.c b/src/frame.c index ba342b15723..d197e4d5351 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2887,6 +2887,15 @@ delete_frame (Lisp_Object frame, Lisp_Object force) promise that the terminal of the frame must be valid until we have called the window-system-dependent frame destruction routine. */ + /* Remember if this was a GUI child frame, so we can + process pending window system events after destruction. */ + bool was_gui_child_frame = FRAME_WINDOW_P (f) && FRAME_PARENT_FRAME (f); +#ifdef HAVE_X_WINDOWS + /* Save the X display before the frame is destroyed, so we can + sync with the X server afterwards. */ + Display *child_frame_display = (was_gui_child_frame && FRAME_X_P (f) + ? FRAME_X_DISPLAY (f) : NULL); +#endif { struct terminal *terminal; block_input (); @@ -2896,6 +2905,24 @@ delete_frame (Lisp_Object frame, Lisp_Object force) f->terminal = 0; /* Now the frame is dead. */ unblock_input (); + /* When a GUI child frame is deleted, the window system may + generate events that affect the parent frame (e.g. + ConfigureNotify, Expose, etc.). We need to sync with the + X server to ensure all events from the frame destruction + have been received, then process them to ensure subsequent + operations like `recenter' see up-to-date window state. + (Bug#76186) */ +#ifdef HAVE_X_WINDOWS + if (child_frame_display) + { + block_input (); + XSync (child_frame_display, False); + unblock_input (); + } +#endif + if (was_gui_child_frame) + swallow_events (false); + /* Clear markers and overlays set by F on behalf of an input method. */ #ifdef HAVE_TEXT_CONVERSION From c07ffa21884edae0bf241eb68c44114639a2a1a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Jan 2026 11:07:31 +0100 Subject: [PATCH 313/325] * lisp/tutorial.el (tutorial--describe-nonstandard-key): add space --- lisp/tutorial.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 113d13d11c2..f98a13b8a4a 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -153,7 +153,7 @@ options: " you can use " (if (string-match-p "^the .*menus?$" where) "" - "the key") + "the key ") where (format-message " to get the function `%s'." db)))) (fill-region (point-min) (point))))) From 495f6b412de244a87cc82a46bab26a86b83e8b15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 29 Jan 2026 11:41:19 +0100 Subject: [PATCH 314/325] tutorial.el: don't mutate quoted list * lisp/tutorial.el (tutorial--default-keys): Don't sort quoted list in-place. Sort at compile time, not load time. Uniform key representation (vectors) so that the default comparison can be used. Eliminate unnecessary backquote. (tutorial--sort-keys): Remove. --- lisp/tutorial.el | 57 ++++++------------------------------------------ 1 file changed, 7 insertions(+), 50 deletions(-) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index f98a13b8a4a..c071c1ff1d8 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -159,54 +159,11 @@ options: (fill-region (point-min) (point))))) (help-print-return-message)))) -(defun tutorial--sort-keys (left right) - "Sort predicate for use with `tutorial--default-keys'. -This is a predicate function to `sort'. - -The sorting is for presentation purpose only and is done on the -key sequence. - -LEFT and RIGHT are the elements to compare." - (let ((x (append (cadr left) nil)) - (y (append (cadr right) nil))) - ;; Skip the front part of the key sequences if they are equal: - (while (and x y - (listp x) (listp y) - (equal (car x) (car y))) - (setq x (cdr x)) - (setq y (cdr y))) - ;; Try to make a comparison that is useful for presentation (this - ;; could be made nicer perhaps): - (let ((cx (car x)) - (cy (car y))) - ;;(message "x=%s, y=%s;;;; cx=%s, cy=%s" x y cx cy) - (cond - ;; Lists? Then call this again - ((and cx cy - (listp cx) - (listp cy)) - (tutorial--sort-keys cx cy)) - ;; Are both numbers? Then just compare them - ((and (wholenump cx) - (wholenump cy)) - (> cx cy)) - ;; Is one of them a number? Let that be bigger then. - ((wholenump cx) - t) - ((wholenump cy) - nil) - ;; Are both symbols? Compare the names then. - ((and (symbolp cx) - (symbolp cy)) - (string< (symbol-name cy) - (symbol-name cx))))))) - (defconst tutorial--default-keys - ;; On window system, `suspend-emacs' is replaced in the default keymap. - (let* ((suspend-emacs 'suspend-frame) - (default-keys + (eval-when-compile + (let ((default-keys ;; The first few are not mentioned but are basic: - `((ESC-prefix [27]) + '((ESC-prefix [27]) (Control-X-prefix [?\C-x]) (mode-specific-command-prefix [?\C-c]) (save-buffers-kill-terminal [?\C-x ?\C-c]) @@ -227,7 +184,7 @@ LEFT and RIGHT are the elements to compare." (move-end-of-line [?\C-e]) (backward-sentence [?\M-a]) (forward-sentence [?\M-e]) - (newline "\r") + (newline [?\C-m]) (beginning-of-buffer [?\M-<]) (end-of-buffer [?\M->]) (universal-argument [?\C-u]) @@ -245,7 +202,7 @@ LEFT and RIGHT are the elements to compare." ;; * INSERTING AND DELETING ;; C-u 8 * to insert ********. - (delete-backward-char "\d") + (delete-backward-char [?\C-?]) (delete-char [?\C-d]) (backward-kill-word [?\M-\d]) (kill-word [?\M-d]) @@ -309,8 +266,8 @@ LEFT and RIGHT are the elements to compare." ;; * CONCLUSION ;;(iconify-or-deiconify-frame [?\C-z]) - (,suspend-emacs [?\C-z])))) - (sort default-keys 'tutorial--sort-keys)) + (suspend-frame [?\C-z])))) + (sort default-keys :key #'cadr))) "Default Emacs key bindings that the tutorial depends on.") (defun tutorial--detailed-help (button) From 4dc7d6056f654dfce90ff815301ccf702f3b66f2 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 29 Jan 2026 11:58:51 +0000 Subject: [PATCH 315/325] Use frame-pixel-width/height to determine if frame is landscape * lisp/window.el (window--frame-landscape-p): New function. (split-window-sensibly): Call it (bug#80053). --- lisp/window.el | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lisp/window.el b/lisp/window.el index 7d866d6475d..b5feed0c30c 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7584,6 +7584,16 @@ strategy." (with-selected-window window (split-window-right)))) +(defun window--frame-landscape-p (&optional frame) + "Non-nil if FRAME is wider than it is tall. + +On text frames, uses a heuristic for character height and width." + (if (display-graphic-p frame) + (> (frame-pixel-width frame) (frame-pixel-height frame)) + ;; On a terminal, displayed characters are usually roughly twice as + ;; tall as they are wide. + (> (frame-width frame) (* 2 (frame-height frame))))) + (defun split-window-sensibly (&optional window) "Split WINDOW in a way suitable for `display-buffer'. The variable `split-window-preferred-direction' prescribes an order of @@ -7624,7 +7634,7 @@ split." (or (if (or (eql split-window-preferred-direction 'horizontal) (and (eql split-window-preferred-direction 'longest) - (> (frame-width) (frame-height)))) + (window--frame-landscape-p (window-frame window)))) (or (window--try-horizontal-split window) (window--try-vertical-split window)) (or (window--try-vertical-split window) From 38d0ac8f6714d107044fb1e156cfaf49887ca094 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Jan 2026 14:37:58 +0000 Subject: [PATCH 316/325] ; * lisp/window.el (window--frame-landscape-p): Improve docstring. --- lisp/window.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/window.el b/lisp/window.el index b5feed0c30c..3a1ebd16fa6 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -7586,8 +7586,9 @@ strategy." (defun window--frame-landscape-p (&optional frame) "Non-nil if FRAME is wider than it is tall. - -On text frames, uses a heuristic for character height and width." +This means actually wider on the screen, not character-wise. +On text frames, use the heuristic that characters are roughtly twice as +tall as they are wide." (if (display-graphic-p frame) (> (frame-pixel-width frame) (frame-pixel-height frame)) ;; On a terminal, displayed characters are usually roughly twice as From 3937833fff0c31f9f6c71badcec2e5d43f7e5eba Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Thu, 29 Jan 2026 17:11:17 +0200 Subject: [PATCH 317/325] xref-find-backend: Error instead of returning nil * lisp/progmodes/xref.el (xref-find-backend): Signal error when we can't find a backend to use (bug#80246). --- lisp/progmodes/xref.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index d2dd4167725..84a3fa4dfba 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -247,7 +247,9 @@ generic functions.") ;;;###autoload (defun xref-find-backend () - (run-hook-with-args-until-success 'xref-backend-functions)) + (or + (run-hook-with-args-until-success 'xref-backend-functions) + (user-error "No Xref backend available"))) (cl-defgeneric xref-backend-definitions (backend identifier) "Find definitions of IDENTIFIER. From 0ab5db015f7eed3ffdf85ccbb75ff48e2c44b5a1 Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Thu, 29 Jan 2026 16:45:15 +0000 Subject: [PATCH 318/325] (minibuffer-message): Do not block while displaying message. * lisp/minibuffer.el (minibuffer--message-overlay) (minibuffer--message-timer): New variables. (minibuffer--delete-message-overlay): New function. (minibuffer-message): Use a timer and 'pre-command-hook' to clear message overlay instead of blocking with 'sit-for'. (bug#79510) * etc/NEWS: Document the change. --- etc/NEWS | 7 ++++++ lisp/minibuffer.el | 63 ++++++++++++++++++++++++---------------------- 2 files changed, 40 insertions(+), 30 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 65c8c62dec5..4af778c990c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3918,6 +3918,13 @@ Binding 'inhibit-message' to a non-nil value will now suppress both the display of messages and the clearing of the echo area, such as caused by calling 'message' with a nil argument. +--- +** 'minibuffer-message' no longer blocks while displaying message +'minibuffer-message' now uses a timer to clear the message printed to +the minibuffer, instead of waiting with 'sit-for' and then clearing it. +This makes 'minibuffer-message' usable in Lisp programs which want to +print a message and then continue to perform work. + ** Special Events +++ diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 12827cacfe2..0904a592eb4 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -797,6 +797,19 @@ for use at QPOS." (defvar minibuffer-message-properties nil "Text properties added to the text shown by `minibuffer-message'.") +(defvar minibuffer--message-overlay nil) + +(defvar minibuffer--message-timer nil) + +(defun minibuffer--delete-message-overlay () + (when (overlayp minibuffer--message-overlay) + (delete-overlay minibuffer--message-overlay) + (setq minibuffer--message-overlay nil)) + (when (timerp minibuffer--message-timer) + (cancel-timer minibuffer--message-timer) + (setq minibuffer--message-timer nil)) + (remove-hook 'pre-command-hook #'minibuffer--delete-message-overlay)) + (defun minibuffer-message (message &rest args) "Temporarily display MESSAGE at the end of minibuffer text. This function is designed to be called from the minibuffer, i.e., @@ -814,13 +827,9 @@ through `format-message'. If some of the minibuffer text has the `minibuffer-message' text property, MESSAGE is shown at that position instead of EOB." (if (not (minibufferp (current-buffer) t)) - (progn - (if args - (apply #'message message args) - (message "%s" message)) - (prog1 (sit-for (or minibuffer-message-timeout 1000000)) - (message nil))) + (apply #'message message args) ;; Clear out any old echo-area message to make way for our new thing. + (minibuffer--delete-message-overlay) (message nil) (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) @@ -834,30 +843,24 @@ property, MESSAGE is shown at that position instead of EOB." (setq message (apply #'propertize message minibuffer-message-properties))) ;; Put overlay either on `minibuffer-message' property, or at EOB. (let* ((ovpos (minibuffer--message-overlay-pos)) - (ol (make-overlay ovpos ovpos nil t t)) - ;; A quit during sit-for normally only interrupts the sit-for, - ;; but since minibuffer-message is used at the end of a command, - ;; at a time when the command has virtually finished already, a C-g - ;; should really cause an abort-recursive-edit instead (i.e. as if - ;; the C-g had been typed at top-level). Binding inhibit-quit here - ;; is an attempt to get that behavior. - (inhibit-quit t)) - (unwind-protect - (progn - (unless (zerop (length message)) - ;; The current C cursor code doesn't know to use the overlay's - ;; marker's stickiness to figure out whether to place the cursor - ;; before or after the string, so let's spoon-feed it the pos. - (put-text-property 0 1 'cursor t message)) - (overlay-put ol 'after-string message) - ;; Make sure the overlay with the message is displayed before - ;; any other overlays in that position, in case they have - ;; resize-mini-windows set to nil and the other overlay strings - ;; are too long for the mini-window width. This makes sure the - ;; temporary message will always be visible. - (overlay-put ol 'priority 1100) - (sit-for (or minibuffer-message-timeout 1000000))) - (delete-overlay ol))))) + (ol (make-overlay ovpos ovpos nil t t))) + (unless (zerop (length message)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t message)) + (overlay-put ol 'after-string message) + ;; Make sure the overlay with the message is displayed before + ;; any other overlays in that position, in case they have + ;; resize-mini-windows set to nil and the other overlay strings + ;; are too long for the mini-window width. This makes sure the + ;; temporary message will always be visible. + (overlay-put ol 'priority 1100) + (setq minibuffer--message-overlay ol + minibuffer--message-timer + (run-at-time (or minibuffer-message-timeout 1000000) nil + #'minibuffer--delete-message-overlay)) + (add-hook 'pre-command-hook #'minibuffer--delete-message-overlay)))) (defcustom minibuffer-message-clear-timeout nil "How long to display an echo-area message when the minibuffer is active. From 60b9435ad7192d9b3759777cd987c301a98796c1 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Jan 2026 17:00:46 +0000 Subject: [PATCH 319/325] ; Fix/improve two comments. --- lisp/vc/diff-mode.el | 2 +- lisp/vc/vc.el | 18 +++++++++++++----- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 5286a079b4c..5c0fb5fba4c 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2359,7 +2359,7 @@ applied. Other non-nil values are reserved." (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched) (diff-find-source-location nil reverse test))) ;; FIXME: Should respect `diff-apply-hunk-to-backup-file' - ;; similarly to how `diff-apply-buffer' does. + ;; similarly to how `diff-apply-hunk' does. ;; Prompt for each relevant file. (cond ((and line-offset (not switched)) (push (cons pos dst) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 0ce4ce56363..cc3aa2d7f01 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -4342,11 +4342,19 @@ BACKEND is the VC backend." (let* ((outgoing-base (vc-call-backend (or backend (vc-deduce-backend)) 'topic-outgoing-base)) - ;; If OUTGOING-BASE is non-nil then it isn't possible to - ;; specify an empty string in response to the prompt, which - ;; normally means to treat the current branch as a trunk. - ;; That's okay because you can use a double prefix argument - ;; to force treating the current branch as a trunk. + ;; If OUTGOING-BASE is non-nil then 'C-u C-x v T ... RET' is + ;; how the user can force Emacs to treat the current branch + ;; as a topic while having Emacs automatically determine the + ;; outgoing base with which to do so (otherwise, forcing + ;; Emacs to treat the current branch as a topic if it thinks + ;; it's a trunk requires specifying an outgoing base which + ;; will have that effect). + ;; + ;; In this case that OUTGOING-BASE is non-nil, it isn't + ;; possible to specify an empty string as the outgoing base, + ;; which normally means that Emacs should treat the current + ;; branch as a trunk. That's okay because you can use a + ;; double prefix argument to achieve that. (res (read-string (if outgoing-base (format-prompt "Upstream location/branch" outgoing-base) From 12e53dfafe097d053e78f83788a5c44320a3d370 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Jan 2026 17:01:32 +0000 Subject: [PATCH 320/325] New C-x v T l and C-x v T L commands * lisp/vc/vc.el (vc-log-outgoing-base) (vc-root-log-outgoing-base): New commands. * lisp/vc/vc-dir.el (vc-dir-mode-map): * lisp/vc/vc-hooks.el (vc-prefix-map): Bind them. * doc/emacs/vc1-xtra.texi (Outstanding Changes): * etc/NEWS: Document them. --- doc/emacs/vc1-xtra.texi | 43 +++++++++++++++++++++++-------- etc/NEWS | 10 +++++--- lisp/vc/vc-dir.el | 2 ++ lisp/vc/vc-hooks.el | 2 ++ lisp/vc/vc.el | 57 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 99 insertions(+), 15 deletions(-) diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 655402b61ba..2bb695025db 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -303,17 +303,26 @@ Display diffs of changes to the VC fileset since the merge base of this branch and its upstream counterpart (@code{vc-diff-outgoing-base}). @item C-x v T D -Display all changes since the merge base of this branch and its upstream -counterpart (@code{vc-root-diff-outgoing-base}). +Display a diff of all changes since the merge base of this branch and +its upstream counterpart (@code{vc-root-diff-outgoing-base}). + +@item C-x v T l +Display log messages for changes to the VC fileset since the merge base +of this branch and its upstream counterpart +(@code{vc-log-outgoing-base}). + +@item C-x v T L +Display log messages for all changes since the merge base of this branch +and its upstream counterpart (@code{vc-root-log-outgoing-base}). @end table For decentralized version control systems (@pxref{VCS Repositories}), -these commands provide specialized versions of @kbd{C-x v M D} (see -@pxref{Merge Bases}) which also take into account the state of upstream -repositories. These commands are useful both when working on a single -branch and when developing features on a separate branch -(@pxref{Branches}). These two cases are conceptually distinct, and so -we will introduce them separately. +these commands provide specialized versions of @kbd{C-x v M L} and +@w{@kbd{C-x v M D}} (see @pxref{Merge Bases}) which also take into +account the state of upstream repositories. These commands are useful +both when working on a single branch and when developing features on a +separate branch (@pxref{Branches}). These two cases are conceptually +distinct, and so we will introduce them separately. First, consider working on a single branch. @dfn{Outstanding changes} are those which you haven't yet pushed upstream. This includes both @@ -340,6 +349,16 @@ include uncommitted changes in the reported diffs. Like those other commands, you can use a prefix argument to specify a particular upstream location.} +@kindex C-x v T l +@findex vc-log-outgoing-base +@kindex C-x v T L +@findex vc-root-log-outgoing-base +Type @kbd{C-x v T L} (@code{vc-root-log-outgoing-base}) to display a +summary of the same changes in the form of a revision log; this does not +include uncommitted changes. You can use @kbd{C-x v T l} +(@code{vc-log-outgoing-base}) instead to limit the display of changes to +the current VC fileset. + Second, consider developing a feature on a separate branch. Call this the @dfn{topic branch},@footnote{What we mean by a topic branch is any shorter-lived branch used for work which will later be merged into a @@ -365,7 +384,9 @@ the trunk to which the current branch will be merged. This summary is in the form of a diff of what committing and pushing all the changes, @emph{and} subsequently merging the topic branch, would do to the trunk. As above, you can use @kbd{C-x v T =} instead to limit the display of -changes to the current VC fileset. +changes to the current VC fileset. @kbd{C-x v T L} and @kbd{C-x v T l} +show the corresponding revision logs, excluding uncommitted changes as +above. This functionality relies on Emacs correctly detecting whether the current branch is a trunk or a topic branch, and in the latter case, @@ -379,8 +400,8 @@ The variables @code{vc-trunk-branch-regexps} and @code{vc-topic-branch-regexps} contain lists of regular expressions matching the names of branches that should always be considered trunk and topic branches, respectively. You can also specify prefix arguments -to @kbd{C-x v T D} and @kbd{C-x v T =}. Here is a summary of how to use -these controls: +to @kbd{C-x v T @dots{}}. Here is a summary of how to use these +controls: @enumerate @item diff --git a/etc/NEWS b/etc/NEWS index 4af778c990c..99fc1754bad 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2745,13 +2745,15 @@ include were committed and will be pushed. current VC fileset. +++ -*** New commands to report diffs of outstanding changes. +*** New commands to report information about outstanding changes. 'C-x v T =' ('vc-diff-outgoing-base') and 'C-x v T D' ('vc-root-diff-outgoing-base') report diffs of changes since the merge base with the remote branch, including uncommitted changes. -They are useful to view all outstanding (unmerged, unpushed) changes on -the current branch. -They are also available as 'T =' and 'T D' in VC-Dir buffers. +'C-x v T l' ('vc-log-outgoing-base') and 'C-x v T L' +('vc-root-log-outgoing-base') show the corresponding revision logs. +These are useful to view all outstanding (unmerged, unpushed) changes on +the current branch. They are also available as 'T =', 'T D', 'T l' and +'T L' in VC-Dir buffers. +++ *** New user option 'vc-use-incoming-outgoing-prefixes'. diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index b9176d8a2f6..5781ddc45d9 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -397,6 +397,8 @@ That is, refreshing the VC-Dir buffer also hides `up-to-date' and (define-key map (kbd "M-s a M-C-s") #'vc-dir-isearch-regexp) (define-key map "G" #'vc-dir-ignore) (define-key map "@" #'vc-revert) + (define-key map "Tl" #'vc-log-outgoing-base) + (define-key map "TL" #'vc-root-log-outgoing-base) (define-key map "T=" #'vc-diff-outgoing-base) (define-key map "TD" #'vc-root-diff-outgoing-base) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index a6e07e02de9..f3519465c07 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -1018,6 +1018,8 @@ In the latter case, VC mode is deactivated for this buffer." "O" #'vc-root-log-outgoing "M L" #'vc-log-mergebase "M D" #'vc-diff-mergebase + "T l" #'vc-log-outgoing-base + "T L" #'vc-root-log-outgoing-base "T =" #'vc-diff-outgoing-base "T D" #'vc-root-diff-outgoing-base "m" #'vc-merge diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index cc3aa2d7f01..770906ff6cc 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3403,6 +3403,63 @@ When called from Lisp, optional argument FILESET overrides the fileset." nil (called-interactively-p 'interactive)))) +;;;###autoload +(defun vc-log-outgoing-base (&optional upstream-location fileset) + "Show log for the VC fileset since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. + +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. + +When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. + +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. + +When called from Lisp, optional argument FILESET overrides the fileset." + (interactive (let ((fileset (vc-deduce-fileset t))) + (list (vc--maybe-read-outgoing-base (car fileset)) + fileset))) + (let* ((fileset (or fileset (vc-deduce-fileset t))) + (backend (car fileset))) + (vc-print-log-internal backend (cadr fileset) nil nil + (vc--outgoing-base-mergebase backend + upstream-location)))) + +;;;###autoload +(defun vc-root-log-outgoing-base (&optional upstream-location) + "Show log of revisions since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. + +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. + +When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. + +When called interactively with a \\[universal-argument] \\[universal-argument] \ +prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch." + (interactive (list (vc--maybe-read-outgoing-base))) + (vc--with-backend-in-rootdir "VC revision log" + (vc-log-outgoing-base upstream-location `(,backend (,rootdir))))) + (declare-function ediff-load-version-control "ediff" (&optional silent)) (declare-function ediff-vc-internal "ediff-vers" (rev1 rev2 &optional startup-hooks)) From 88d787d97c9f1b932fb38aab031c35adea1076e8 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Jan 2026 17:03:58 +0000 Subject: [PATCH 321/325] ; * lisp/ldefs-boot.el: Regenerate. --- lisp/ldefs-boot.el | 104 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 88 insertions(+), 16 deletions(-) diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index e20d8609e88..c5fbb5a3e22 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -2699,10 +2699,10 @@ from `browse-url-elinks-wrapper'. (fn URL &optional NEW-WINDOW)" t) (autoload 'browse-url-button-open "browse-url" "\ Follow the link under point using `browse-url'. -If EXTERNAL (the prefix if used interactively), open with the -external browser instead of the default one. +If SECONDARY (the prefix if used interactively), open with the +secondary browser instead of the default one. -(fn &optional EXTERNAL MOUSE-EVENT)" t) +(fn &optional SECONDARY MOUSE-EVENT)" t) (autoload 'browse-url-button-open-url "browse-url" "\ Open URL using `browse-url'. If `current-prefix-arg' is non-nil, use @@ -5133,7 +5133,7 @@ List of directories to search for source files named in error messages. Elements should be directory names, not file names of directories. The value nil as an element means to try the default directory.") (custom-autoload 'compilation-search-path "compile" t) -(defvar compile-command "make -k " "\ +(defvar compile-command (format "make -k -j%d " (ceiling (num-processors) 1.5)) "\ Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. @@ -13691,8 +13691,6 @@ evaluate the variable `flymake-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{flymake-mode-map} - (fn &optional ARG)" t) (autoload 'flymake-mode-on "flymake" "\ Turn Flymake mode on.") @@ -24735,6 +24733,21 @@ If optional argument NOCONFIRM is non-nil, or when invoked with a prefix argument, don't ask for confirmation to install packages. (fn &optional NOCONFIRM)" t) +(autoload 'package-delete "package" "\ +Delete package PKG-DESC. + +Argument PKG-DESC is the full description of the package, for example as +obtained by `package-get-descriptor'. Interactively, prompt the user +for the package name and version. + +When package is used elsewhere as dependency of another package, +refuse deleting it and return an error. +If prefix argument FORCE is non-nil, package will be deleted even +if it is used elsewhere. +If NOSAVE is non-nil, the package is not removed from +`package-selected-packages'. + +(fn PKG-DESC &optional FORCE NOSAVE)" t) (autoload 'package-reinstall "package" "\ Reinstall package PKG. PKG should be either a symbol, the package name, or a `package-desc' @@ -24779,11 +24792,18 @@ short description. (defcustom package-quickstart-file (locate-user-emacs-file "package-quickstart.el") "\ Location of the file used to speed up activation of packages at startup." :type 'file :group 'applications :initialize #'custom-initialize-delay :version "27.1") (custom-autoload 'package-quickstart-file "package" t) +(autoload 'package-browse-url "package" "\ +Open the website of the package under point in a browser. +`browse-url' is used to determine the browser to be used. If +SECONDARY (interactively, the prefix), use the secondary browser. +DESC must be a `package-desc' object. + +(fn DESC &optional SECONDARY)" t) (autoload 'package-report-bug "package" "\ Prepare a message to send to the maintainers of a package. DESC must be a `package-desc' object. -(fn DESC)" '(package-menu-mode)) +(fn DESC)" t) (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")) @@ -25815,6 +25835,10 @@ Note that this function doesn't work if DELTA is larger than the height of the current window. (fn DELTA)") +(autoload 'pixel-scroll-interpolate-down "pixel-scroll" "\ +Interpolate a scroll downwards by one page." t) +(autoload 'pixel-scroll-interpolate-up "pixel-scroll" "\ +Interpolate a scroll upwards by one page." t) (defvar pixel-scroll-precision-mode nil "\ Non-nil if Pixel-Scroll-Precision mode is enabled. See the `pixel-scroll-precision-mode' command @@ -27749,8 +27773,6 @@ evaluate the variable `rectangle-mark-mode'. The mode's hook is called both when the mode is enabled and when it is disabled. -\\{rectangle-mark-mode-map} - (fn &optional ARG)" t) (register-definition-prefixes "rect" '("apply-on-rectangle" "clear-rectangle-line" "delete-" "extract-rectangle-" "killed-rectangle" "ope" "rectangle-" "spaces-string" "string-rectangle-")) @@ -36590,6 +36612,50 @@ topic branch. (With a double prefix argument, this command is like When called from Lisp, optional argument FILESET overrides the fileset. (fn &optional UPSTREAM-LOCATION FILESET)" t) +(autoload 'vc-log-outgoing-base "vc" "\ +Show log for the VC fileset since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. + +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. + +When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. + +When called interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. + +When called from Lisp, optional argument FILESET overrides the fileset. + +(fn &optional UPSTREAM-LOCATION FILESET)" t) +(autoload 'vc-root-log-outgoing-base "vc" "\ +Show log of revisions since the merge base with UPSTREAM-LOCATION. +The merge base with UPSTREAM-LOCATION means the common ancestor of the +working revision and UPSTREAM-LOCATION. + +When unspecified, UPSTREAM-LOCATION is the outgoing base. +For a trunk branch this is always the place \\[vc-push] would push to. +For a topic branch, query the backend for an appropriate outgoing base. +See `vc-trunk-branch-regexps' and `vc-topic-branch-regexps' regarding +the difference between trunk and topic branches. + +When called interactively with a prefix argument, prompt for +UPSTREAM-LOCATION. In some version control systems, UPSTREAM-LOCATION +can be a remote branch name. + +When called interactively with a \\[universal-argument] \\[universal-argument] prefix argument, always +use the place to which \\[vc-push] would push to as the outgoing base, +i.e., treat this branch as a trunk branch even if Emacs thinks it is a +topic branch. + +(fn &optional UPSTREAM-LOCATION)" t) (autoload 'vc-version-ediff "vc" "\ Show differences between REV1 and REV2 of FILES using ediff. This compares two revisions of the files in FILES. Currently, @@ -37320,7 +37386,7 @@ step during initialization." t) ;;; Generated autoloads from progmodes/verilog-mode.el -(push '(verilog-mode 2025 11 8 248496848) package--builtin-versions) +(push '(verilog-mode 2026 1 18 88738971) package--builtin-versions) (autoload 'verilog-mode "verilog-mode" "\ Major mode for editing Verilog code. \\ @@ -39641,6 +39707,14 @@ list. Delete FRAME2 if the merge completed successfully and return FRAME1. (fn &optional FRAME1 FRAME2 VERTICAL)" t) +(autoload 'window-get-split-combination "window-x" "\ +Return window combination suitable for `split-frame'. + +WINDOW is the main window in which the combination should be derived. +ARG is the argument passed to `split-frame'. Return a +combination of windows `split-frame' is considered to split off. + +(fn WINDOW ARG)") (autoload 'split-frame "window-x" "\ Split windows of specified FRAME into two separate frames. FRAME must be a live frame and defaults to the selected frame. ARG @@ -39975,12 +40049,9 @@ output of this command when the backend is etags. (define-key ctl-x-5-map "." #'xref-find-definitions-other-frame) (autoload 'xref-references-in-directory "xref" "\ Find all references to SYMBOL in directory DIR. +See `xref-references-in-directory-function' for the implementation. Return a list of xref values. -This function uses the Semantic Symbol Reference API, see -`semantic-symref-tool-alist' for details on which tools are used, -and when. - (fn SYMBOL DIR)") (autoload 'xref-matches-in-directory "xref" "\ Find all matches for REGEXP in directory DIR. @@ -39988,8 +40059,9 @@ Return a list of xref values. Only files matching some of FILES and none of IGNORES are searched. FILES is a string with glob patterns separated by spaces. IGNORES is a list of glob patterns for files to ignore. +If DELIMITED is `symbol', only select matches that span full symbols. -(fn REGEXP FILES DIR IGNORES)") +(fn REGEXP FILES DIR IGNORES &optional DELIMITED)") (autoload 'xref-matches-in-files "xref" "\ Find all matches for REGEXP in FILES. Return a list of xref values. @@ -40087,7 +40159,7 @@ Enable `yaml-ts-mode' when its grammar is available. Also propose to install the grammar when `treesit-enabled-modes' is t or contains the mode name.") (when (boundp 'treesit-major-mode-remap-alist) (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode-maybe)) (add-to-list 'treesit-major-mode-remap-alist '(yaml-mode . yaml-ts-mode))) -(register-definition-prefixes "yaml-ts-mode" '("yaml-ts-mode--")) +(register-definition-prefixes "yaml-ts-mode" '("yaml-ts-mode-")) ;;; Generated autoloads from yank-media.el From b9bfe461b250728fb1f6d5df0ce657bffd873e59 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Jan 2026 17:08:55 +0000 Subject: [PATCH 322/325] ; Fix minibuffer-message NEWS entry. --- etc/NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/etc/NEWS b/etc/NEWS index 99fc1754bad..87023ade5fd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3921,7 +3921,7 @@ the display of messages and the clearing of the echo area, such as caused by calling 'message' with a nil argument. --- -** 'minibuffer-message' no longer blocks while displaying message +** 'minibuffer-message' no longer blocks while displaying message. 'minibuffer-message' now uses a timer to clear the message printed to the minibuffer, instead of waiting with 'sit-for' and then clearing it. This makes 'minibuffer-message' usable in Lisp programs which want to From eca025334ed607656bb6ce5a14acd596270dabc1 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Thu, 29 Jan 2026 22:13:02 +0200 Subject: [PATCH 323/325] ; Fix last change * etc/NEWS: * doc/lispref/windows.texi (Choosing Window Options): * doc/emacs/windows.texi (Window Choice): Improve documentation of 'split-window-preferred-direction'. --- doc/emacs/windows.texi | 12 ++++++++++-- doc/lispref/windows.texi | 35 +++++++++++++++++++++++++---------- etc/NEWS | 19 ++++++++++++++----- 3 files changed, 49 insertions(+), 17 deletions(-) diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi index 937ea386650..8500e3b7731 100644 --- a/doc/emacs/windows.texi +++ b/doc/emacs/windows.texi @@ -519,6 +519,8 @@ selected frame, and display the buffer in that new window. @vindex split-height-threshold @vindex split-width-threshold @vindex split-window-preferred-direction +@cindex portrait frame +@cindex landscape frame The split can be either vertical or horizontal, depending on the variables @code{split-height-threshold} and @code{split-width-threshold}. These variables should have integer @@ -528,8 +530,14 @@ window's height, the split puts the new window below. Otherwise, if split puts the new window on the right. If neither condition holds, Emacs tries to split so that the new window is below---but only if the window was not split before (to avoid excessive splitting). Whether -Emacs tries first to split vertically or horizontally, is -determined by the value of @code{split-window-preferred-direction}. +Emacs tries first to split vertically or horizontally when both +conditions hold is determined by the value of +@code{split-window-preferred-direction}. Its default is @code{longest}, +which means to split vertically if the window's frame is taller than it +is wide (a @dfn{portrait} frame), and split horizontally if its wider +than it's tall (a @dfn{landscape} frame). The values @code{vertical} +and @code{horizontal} always prefer, respectively, the vertical or the +horizontal split. @item Otherwise, display the buffer in a window previously showing it. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 169f15cc898..d804c34250f 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -4122,16 +4122,19 @@ window. If @var{window} cannot be split, it returns @code{nil}. If @var{window} is omitted or @code{nil}, it defaults to the selected window. -This function obeys the usual rules that determine when a window may -be split (@pxref{Splitting Windows}). It first tries to split by -placing the new window below, subject to the restriction imposed by -@code{split-height-threshold} (see below), in addition to any other -restrictions. If that fails, it tries to split by placing the new -window to the right, subject to @code{split-width-threshold} (see -below). If that also fails, and the window is the only window on its -frame, this function again tries to split and place the new window -below, disregarding @code{split-height-threshold}. If this fails as -well, this function gives up and returns @code{nil}. +This function obeys the usual rules that determine when a window may be +split (@pxref{Splitting Windows}). It first tries either a vertical +split by placing the new window below, subject to the restriction +imposed by @code{split-height-threshold} (see below), or a horizontal +split that places the new window to the right, subject to +@code{split-width-threshold}, in addition to any other restrictions. +Whether it tries first to split vertically or horizontally depends on +the value of the user option @code{split-window-preferred-direction}. +If splitting along the first dimension fails, it tries to split along +the other dimension. If that also fails, and the window is the only +window on its frame, this function again tries to split and place the +new window below, disregarding @code{split-height-threshold}. If this +fails as well, this function gives up and returns @code{nil}. @end defun @defopt split-height-threshold @@ -4150,6 +4153,18 @@ window has at least that many columns. If the value is @code{nil}, that means not to split this way. @end defopt +@defopt split-window-preferred-direction +This variable determines the first dimension along which +@code{split-window-sensibly} tries to split the window, if the window +could be split both vertically and horizontally, as determined by the +values of @code{split-height-threshold} and +@code{split-width-threshold}. The default value is @code{longest}, +which means to split vertically if the height of the window's frame is +greater or equal to its width, and horizontally otherwise. The values +@code{vertical} and @code{horizontal} specify the direction in which to +attempt the first split. +@end defopt + @defopt even-window-sizes This variable, if non-@code{nil}, causes @code{display-buffer} to even window sizes whenever it reuses an existing window, and that window is diff --git a/etc/NEWS b/etc/NEWS index 87023ade5fd..1ed41795fe3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -416,11 +416,20 @@ for which you can use '(category . tex-shell)'. +++ *** New user option 'split-window-preferred-direction'. -Users can now choose in which direction Emacs tries to split first: -vertically or horizontally. The new default is to prefer to split -horizontally if the frame is landscape and vertically if it is portrait. -You can customize this option to 'vertical' to restore Emacs's old -behavior of always preferring vertical splits. +Functions called by 'display-buffer' split the selected window when they +need to create a new window. A window can be split either vertically, +one below the other, or horizontally, side by side. This new option +determines which direction will be tried first, when both directions are +possible according to the values of 'split-width-threshold' and +'split-height-threshold'. The default value is 'longest', which means +to prefer to split horizontally if the window's frame is a "landscape" +frame, and vertically if it is a "portrait" frame. (A frame is +considered to be "portrait" if its vertical dimension in pixels is +greater or equal to its horizontal dimension, otherwise it's considered +to be "landscape".) Previous versions of Emacs always tried to split +vertically first, so to get previous behavior, you can customize this +option to 'vertical'. The value 'horizontal' always prefers the +horizontal split. +++ *** New argument INDIRECT for 'get-buffer-window-list'. From 31944efb826ea02ea7197012f84b00f903df66bb Mon Sep 17 00:00:00 2001 From: Spencer Baugh Date: Mon, 22 Dec 2025 16:25:26 -0500 Subject: [PATCH 324/325] eager-display *Completions* again after completion failure If the completion table requests eager-update (so *Completions* should be updated as the user types, when already displayed) then *Completions* will be dismissed automatically if the user types something which isn't a completion. Previously, *Completions* wouldn't be redisplayed until the user requests it again. Now, if the completion table also enables eager-display in addition to eager-update, then automatically redisplay *Completions* after it disappears. * lisp/minibuffer.el (completions--start-eager-display): Add REQUIRE-EAGER-UPDATE argument and don't run if Completions is already displayed. (completions--after-change): Call 'completions--start-eager-display'. (minibuffer-completion-help): Add the 'completions--after-change' hook earlier, and let it remove itself (bug#80055). --- lisp/minibuffer.el | 41 ++++++++++++++++++++++++++--------------- 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0904a592eb4..fc193fe54f0 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -2777,18 +2777,27 @@ so that the update is less likely to interfere with user typing." ;; If we got interrupted, try again the next time the user is idle. (completions--start-eager-display)))) -(defun completions--start-eager-display () +(defun completions--start-eager-display (&optional require-eager-update) "Maybe display the *Completions* buffer when the user is next idle. Only displays if `completion-eager-display' is t, or if eager display -has been requested by the completion table." - (when completion-eager-display - (when (or (eq completion-eager-display t) - (completion-metadata-get - (completion-metadata - (buffer-substring-no-properties (minibuffer-prompt-end) (point)) - minibuffer-completion-table minibuffer-completion-predicate) - 'eager-display)) +has been requested by the completion table. + +When REQUIRE-EAGER-UPDATE is non-nil, also require eager-display to be +requested by the completion table." + (when (and completion-eager-display + ;; If it's already displayed, don't display it again. + (not (get-buffer-window "*Completions*" 0))) + (when (let ((metadata + (completion-metadata + (buffer-substring-no-properties (minibuffer-prompt-end) (point)) + minibuffer-completion-table minibuffer-completion-predicate))) + (and + (or (eq completion-eager-display t) + (completion-metadata-get metadata 'eager-display)) + (or (not require-eager-update) + (eq completion-eager-update t) + (completion-metadata-get metadata 'eager-update)))) (setq completion-eager-display--timer (run-with-idle-timer 0 nil #'completions--eager-display))))) @@ -2800,13 +2809,16 @@ has been requested by the completion table." (defun completions--after-change (_start _end _old-len) "Update displayed *Completions* buffer after change in buffer contents." - (when (or completion-auto-deselect completion-eager-update) - (when-let* ((window (minibuffer--completions-visible))) + (if (not (or (minibufferp nil t) completion-in-region-mode)) + (remove-hook 'after-change-functions #'completions--after-change t) + (when-let* ((window (get-buffer-window "*Completions*" 0))) (when completion-auto-deselect (with-selected-window window (completions--deselect))) (when completion-eager-update - (add-hook 'post-command-hook #'completions--post-command-update))))) + (add-hook 'post-command-hook #'completions--post-command-update))) + (when (minibufferp nil t) + (completions--start-eager-display t)))) (defun minibuffer-completion-help (&optional start end) "Display a list of possible completions of the current minibuffer contents." @@ -2824,6 +2836,8 @@ has been requested by the completion table." (- (point) start) md))) (message nil) + (when (or completion-auto-deselect completion-eager-update) + (add-hook 'after-change-functions #'completions--after-change nil t)) (if (or (null completions) (and (not (consp (cdr completions))) (equal (car completions) string))) @@ -2831,7 +2845,6 @@ has been requested by the completion table." ;; If there are no completions, or if the current input is already ;; the sole completion, then hide (previous&stale) completions. (minibuffer-hide-completions) - (remove-hook 'after-change-functions #'completions--after-change t) (if completions (completion--message "Sole completion") (unless completion-fail-discreetly @@ -2897,8 +2910,6 @@ has been requested by the completion table." (body-function . ,#'(lambda (window) (with-current-buffer mainbuf - (when (or completion-auto-deselect completion-eager-update) - (add-hook 'after-change-functions #'completions--after-change nil t)) ;; Remove the base-size tail because `sort' requires a properly ;; nil-terminated list. (when last (setcdr last nil)) From 3584a762b8cbfb6e13011827ec5934f039344d0f Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 30 Jan 2026 09:27:12 +0200 Subject: [PATCH 325/325] New key 'M-j' for 'icomplete-mode' (bug#62108) * lisp/icomplete.el (icomplete-exit): New alias for 'icomplete-fido-exit'. (icomplete-minibuffer-map): Bind it to "M-j" . * lisp/replace.el (multi-occur--prompt): Show "M-j" bound to 'icomplete-exit' in 'icomplete-mode'. --- etc/NEWS | 4 ++++ lisp/icomplete.el | 3 +++ lisp/replace.el | 3 +++ 3 files changed, 10 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 1ed41795fe3..1838a1ec3e5 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3057,6 +3057,10 @@ Meant to be given a global binding convenient to the user. Example: ** Icomplete +*** New key 'M-j' for 'icomplete-mode' and 'icomplete-vertical-mode'. +Like 'M-j' in 'fido-mode', it can exit the minibuffer with a selected +candidate even when 'icomplete-show-matches-on-no-input' is non-nil. + *** New user options for 'icomplete-vertical-mode'. New user options have been added to enhance 'icomplete-vertical-mode': diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 6de3dd0b50a..c1d9556e24d 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -242,6 +242,7 @@ Used to implement the option `icomplete-show-matches-on-no-input'.") :doc "Keymap used by `icomplete-mode' in the minibuffer." "C-M-i" #'icomplete-force-complete "C-j" #'icomplete-force-complete-and-exit + "M-j" #'icomplete-exit "C-." #'icomplete-forward-completions "C-," #'icomplete-backward-completions " " #'icomplete-ret) @@ -455,6 +456,8 @@ if that doesn't produce a completion match." (minibuffer-complete-and-exit) (exit-minibuffer))) +(defalias 'icomplete-exit #'icomplete-fido-exit) + (defun icomplete-fido-backward-updir () "Delete char before or go up directory, like `ido-mode'." (interactive) diff --git a/lisp/replace.el b/lisp/replace.el index 933249d824c..d8b27544128 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1878,6 +1878,9 @@ is not modified." (bound-and-true-p ido-everywhere)) (substitute-command-keys "(\\\\[ido-select-text] to end): ")) + ((bound-and-true-p icomplete-mode) + (substitute-command-keys + "(\\\\[icomplete-exit] to end): ")) ((bound-and-true-p fido-mode) (substitute-command-keys "(\\\\[icomplete-fido-exit] to end): "))