commit c5bdb287e8109beef06f477fa1212226945c265e (HEAD, refs/remotes/origin/master) Author: Eli Zaretskii Date: Sun Sep 12 11:02:58 2021 +0300 Improve documentation of tab bars in the Emacs manual * doc/emacs/frames.texi (Tab Bars): Improve wording, indexing, and cross-references. Make sure each command is mentioned by its name when it is called out by the key sequence. Index entries should precede @item lines in a @table. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index a32181e73b..e238966428 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -1281,19 +1281,22 @@ displayed by moving the mouse pointer to the top of the screen. @section Tab Bars @cindex tab bar mode @cindex mode, Tab Bar -@cindex tabs, tabbar +@cindex tabs, on the Tab Bar On graphical displays and on text terminals, Emacs can optionally display a @dfn{Tab Bar} at the top of each frame, just below the menu -bar. The Tab Bar is a row of @dfn{tabs}---buttons that you can click -to switch between window configurations on that frame. +bar (@pxref{Menu Bars}) and above the tool bar (@pxref{Tool Bars}). +The Tab Bar is a row of @dfn{tabs}---buttons that you can click to +switch between window configurations. Each tab on the Tab Bar represents a named persistent window -configuration. Its name is composed from the list of names of buffers -visible in windows of that window configuration. Clicking on the tab -switches to the window configuration recorded by the tab; it is a -configuration of windows and buffers which was previously used in the -frame when that tab was the current tab. +configuration of its frame, i.e., how that frame is partitioned into +windows and which buffer is displayed in each window. The tab's name +is composed from the list of names of buffers shown in windows of that +window configuration. Clicking on the tab switches to the window +configuration recorded by the tab; it is a configuration of windows +and buffers which was previously used in the frame when that tab was +the current tab. If you are using the desktop library to save and restore your sessions (@pxref{Saving Emacs Sessions}), the tabs from the Tab Bar are @@ -1302,28 +1305,39 @@ configurations, and will be available after restoring the session. Note that the Tab Bar is different from the Tab Line (@pxref{Tab Line}). Whereas tabs on the Tab Line at the top of each window are used to -switch between buffers, tabs on the Tab Bar at the top of each frame -are used to switch between window configurations containing several -windows with buffers. +switch between buffers in the window, tabs on the Tab Bar at the top +of each frame are used to switch between window configurations +containing several windows showing one or more buffers. @findex tab-bar-mode - To toggle the use of tab bars, type @kbd{M-x tab-bar-mode}. This + To toggle the use of Tab Bars, type @kbd{M-x tab-bar-mode}. This command applies to all frames, including frames yet to be created. To control the use of tab bars at startup, customize the variable -@code{tab-bar-mode}. +@code{tab-bar-mode} and save your customization. + +@findex toggle-frame-tab-bar + To toggle the use of the Tab Bar only on the selected frame, type +@kbd{M-x toggle-frame-tab-bar}. This command allows to enable the +display of the Tab Bar on some frames and disable it on others. @vindex tab-bar-show The variable @code{tab-bar-show} controls whether the Tab Bar mode is turned on automatically. If the value is @code{t}, then @code{tab-bar-mode} is enabled when using the commands that create new tabs. The value @code{1} hides the tab bar when it has only one tab, -and shows it again when more tabs are created. The value @code{nil} -always keeps the tab bar hidden; in this case it's still possible to -switch between named window configurations without the tab bar by -using @kbd{M-x tab-next}, @kbd{M-x tab-switcher}, and other commands -that provide completion on tab names. Also it's possible to create -and close tabs without the tab bar by using commands @kbd{M-x -tab-new}, @kbd{M-x tab-close}, etc. +and shows it again when more tabs are created. More generally, a +value that is a non-negative integer causes the Tab Bar to be +displayed only if the number of tabs is greater than that integer. +The value @code{nil} always keeps the Tab Bar hidden; in this case +it's still possible to switch between named window configurations +without displaying the Tab Bar by using @kbd{M-x tab-next}, @kbd{M-x +tab-switcher}, and other commands that provide completion on tab +names. Also it's possible to create and close tabs without the Tab +Bar by using commands @kbd{M-x tab-new}, @kbd{M-x tab-close}, etc. + + Note that a numerical value of @code{tab-bar-show} can cause the Tab +Bar to be displayed on some frames, but not on others, depending on +the number of tabs defined on each frame. @kindex C-x t The prefix key @kbd{C-x t} is analogous to @kbd{C-x 5}. @@ -1336,29 +1350,41 @@ buffer to select. The following commands can be used to select a buffer in a new tab: @table @kbd -@item C-x t 2 @kindex C-x t 2 @findex tab-new +@vindex tab-bar-tab-name-function +@item C-x t 2 Add a new tab (@code{tab-new}). You can control the choice of the buffer displayed in a new tab by customizing the variable -@code{tab-bar-new-tab-choice}. +@code{tab-bar-new-tab-choice}. You can control the names given by +default to new tabs by customizing the variable +@code{tab-bar-tab-name-function}. +@kindex C-x t b +@findex switch-to-buffer-other-tab @item C-x t b @var{bufname} @key{RET} Select buffer @var{bufname} in another tab. This runs @code{switch-to-buffer-other-tab}. +@kindex C-x t f +@findex find-file-other-tab @item C-x t f @var{filename} @key{RET} -Visit file @var{filename} and select its buffer in another tab. This -runs @code{find-file-other-tab}. @xref{Visiting}. +Visit the file @var{filename} (@pxref{Visiting}) and select its buffer +in another tab. This runs @code{find-file-other-tab}. +@kindex C-x t d +@findex dired-other-tab @item C-x t d @var{directory} @key{RET} -Select a Dired buffer for directory @var{directory} in another tab. -This runs @code{dired-other-tab}. @xref{Dired}. +Edit the specified @var{directory} (@pxref{Dired}) in another tab. +This runs @code{dired-other-tab}. +@kindex C-x t t +@findex other-tab-prefix @item C-x t t -A more general prefix command affects the buffer displayed by the next -command invoked immediately after this prefix command. It requests -the buffer of the next command to be displayed in another tab. +This is a prefix command (@code{other-tab-prefix}) that affects the +next command invoked immediately after this prefix command. It +requests the buffer displayed by the next command to be shown in +another tab. @end table @vindex tab-bar-new-tab-choice @@ -1374,17 +1400,18 @@ By default, a new tab is added on the right side of the current tab. The following commands can be used to delete tabs: @table @kbd -@item C-x t 0 @kindex C-x t 0 @findex tab-close -Close the selected tab (@code{tab-close}). It has no effect if there +@vindex tab-bar-close-last-tab-choice +@item C-x t 0 +Close the selected tab (@code{tab-close}). This has no effect if there is only one tab, unless the variable @code{tab-bar-close-last-tab-choice} is customized to a non-default value. -@item C-x t 1 @kindex C-x t 1 @findex tab-close-other -Close all tabs on the selected frame, except the selected one. +@item C-x t 1 +Close all tabs, except the selected tab, on the selected frame. @end table @vindex tab-bar-close-tab-select @@ -1398,75 +1425,92 @@ a recently used tab. The following commands can be used to switch between tabs: @table @kbd -@item C-x t o -@itemx C-@key{TAB} @kindex C-x t o @kindex C-TAB @findex tab-next -Switch to the next tab. If you repeat this command, it cycles through -all the tabs on the selected frame. With a positive numeric argument -@var{n}, it switches to the next @var{n}th tab; with a negative -argument @minus{}@var{n}, it switches back to the previous @var{n}th -tab. +@item C-x t o +@itemx C-@key{TAB} +Switch to the next tab (@code{tab-next}). If you repeat this command, +it cycles through all the tabs on the selected frame. With a positive +numeric argument @var{n}, it switches to the @var{n}th next tab; with +a negative argument @minus{}@var{n}, it switches back to the @var{n}th +previous tab. -@item S-C-@key{TAB} @kindex S-C-TAB @findex tab-previous -Switch to the previous tab. With a positive numeric argument @var{n}, -it switches to the previous @var{n}th tab; with a negative argument -@minus{}@var{n}, it switches back to the next @var{n}th tab. +@item S-C-@key{TAB} +Switch to the previous tab (@code{tab-previous}). With a positive +numeric argument @var{n}, it switches to the @var{n}th previous tab; +with a negative argument @minus{}@var{n}, it switches to the +@var{n}th next tab. +@kindex C-x t @key{RET} +@findex tab-switch @item C-x t @key{RET} @var{tabname} @key{RET} -Switch to the tab by its name, with completion on all tab names. -Default values are tab names sorted by recency, so you can use -@kbd{M-n} (@code{next-history-element}) to get the name of the last -visited tab, the second last, and so on. - -@item @var{modifier}-@var{tabnumber} +Switch to the tab by its name (@code{tab-switch}), with completion on +all tab names. History of used tab names is sorted by recency, so you +can use @kbd{M-n} (@code{next-history-element}) to get the name of the +last visited tab, the second last, and so on. + +@kindex C-1, tab bar +@kindex C-9, tab bar +@kindex M-1, tab bar +@kindex M-9, tab bar @findex tab-select -Switch to the tab by its number. After customizing the variable -@code{tab-bar-select-tab-modifiers} to specify a @var{modifier} key, you -can select a tab by its ordinal number using the specified modifier in -combination with the tab number to select. To display the tab number -alongside the tab name, you can customize another variable -@code{tab-bar-tab-hints}. This will help you to decide what key to press -to select the tab by its number. - -@item @var{modifier}-@kbd{0} +@vindex tab-bar-select-tab-modifiers +@vindex tab-bar-tab-hints +@item @var{modifier}-@var{tab-number} +Switch to the tab by its number @var{tab-number} (@code{tab-select}). +After customizing the variable @code{tab-bar-select-tab-modifiers} to +specify one or more @var{modifier} keys, you can select a tab by its +ordinal number using one of the specified modifiers in combination +with the tab number to select. You can select any modifiers supported +by Emacs, @pxref{Modifier Keys}. To display the tab number alongside +the tab name, you can customize another variable +@code{tab-bar-tab-hints}. This will help you decide which numerical +key to press to select the tab by its number. + +@kindex C-0, tab bar +@kindex M-0, tab bar @findex tab-recent -Switch to the recent tab. The key combination is the modifier key -defined by @code{tab-bar-select-tab-modifiers} and the key @kbd{0}. -With a numeric argument @var{n}, switch to the @var{n}th recent tab. +@item @var{modifier}-@kbd{0} +Switch to the recent tab (@code{tab-recent}). The key combination is +the modifier key defined by @code{tab-bar-select-tab-modifiers} and +the key @kbd{0}. With a numeric argument @var{n}, switch to the +@var{n}th recent tab. @end table The following commands can be used to operate on tabs: @table @kbd -@item C-x t r @var{tabname} @key{RET} +@kindex C-x t r @findex tab-rename -Rename the current tab to @var{tabname}. You can control the -programmatic name given to a tab by default by customizing the -variable @code{tab-bar-tab-name-function}. +@item C-x t r @var{tabname} @key{RET} +Rename the current tab to @var{tabname} (@code{tab-rename}). -@item C-x t m +@kindex C-x t m @findex tab-move -Move the current tab @var{n} positions to the right with a positive -numeric argument @var{n}. With a negative argument @minus{}@var{n}, -move the current tab @var{n} positions to the left. +@item C-x t m +Move the current tab one position to the right (@code{tab-move}). +With a positive numeric argument @var{n}, move it that many positions +to the right; with a negative argument @minus{}@var{n}, move it +@var{n} positions to the left. @end table @findex tab-bar-history-mode You can enable @code{tab-bar-history-mode} to remember window -configurations used in every tab, and restore them. +configurations used in every tab, and later restore them. @table @kbd -@item tab-bar-history-back +@findex tab-bar-history-back +@item M-x tab-bar-history-back Restore a previous window configuration used in the current tab. This navigates back in the history of window configurations. -@item tab-bar-history-forward +@findex tab-bar-history-forward +@item M-x tab-bar-history-forward Cancel restoration of the previous window configuration. -This navigates forward in the history of window configurations. +This moves forward in the history of window configurations. @end table @node Dialog Boxes commit ae6af0ba333ae02c872006af4e771f287c25447f Author: Eli Zaretskii Date: Sun Sep 12 10:01:38 2021 +0300 Improve documentation of some tab-bar features * lisp/tab-bar.el (tab-bar-show, toggle-frame-tab-bar): Doc fixes. * etc/NEWS: Update the corresponding entries. diff --git a/etc/NEWS b/etc/NEWS index 406a73b0ae..ca269aabaa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -419,14 +419,17 @@ scrolling switches to the previous/next tab, and holding the Shift key during scrolling moves the tab to the left/right. --- -*** The tab bar is frame-local when 'tab-bar-show' is a number. -You can show/hide the tab bar independently for each frame, according -to the value of 'tab-bar-show'. +*** Frame-specific appearance of the tab bar when 'tab-bar-show' is a number. +When 'tab-bar-show' is a number, the tab bar on different frames can +be shown or hidden independently, as determined by the number of tabs +on each frame compared to the numerical value of 'tab-bar-show'. --- *** New command 'toggle-frame-tab-bar'. It can be used to enable/disable the tab bar on the currently selected frame regardless of the values of 'tab-bar-mode' and 'tab-bar-show'. +This allows to enable/disable the tab bar independently on different +frames. --- *** New user option 'tab-bar-format' defines a list of tab bar items. diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index faa155c53f..ab6595e45e 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -303,9 +303,9 @@ See `tab-bar-mode' for more information." "Toggle tab bar of the selected frame. When calling from Lisp, use the optional argument FRAME to toggle the tab bar on that frame. -This is useful when you want to enable the tab bar individually +This is useful if you want to enable the tab bar individually on each new frame when the global `tab-bar-mode' is disabled, -or when you want to disable the tab bar individually on each +or if you want to disable the tab bar individually on each new frame when the global `tab-bar-mode' is enabled, by using (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)" @@ -354,14 +354,17 @@ and to bind mouse events to the commands." (defcustom tab-bar-show t "Defines when to show the tab bar. -If t, enable `tab-bar-mode' automatically on using the commands that -create new window configurations (e.g. `tab-new'). -If a non-negative integer, hide the tab bar when the number of the -tabs does not exceed the value of this variable. In particular, +If t, the default, enable `tab-bar-mode' automatically upon using +the commands that create new window configurations (e.g., `tab-new'). +If a non-negative integer, show the tab bar only if the number of +the tabs exceeds the value of this variable. In particular, if the value is 1, hide the tab bar when it has only one tab, and show it again once more tabs are created. A value that is a -non-negative integer also makes the tab bar frame-local: the tab -bar can be shown or hidden independently for each frame. +non-negative integer also makes the tab bar appearance be different +on different frames: the tab bar can be shown on some frames and +hidden on others, depending on how many tab-bar tabs are on that +frame, and whether that number is greater than the numerical value +of this variable. If nil, always keep the tab bar hidden. In this case it's still possible to use persistent named window configurations by relying on keyboard commands `tab-new', `tab-close', `tab-next', `tab-switcher', etc. commit 291bcb5973230c36f9cec6f9fa91b553d944ccd2 Author: Olivier Certner Date: Thu Jan 14 18:36:08 2021 +0100 ERC: Track: Fix a perceived minor bug in mode line face selection * lisp/erc/erc-track.el (erc-track-modified-channels): Fix what is a probable bug when a new insert event happens for a buffer that was not tracked or for which no mode line face was selected: in this case, stop treating the latest buffer's face (first in list) as the previous one, which could be overridden with an older one (in FACES' rest), as if it had happened after. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 7b9a2e9cd5..2582a5039a 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -818,18 +818,15 @@ is in `erc-mode'." (cons (cons (current-buffer) (cons 1 (erc-track-select-mode-line-face - (car faces) (cdr faces)))) + nil faces))) erc-modified-channels-alist)) ;; Else modify the face for the buffer, if necessary. (when faces (let* ((cell (assq (current-buffer) erc-modified-channels-alist)) (old-face (cddr cell)) - (new-face (if old-face - (erc-track-select-mode-line-face - old-face faces) - (erc-track-select-mode-line-face - (car faces) (cdr faces))))) + (new-face (erc-track-select-mode-line-face + old-face faces))) (setcdr cell (cons (1+ (cadr cell)) new-face))))) ;; And display it (erc-modified-channels-display))) commit 3df279aae2a1f0c8dc5acee59dd48840f6695866 Author: Olivier Certner Date: Thu Jan 14 18:26:38 2021 +0100 ERC: Track: Rewrite 'erc-track-find-face' as 'erc-track-select-mode-line-face' * lisp/erc/erc-track.el (erc-track-find-face): Declare obsolete and rewrite as 'erc-track-select-mode-line-face', changing the function arguments, so that it is very clear what the current algorithm is. No functional changes. Performance improvements. Clarify the documentation and remove the part on some faces being lists, which clearly does not apply. (erc-track-modified-channels): Replace calls to 'erc-track-find-face' with calls to 'erc-track-select-mode-line-face', preserving the existing behavior. (erc-modified-channels-alist): Change the reference to 'erc-track-select-mode-line-face' in the documentation following the rename. * etc/NEWS: Announce the change. Co-authored-by: Amin Bandali diff --git a/etc/NEWS b/etc/NEWS index 50cf0748b1..406a73b0ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2653,6 +2653,13 @@ node "(erc) Connecting" in the ERC manual for more details and examples on how to specify and use TLS client certificates with 'erc-tls'. +--- +*** Add 'erc-track-select-mode-line-face' (obsoletes 'erc-track-find-face'). +The 'erc-track-find-face' function of the erc-track module has been +declared obsolete and rewritten as 'erc-track-select-mode-line-face', +with different expected arguments (the current and old faces are now +separated) and clearer documentation. + ** xwidget-webkit mode *** New xwidget commands. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 7cdddbfd38..7b9a2e9cd5 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -275,9 +275,9 @@ is disconnected, provided `erc-track-remove-disconnected-buffers' is true). For how the face is chosen for a buffer, see -`erc-track-find-face' and `erc-track-priority-faces-only'. For -how buffers are then displayed in the mode line, see -`erc-modified-channels-display'.") +`erc-track-select-mode-line-face' and +`erc-track-priority-faces-only'. For how buffers are then +displayed in the mode line, see `erc-modified-channels-display'.") (defcustom erc-track-showcount nil "If non-nil, count of unseen messages will be shown for each channel." @@ -734,37 +734,49 @@ Use `erc-make-mode-line-buffer-name' to create buttons." (erc-modified-channels-display))) (defun erc-track-find-face (faces) - "Return the face to use in the mode line from the faces in FACES. -If `erc-track-faces-priority-list' is set, the one from FACES who -is first in that list will be used. If nothing matches or if -`erc-track-faces-priority-list' is not set, the default mode-line -faces will be used. - -If `erc-track-faces-normal-list' is non-nil, use it to produce a -blinking effect that indicates channel activity when the first -element in FACES and the highest-ranking face among the rest of -FACES are both members of `erc-track-faces-normal-list'. - -If one of the faces is a list, then it will be ranked according -to its highest-tanking face member. A list of faces including -that member will take priority over just the single member -element." + "Return the face to use in the mode line." + (declare (obsolete erc-track-select-mode-line-face "28.1")) + (erc-track-select-mode-line-face (car faces) (cdr faces))) + +(defun erc-track-select-mode-line-face (cur-face new-faces) + "Return the face to use in the mode line. + +CUR-FACE is the face currently used in the mode line (for the +current buffer). NEW-FACES is the list of new faces that have +just been seen (in the current buffer). + +Initially, the selected face is the one with highest priority in +`erc-track-faces-priority-list' (i.e., the one closest to the +front of the list) among CUR-FACE and NEW-FACES. If nothing +matches (including if `erc-track-faces-priority-list' is not +set), the default mode-line faces will be used (NIL is returned). + +If the selected face is still CUR-FACE (highest priority), and +the highest priority face in NEW-FACES alone is different (which +necessarily means it has lower priority than CUR-FACE), and both +are in `erc-track-faces-normal-list', then the latter is selected +instead. This has the effect of allowing the current mode line +face, if a member of `erc-track-faces-normal-list', to be +replaced with another with lower priority face from NEW-FACES, if +that face with highest priority in NEW-FACES is also a member of +`erc-track-faces-normal-list'." (let ((choice (catch 'face - (dolist (candidate erc-track-faces-priority-list) - (when (member candidate faces) - (throw 'face candidate))))) - (no-first (and erc-track-faces-normal-list - (catch 'face - (dolist (candidate erc-track-faces-priority-list) - (when (member candidate (cdr faces)) - (throw 'face candidate))))))) - (cond ((null choice) - nil) - ((and (member choice erc-track-faces-normal-list) - (member no-first erc-track-faces-normal-list)) - no-first) - (t - choice)))) + (dolist (candidate erc-track-faces-priority-list) + (when (or (equal candidate cur-face) + (member candidate new-faces)) + (throw 'face candidate)))))) + (when choice + (if (and (equal choice cur-face) + (member choice erc-track-faces-normal-list)) + (let ((only-in-new + (catch 'face + (dolist (candidate erc-track-faces-priority-list) + (when (member candidate new-faces) + (throw 'face candidate)))))) + (if (member only-in-new erc-track-faces-normal-list) + only-in-new + choice)) + choice)))) (defun erc-track-modified-channels () "Hook function for `erc-insert-post-hook' to check if the current @@ -804,17 +816,20 @@ is in `erc-mode'." ;; Add buffer, faces and counts (setq erc-modified-channels-alist (cons (cons (current-buffer) - (cons 1 (erc-track-find-face faces))) + (cons + 1 (erc-track-select-mode-line-face + (car faces) (cdr faces)))) erc-modified-channels-alist)) ;; Else modify the face for the buffer, if necessary. (when faces (let* ((cell (assq (current-buffer) erc-modified-channels-alist)) (old-face (cddr cell)) - (new-face (erc-track-find-face - (if old-face - (cons old-face faces) - faces)))) + (new-face (if old-face + (erc-track-select-mode-line-face + old-face faces) + (erc-track-select-mode-line-face + (car faces) (cdr faces))))) (setcdr cell (cons (1+ (cadr cell)) new-face))))) ;; And display it (erc-modified-channels-display))) commit e4b7fa05001ef48db28a77e1343ffb196de39609 Merge: 108dbed4c0 d7f4cc0974 Author: Amin Bandali Date: Sat Sep 11 23:03:57 2021 -0400 Merge from origin/emacs-27 d7f4cc0974 ERC: Track: Clarify documentation on tracked buffers and a... fb1f0dfec9 ERC: Track: Fix documentation of structure of 'erc-modifie... 252a769b11 ; * doc/lispref/files.texi (Changing Files): Fix xref to f... edc93a5ce6 ; Fix grammar in efaq.texi on Emacs vs XEmacs. # Conflicts: # doc/misc/efaq.texi commit d7f4cc0974645cc6a295740afe85c6e21d956119 (refs/remotes/origin/emacs-27) Author: Olivier Certner Date: Thu Jan 14 18:20:26 2021 +0100 ERC: Track: Clarify documentation on tracked buffers and add references * lisp/erc/erc-track.el (erc-modified-channels-alist): Clarify what the list contains. Add references to variables and functions involved in displaying tracked buffers from this list. (erc-make-mode-line-buffer-name): Describe exactly the algorithm, and reference custom variables that influence it. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index b6055b6fda..66fde69308 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -284,14 +284,19 @@ nil - don't add to mode line." Each element is a list of the form (BUFFER COUNT . FACE) where BUFFER is a buffer object of the channel the entry corresponds to, COUNT is a number indicating how often activity was noticed, -and FACE is a face (or a list of faces) to use when displaying the -buffer's name. +and FACE is a face (or a list of faces, combined as usual) to use +when displaying the buffer's name in the mode line. -Entries in this list should only happen for buffers where activity occurred -while the buffer was not visible. +Entries in this list are only added/updated for buffers that were +not visible when activity occurred in them, and are removed for +each buffer as soon as it becomes visible again (or if the server +is disconnected, provided `erc-track-remove-disconnected-buffers' +is true). -See also `erc-track-faces-priority-list', -`erc-track-faces-normal-list' and `erc-track-showcount'.") +For how the face is chosen for a buffer, see +`erc-track-find-face' and `erc-track-priority-faces-only'. For +how buffers are then displayed in the mode line, see +`erc-modified-channels-display'.") (defcustom erc-track-showcount nil "If non-nil, count of unseen messages will be shown for each channel." @@ -656,8 +661,14 @@ ARGS are ignored." "The face to use when mouse is over channel names in the mode line.") (defun erc-make-mode-line-buffer-name (string buffer &optional faces count) - "Return STRING as a button that switches to BUFFER when clicked. -If FACES are provided, color STRING with them." + "Returns a button that switches to BUFFER when clicked. +STRING is the string in the button. It is possibly suffixed with +the number of unread messages, according to variables +`erc-track-showcount' and `erc-track-showcount-string'. + +If `erc-track-use-faces' is true and FACES are provided, format +STRING with them. When the mouse hovers above the button, STRING +is displayed according to `erc-track-mouse-face'." ;; We define a new sparse keymap every time, because 1. this data ;; structure is very small, the alternative would require us to ;; defvar a keymap, 2. the user is not interested in customizing it commit fb1f0dfec968d74e887c457e34300ae02a328d52 Author: Olivier Certner Date: Wed Jan 13 17:39:54 2021 +0100 ERC: Track: Fix documentation of structure of 'erc-modified-channels-alist' * lisp/erc/erc-track.el (erc-modified-channels-alist): Fix the docstring: each element is a dotted list where the last cdr is sometimes a proper list, making the element only sometimes a proper list. diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index 1127077065..b6055b6fda 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -281,14 +281,17 @@ nil - don't add to mode line." (defvar erc-modified-channels-alist nil "An ALIST used for tracking channel modification activity. -Each element looks like (BUFFER COUNT FACE) where BUFFER is a buffer -object of the channel the entry corresponds to, COUNT is a number -indicating how often activity was noticed, and FACE is the face to use -when displaying the buffer's name. See `erc-track-faces-priority-list', -and `erc-track-showcount'. +Each element is a list of the form (BUFFER COUNT . FACE) where +BUFFER is a buffer object of the channel the entry corresponds +to, COUNT is a number indicating how often activity was noticed, +and FACE is a face (or a list of faces) to use when displaying the +buffer's name. Entries in this list should only happen for buffers where activity occurred -while the buffer was not visible.") +while the buffer was not visible. + +See also `erc-track-faces-priority-list', +`erc-track-faces-normal-list' and `erc-track-showcount'.") (defcustom erc-track-showcount nil "If non-nil, count of unseen messages will be shown for each channel." commit 108dbed4c0d874f71bc40f63d39d8777ce192303 Author: Dmitry Gutov Date: Sun Sep 12 03:28:38 2021 +0300 Re-fix bug#16897 * lisp/vc/vc-git.el (vc-git--file-list-is-rootdir): Extract from 'vc-git-command'. (vc-git--literal-pathspecs): Use it here as well. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 5835b5b92b..4b309c338a 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -254,7 +254,8 @@ included in the completions." (defun vc-git--literal-pathspecs (files) "Prepend :(literal) path magic to FILES." - (mapcar #'vc-git--literal-pathspec files)) + (unless (vc-git--file-list-is-rootdir files) + (mapcar #'vc-git--literal-pathspec files))) (defun vc-git-registered (file) "Check whether FILE is registered with git." @@ -1792,15 +1793,18 @@ The difference to vc-do-command is that this function always invokes '("GIT_OPTIONAL_LOCKS=0"))) process-environment))) (apply #'vc-do-command (or buffer "*vc*") okstatus vc-git-program - ;; https://debbugs.gnu.org/16897 - (unless (and (not (cdr-safe file-or-list)) - (let ((file (or (car-safe file-or-list) - file-or-list))) - (and file - (eq ?/ (aref file (1- (length file)))) - (equal file (vc-git-root file))))) - file-or-list) - (cons "--no-pager" flags)))) + ;; https://debbugs.gnu.org/16897 + (unless (vc-git--file-list-is-rootdir file-or-list) + file-or-list) + (cons "--no-pager" flags)))) + +(defun vc-git--file-list-is-rootdir (file-or-list) + (and (not (cdr-safe file-or-list)) + (let ((file (or (car-safe file-or-list) + file-or-list))) + (and file + (eq ?/ (aref file (1- (length file)))) + (equal file (vc-git-root file)))))) (defun vc-git--empty-db-p () "Check if the git db is empty (no commit done yet)." commit 6e60e746535e74d49f4a61b78a7844fa221dbba8 Author: Tassilo Horn Date: Sat Sep 11 22:49:29 2021 +0200 Refactor bug-reference setup for software forges * lisp/progmodes/bug-reference.el (bug-reference-gitea-instances) (bug-reference-gitlab-instances,bug-reference-sourcehut-instances): Delete defvars. Those are replaced with bug-reference-forge-alist. (bug-reference-forge-alist): New variable. (bug-reference--build-forge-setup-entry): New cl-defgeneric with methods for github, gitlab, gitea, and sourcehut instances. (bug-reference--setup-from-vc-alist): Use bug-reference-forge-alist and bug-reference--build-forge-setup-entry. * doc/emacs/maintaining.texi (Bug Reference): Mention that the first group in bug-reference-bug-regexp defines the overlay bounds. Also mention bug-reference-forge-alist in VCS setup section. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 8305918336..4ec2b2d72a 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3113,6 +3113,10 @@ these local variables section would do. ;; End: @end smallexample +The string captured by the first regexp group defines the bounds of +the overlay bug-reference creates, i.e., the part which is highlighted +and made clickable. + The string captured by the second regexp group in @code{bug-reference-bug-regexp} is used to replace the @code{%s} template in the @code{bug-reference-url-format}. @@ -3135,20 +3139,22 @@ variables itself by calling the functions in one is able to set the variables. @vindex bug-reference-setup-from-vc-alist +@vindex bug-reference-forge-alist @vindex bug-reference-setup-from-mail-alist @vindex bug-reference-setup-from-irc-alist Right now, there are three types of setup functions. @enumerate @item -Setup for version-controlled files configurable by the variable -@code{bug-reference-setup-from-vc-alist}. The default is able to +Setup for version-controlled files configurable by the variables +@code{bug-reference-forge-alist}, and +@code{bug-reference-setup-from-vc-alist}. The defaults are able to setup GNU projects where @url{https://debbugs.gnu.org} is used as issue tracker and issues are usually referenced as @code{bug#13} (but -many different notations are considered, too), Sourcehut projects -where issues are referenced using the notation @code{#17}, Codeberg -and Github projects where both bugs and pull requests are referenced -using the same notation, and GitLab projects where bugs are referenced -with @code{#17}, too, but merge requests use the @code{!18} notation. +many different notations are considered, too), and several kinds of +modern software forges such as GitLab, Gitea, SourceHut, or GitHub. +If you deploy a self-hosted instance of such a forge, the easiest way +to tell bug-reference about it is through +@code{bug-reference-forge-alist}. @item Setup for email guessing from mail folder/mbox names, and mail header diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index e5d77a0a33..a596b27cd0 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -26,17 +26,17 @@ ;; This file provides minor modes for putting clickable overlays on ;; references to bugs. A bug reference is text like "PR foo/29292"; ;; this is mapped to a URL using a user-supplied format; see -;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More +;; `bug-reference-url-format' and `bug-reference-bug-regexp'. More ;; extensive documentation is in (info "(emacs) Bug Reference"). ;; Two minor modes are provided. One works on any text in the buffer; -;; the other operates only on comments and strings. By default, the +;; the other operates only on comments and strings. By default, the ;; URL link is followed by invoking C-c RET or mouse-2. ;;; Code: (defgroup bug-reference nil - "Hyperlinking references to bug reports" + "Hyperlinking references to bug reports." ;; Somewhat arbitrary, by analogy with eg goto-address. :group 'comm) @@ -125,10 +125,7 @@ to the highlighted and clickable region." (defvar bug-reference-prog-mode) -(defvar bug-reference--nonconforming-regexps nil - "Holds `bug-reference-bug-regexp' values which don't conform to -the documented contract in order to warn about their -non-conformance only once.") +(defvar bug-reference--nonconforming-regexps nil) (defun bug-reference--overlay-bounds () (let ((m-b1 (match-beginning 1)) @@ -171,27 +168,27 @@ subexpression 10." "Apply bug reference overlays to the region between START and END." (save-excursion (let* ((beg-line (progn (goto-char start) (line-beginning-position))) - (end-line (progn (goto-char end) (line-end-position))) + (end-line (progn (goto-char end) (line-end-position))) ;; Reuse existing overlays overlays. (overlays (bug-reference--overlays-in beg-line end-line))) (goto-char beg-line) (while (and (< (point) end-line) - (re-search-forward bug-reference-bug-regexp end-line 'move)) - (when (or (not bug-reference-prog-mode) - ;; This tests for both comment and string syntax. - (nth 8 (syntax-ppss))) - (let* ((bounds (bug-reference--overlay-bounds)) + (re-search-forward bug-reference-bug-regexp end-line 'move)) + (when (or (not bug-reference-prog-mode) + ;; This tests for both comment and string syntax. + (nth 8 (syntax-ppss))) + (let* ((bounds (bug-reference--overlay-bounds)) (overlay (or (let ((ov (pop overlays))) (when ov (move-overlay ov (car bounds) (cdr bounds)) ov)) (let ((ov (make-overlay (car bounds) (cdr bounds) - nil t nil))) + nil t nil))) (overlay-put ov 'category 'bug-reference) ov)))) - ;; Don't put a link if format is undefined. - (when bug-reference-url-format + ;; Don't put a link if format is undefined. + (when bug-reference-url-format (overlay-put overlay 'bug-reference-url (if (stringp bug-reference-url-format) (format bug-reference-url-format @@ -212,14 +209,14 @@ subexpression 10." (if (and (not (integerp pos)) (eventp pos)) ;; POS is a mouse event; switch to the proper window/buffer (let ((posn (event-start pos))) - (with-current-buffer (window-buffer (posn-window posn)) - (bug-reference-push-button (posn-point posn) t))) + (with-current-buffer (window-buffer (posn-window posn)) + (bug-reference-push-button (posn-point posn) t))) ;; POS is just normal position. (dolist (o (overlays-at pos)) ;; It should only be possible to have one URL overlay. (let ((url (overlay-get o 'bug-reference-url))) - (when url - (browse-url url)))))) + (when url + (browse-url url)))))) (defun bug-reference-maybe-setup-from-vc (url url-rx bug-rx bug-url-fmt) (when (string-match url-rx url) @@ -230,54 +227,123 @@ subexpression 10." (push (match-string i url) groups)) (funcall bug-url-fmt (nreverse groups)))))) -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-gitea-instances '("gitea.com" - "codeberg.org") - "List of Gitea forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-gitlab-instances '("gitlab.com" - "salsa.debian.org" - "framagit.org") - "List of GitLab forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - -;; TODO: Change to alist with (HOST PROTOCOL) entries because -;; self-hosted instances might be accessed with http rather than -;; https. -(defvar bug-reference-sourcehut-instances '("sr.ht") - "List of SourceHut forge instances. -When the value is changed after bug-reference has already been -loaded, and performed an auto-setup, evaluate -`(bug-reference--setup-from-vc-alist t)' for rebuilding the value -of `bug-reference--setup-from-vc-alist'.") - (defvar bug-reference--setup-from-vc-alist nil - "An alist for setting up ‘bug-reference-mode’ based on VC URL. + "An alist for setting up `bug-reference-mode' based on VC URL. This is like `bug-reference-setup-from-vc-alist' but generated -for the known free software forges from the variables -`bug-reference-gitea-instances', -`bug-reference-gitlab-instances', and -`bug-reference-sourcehut-instances'.") +from a few default entries, and the value of +`bug-reference-forge-alist'.") + +(defvar bug-reference-forge-alist + '(("github.com" github "https") + ("gitea.com" gitea "https") + ("codeberg.org" gitea "https") + ("gitlab.com" gitlab "https") + ("framagit.org" gitlab "https") + ("salsa.debian.org" gitlab "https") + ("sr.ht" sourcehut "https")) + "An alist of forge instances. +Each entry has the form (HOST-DOMAIN FORGE-TYPE PROTOCOL). +HOST-DOMAIN is the host- and domain name, e.g., gitlab.com, +salsa.debian.org, or sr.ht. +FORGE-TYPE is the type of the forge, e.g., gitlab, gitea, +sourcehut, or github. +PROTOCOL is the protocol for accessing the forge's issue tracker, +usually \"https\" but for self-hosted forge instances not +accessible via the internet it might also be \"http\".") + +(cl-defgeneric bug-reference--build-forge-setup-entry + (host-domain forge-type protocol) + "Build an entry for `bug-reference--setup-from-vc-alist'. +HOST-DOMAIN is the host- and domain name, e.g., gitlab.com, or +sr.ht. + +FORGE-TYPE is the type of the forge, e.g., gitlab, gitea, +sourcehut, or github. + +PROTOCOL is the protocol for accessing the forge's issue tracker, +usually https but for self-hosted forge instances not accessible +via the internet it might also be http.") + +;; GitHub: Here #17 may refer to either an issue or a pull request but +;; visiting the issue/17 web page will automatically redirect to the +;; pull/17 page if 17 is a PR. Explicit user/project#17 links to +;; possibly different projects are also supported. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql github)) protocol) + `(,(concat "[/@]" host-domain "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/issues/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) + +;; GitLab: Here #18 is an issue and !17 is a merge request. Explicit +;; namespace/project#18 or namespace/project!17 references to possibly +;; different projects are also supported. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql gitlab)) protocol) + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/-/%s/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (if (string= (match-string-no-properties 3) "#") + "issues/" + "merge_requests/") + (match-string-no-properties 4))))))) + +;; Gitea: The systematics is exactly as for Github projects. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql gitea)) protocol) + `(,(concat "[/@]" (regexp-quote host-domain) + "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://%s/%s/issues/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) + +;; Sourcehut: #19 is an issue. Other project's issues can be +;; referenced as ~user/project#19. +;; +;; Caveat: The code assumes that a project on git.sr.ht or hg.sr.ht +;; has a tracker of the same name on todo.sh.ht. That's a very common +;; setup but all sr.ht services are loosely coupled, so you can have a +;; repo without tracker, or a repo with a tracker using a different +;; name, etc. So we can only try to make a good guess. +(cl-defmethod bug-reference--build-forge-setup-entry + (host-domain (_forge-type (eql sourcehut)) protocol) + `(,(concat "[/@]\\(?:git\\|hg\\)." (regexp-quote host-domain) + "[/:]\\(~[.A-Za-z0-9_/-]+\\)") + "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" + ,(lambda (groups) + (let ((ns-project (nth 1 groups))) + (lambda () + (format "%s://todo.%s/%s/%s" + protocol host-domain + (or (match-string-no-properties 2) ns-project) + (match-string-no-properties 3))))))) (defun bug-reference--setup-from-vc-alist (&optional rebuild) + "Compute the `bug-reference--setup-from-vc-alist' value. +If REBUILD is non-nil, compute it again even if has been computed +already. The value contains a few default entries, and entries +generated from `bug-reference-forge-alist'." (if (and bug-reference--setup-from-vc-alist (null rebuild)) bug-reference--setup-from-vc-alist (setq bug-reference--setup-from-vc-alist - `(;; - ;; GNU projects on savannah. + `(;; GNU projects on savannah. ;; ;; Not all of them use debbugs but that doesn't really ;; matter because the auto-setup is only performed if @@ -286,95 +352,12 @@ for the known free software forges from the variables ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" ,(lambda (_) "https://debbugs.gnu.org/%s")) - ;; - ;; GitHub projects. - ;; - ;; Here #17 may refer to either an issue or a pull request - ;; but visiting the issue/17 web page will automatically - ;; redirect to the pull/17 page if 17 is a PR. Explicit - ;; user/project#17 links to possibly different projects - ;; are also supported. - ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((ns-project (nth 1 groups))) - (lambda () - (concat "https://github.com/" - (or - ;; Explicit user/proj#18 link. - (match-string 2) - ns-project) - "/issues/" - (match-string 3)))))) - ;; - ;; Gitea instances. - ;; - ;; The systematics is exactly as for Github projects. - (,(concat "[/@]" - (regexp-opt bug-reference-gitea-instances t) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((host (nth 1 groups)) - (ns-project (nth 2 groups))) - (lambda () - (concat "https://" host "/" - (or - ;; Explicit user/proj#18 link. - (match-string 2) - ns-project) - "/issues/" - (match-string 3)))))) - ;; - ;; GitLab instances. - ;; - ;; Here #18 is an issue and !17 is a merge request. - ;; Explicit namespace/project#18 or namespace/project!17 - ;; references to possibly different projects are also - ;; supported. - (,(concat "[/@]" - (regexp-opt bug-reference-gitlab-instances t) - "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((host (nth 1 groups)) - (ns-project (nth 2 groups))) - (lambda () - (concat "https://" host "/" - (or (match-string 2) - ns-project) - "/-/" - (if (string= (match-string 3) "#") - "issues/" - "merge_requests/") - (match-string 4)))))) - ;; - ;; Sourcehut instances. - ;; - ;; #19 is an issue. Other project's issues can be - ;; #referenced as ~user/project#19. - ;; - ;; Caveat: The code assumes that a project on git.sr.ht or - ;; hg.sr.ht has a tracker of the same name on todo.sh.ht. - ;; That's a very common setup but all sr.ht services are - ;; loosely coupled, so you can have a repo without - ;; tracker, or a repo with a tracker using a different - ;; name, etc. So we can only try to make a good guess. - (,(concat "[/@]\\(?:git\\|hg\\)." - (regexp-opt bug-reference-sourcehut-instances t) - "[/:]\\(~[.A-Za-z0-9_/-]+\\)") - "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" - ,(lambda (groups) - (let ((host (nth 1 groups)) - (ns-project (nth 2 groups))) - (lambda () - (concat "https://todo." host "/" - (or - ;; Explicit user/proj#18 link. - (match-string 2) - ns-project) - "/" - (match-string 3)))))))))) + + ;; Entries for the software forges of + ;; `bug-reference-forge-alist'. + ,@(mapcar (lambda (entry) + (apply #'bug-reference--build-forge-setup-entry entry)) + bug-reference-forge-alist))))) (defvar bug-reference-setup-from-vc-alist nil "An alist for setting up `bug-reference-mode' based on VC URL. commit d5c6f701a64413667fb573e12e05b89f8704c3f7 Author: Mattias Engdegård Date: Sat Sep 11 17:13:14 2021 +0200 Fix byte-compilation warnings * lisp/calc/calc-graph.el (calc-gnuplot-check-for-errors): * lisp/calendar/holidays.el (list-holidays): Dodge 'save-excursion+set-buffer' warnings that appeared after the progn flattening was introduced. diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index 9dfdba3930..7891e35c40 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1403,14 +1403,12 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (or calc-graph-no-auto-view (sit-for 0)))) (defun calc-gnuplot-check-for-errors () - (if (save-excursion - (prog2 - (progn - (set-buffer calc-gnuplot-buffer) - (goto-char calc-gnuplot-last-error-pos)) - (re-search-forward "^[ \t]+\\^$" nil t) - (goto-char (point-max)) - (setq calc-gnuplot-last-error-pos (point-max)))) + (if (with-current-buffer calc-gnuplot-buffer + (goto-char calc-gnuplot-last-error-pos) + (prog1 + (re-search-forward "^[ \t]+\\^$" nil t) + (goto-char (point-max)) + (setq calc-gnuplot-last-error-pos (point-max)))) (calc-graph-view-trail))) (defun calc-gnuplot-command (&rest args) diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 3eae2dcc7f..bda5dc5a6b 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -482,7 +482,7 @@ The optional LABEL is used to label the buffer created." (calendar-increment-month displayed-month displayed-year 3) (setq s (calendar-absolute-from-gregorian (list displayed-month 1 displayed-year)))) - (save-excursion + (save-current-buffer (calendar-in-read-only-buffer holiday-buffer (calendar-set-mode-line (if (= y1 y2) commit 09ae3f9f653ff3b98195a81eef6d4748d2817043 Author: Mattias Engdegård Date: Sat Sep 11 14:46:45 2021 +0200 Remove obsolete variable * lisp/emacs-lisp/byte-opt.el (byte-optimize--vars-outside-condition): Remove. (byte-optimize-form-code-walker): Remove bindings. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 175a22dcb8..966ef266b9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -310,13 +310,6 @@ Earlier variables shadow later ones with the same name.") ;;; implementing source-level optimizers -(defvar byte-optimize--vars-outside-condition nil - "Alist of variables lexically bound outside conditionally executed code. -Variables here are sensitive to mutation inside the conditional code, -since their contents in sequentially later code depends on the path taken -and may no longer be statically known. -Same format as `byte-optimize--lexvars', with shared structure and contents.") - (defvar byte-optimize--vars-outside-loop nil "Alist of variables lexically bound outside the innermost `while' loop. Variables here are sensitive to mutation inside the loop, since this can @@ -432,19 +425,19 @@ for speeding up processing.") (`(,(or 'let 'let*) . ,rest) (cons fn (byte-optimize-let-form fn rest for-effect))) (`(cond . ,clauses) - ;; The condition in the first clause is always executed, but - ;; right now we treat all of them as conditional for simplicity. - (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - (cons fn - (mapcar (lambda (clause) - (if (consp clause) - (cons - (byte-optimize-form (car clause) nil) - (byte-optimize-body (cdr clause) for-effect)) - (byte-compile-warn "malformed cond form: `%s'" - (prin1-to-string clause)) - clause)) - clauses)))) + ;; FIXME: The condition in the first clause is always executed, and + ;; clause bodies are mutually exclusive -- use this for improved + ;; optimisation (see comment about `if' below). + (cons fn + (mapcar (lambda (clause) + (if (consp clause) + (cons + (byte-optimize-form (car clause) nil) + (byte-optimize-body (cdr clause) for-effect)) + (byte-compile-warn "malformed cond form: `%s'" + (prin1-to-string clause)) + clause)) + clauses))) (`(progn . ,exps) ;; As an extra added bonus, this simplifies (progn ) --> . (if (cdr exps) @@ -470,22 +463,15 @@ for speeding up processing.") ;; FIXME: We are conservative here: any variable changed in the ;; THEN branch will be barred from substitution in the ELSE ;; branch, despite the branches being mutually exclusive. - - ;; The test is always executed. (let* ((test-opt (byte-optimize-form test nil)) (const (macroexp-const-p test-opt)) - ;; The branches are traversed unconditionally when possible. - (byte-optimize--vars-outside-condition - (if const - byte-optimize--vars-outside-condition - byte-optimize--lexvars)) ;; Avoid traversing dead branches. (then-opt (and test-opt (byte-optimize-form then for-effect))) (else-opt (and (not (and test-opt const)) (byte-optimize-body else for-effect)))) `(if ,test-opt ,then-opt . ,else-opt))) - (`(,(or 'and 'or) . ,exps) ; Remember, and/or are control structures. + (`(,(or 'and 'or) . ,exps) ;; FIXME: We have to traverse the expressions in left-to-right ;; order (because that is the order of evaluation and variable ;; mutations must be found prior to their use), but doing so we miss @@ -494,19 +480,11 @@ for speeding up processing.") ;; Then A could be optimised in a for-effect context too. (let ((tail exps) (args nil)) - (when tail - ;; The first argument is always unconditional. + (while tail (push (byte-optimize-form (car tail) (and for-effect (null (cdr tail)))) args) - (setq tail (cdr tail)) - ;; Remaining arguments are conditional. - (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - (while tail - (push (byte-optimize-form - (car tail) (and for-effect (null (cdr tail)))) - args) - (setq tail (cdr tail))))) + (setq tail (cdr tail))) (cons fn (nreverse args)))) (`(while ,exp . ,exps) @@ -515,13 +493,11 @@ for speeding up processing.") ;; but this misses many opportunities: variables not mutated in the ;; loop at all, and variables affecting the initial condition (which ;; is always executed unconditionally). - (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) - (byte-optimize--vars-outside-loop byte-optimize--lexvars) + (let* ((byte-optimize--vars-outside-loop byte-optimize--lexvars) (condition (byte-optimize-form exp nil)) (body (byte-optimize-body exps t))) `(while ,condition . ,body))) - (`(interactive . ,_) (byte-compile-warn "misplaced interactive spec: `%s'" (prin1-to-string form)) @@ -533,19 +509,18 @@ for speeding up processing.") form) (`(condition-case ,var ,exp . ,clauses) - (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - `(condition-case ,var ;Not evaluated. - ,(byte-optimize-form exp for-effect) - ,@(mapcar (lambda (clause) - (let ((byte-optimize--lexvars - (and lexical-binding - (if var - (cons (list var t) - byte-optimize--lexvars) - byte-optimize--lexvars)))) - (cons (car clause) - (byte-optimize-body (cdr clause) for-effect)))) - clauses)))) + `(condition-case ,var ;Not evaluated. + ,(byte-optimize-form exp for-effect) + ,@(mapcar (lambda (clause) + (let ((byte-optimize--lexvars + (and lexical-binding + (if var + (cons (list var t) + byte-optimize--lexvars) + byte-optimize--lexvars)))) + (cons (car clause) + (byte-optimize-body (cdr clause) for-effect)))) + clauses))) (`(unwind-protect ,exp . ,exps) ;; The unwinding part of an unwind-protect is compiled (and thus @@ -554,8 +529,7 @@ for speeding up processing.") ;; protected part has the same for-effect status as the ;; unwind-protect itself. (The unwinding part is always for effect, ;; but that isn't handled properly yet.) - (let* ((byte-optimize--vars-outside-condition byte-optimize--lexvars) - (bodyform (byte-optimize-form exp for-effect))) + (let ((bodyform (byte-optimize-form exp for-effect))) (pcase exps (`(:fun-body ,f) `(unwind-protect ,bodyform @@ -565,9 +539,8 @@ for speeding up processing.") . ,(byte-optimize-body exps t)))))) (`(catch ,tag . ,exps) - (let ((byte-optimize--vars-outside-condition byte-optimize--lexvars)) - `(catch ,(byte-optimize-form tag nil) - . ,(byte-optimize-body exps for-effect)))) + `(catch ,(byte-optimize-form tag nil) + . ,(byte-optimize-body exps for-effect))) ;; Needed as long as we run byte-optimize-form after cconv. (`(internal-make-closure . ,_) commit 020a408edabcbaa3722af6fc5bb8b5fe6add6af0 Author: Mattias Engdegård Date: Fri Jul 30 13:44:07 2021 +0200 Propagate aliased lexical variables in byte compiler Replace uses of a variable aliasing another variable with that aliased variable, to allow for variable removal when possible. This also enables opportunities for other optimisations. Example: (let ((y x)) (f y)) => (f x) The optimisation is only performed if both aliased and aliasing variables are lexically bound. Shadowing bindings are α-renamed when necessary for correctness. Example: (let* ((b a) (a EXPR)) (f a b)) => (let* ((a{new} EXPR)) (f a{new} a)) * lisp/emacs-lisp/byte-opt.el (byte-optimize--aliased-vars): New. (byte-optimize-form-code-walker): Cancel aliasing upon mutation. (byte-optimize--rename-var-body, byte-optimize--rename-var): New. (byte-optimize-let-form): Add the optimisation. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): Add relevant test cases. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index ff512cca36..175a22dcb8 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -327,6 +327,13 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (defvar byte-optimize--dynamic-vars nil "List of variables declared as dynamic during optimisation.") +(defvar byte-optimize--aliased-vars nil + "List of variables which may be aliased by other lexical variables. +If an entry in `byte-optimize--lexvars' has another variable as its VALUE, +then that other variable must be in this list. +This variable thus carries no essential information but is maintained +for speeding up processing.") + (defun byte-optimize--substitutable-p (expr) "Whether EXPR is a constant that can be propagated." ;; Only consider numbers, symbols and strings to be values for substitution @@ -595,7 +602,15 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (value (byte-optimize-form expr nil))) (when lexvar (setcar (cdr lexvar) t) ; Mark variable to be kept. - (setcdr (cdr lexvar) nil)) ; Inhibit further substitution. + (setcdr (cdr lexvar) nil) ; Inhibit further substitution. + + (when (memq var byte-optimize--aliased-vars) + ;; Cancel aliasing of variables aliased to this one. + (dolist (v byte-optimize--lexvars) + (when (eq (nth 2 v) var) + ;; V is bound to VAR but VAR is now mutated: + ;; cancel aliasing. + (setcdr (cdr v) nil))))) (push var var-expr-list) (push value var-expr-list)) @@ -666,34 +681,142 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.") (not (eq new old)))))))) form) +(defun byte-optimize--rename-var-body (var new-var body) + "Replace VAR with NEW-VAR in BODY." + (mapcar (lambda (form) (byte-optimize--rename-var var new-var form)) body)) + +(defun byte-optimize--rename-var (var new-var form) + "Replace VAR with NEW-VAR in FORM." + (pcase form + ((pred symbolp) (if (eq form var) new-var form)) + (`(setq . ,args) + (let ((new-args nil)) + (while args + (push (byte-optimize--rename-var var new-var (car args)) new-args) + (push (byte-optimize--rename-var var new-var (cadr args)) new-args) + (setq args (cddr args))) + `(setq . ,(nreverse new-args)))) + ;; In binding constructs like `let', `let*' and `condition-case' we + ;; rename everything for simplicity, even new bindings named VAR. + (`(,(and head (or 'let 'let*)) ,bindings . ,body) + `(,head + ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b)) + bindings) + ,@(byte-optimize--rename-var-body var new-var body))) + (`(condition-case ,res-var ,protected-form . ,handlers) + `(condition-case ,(byte-optimize--rename-var var new-var res-var) + ,(byte-optimize--rename-var var new-var protected-form) + ,@(mapcar (lambda (h) + (cons (car h) + (byte-optimize--rename-var-body var new-var (cdr h)))) + handlers))) + (`(internal-make-closure ,vars ,env . ,rest) + `(internal-make-closure + ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest)) + (`(defvar ,name . ,rest) + ;; NAME is not renamed here; we only care about lexical variables. + `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest))) + + (`(cond . ,clauses) + `(cond ,@(mapcar (lambda (c) + (byte-optimize--rename-var-body var new-var c)) + clauses))) + + (`(function . ,_) form) + (`(quote . ,_) form) + (`(lambda . ,_) form) + + ;; Function calls and special forms not handled above. + (`(,head . ,args) + `(,head . ,(byte-optimize--rename-var-body var new-var args))) + (_ form))) + (defun byte-optimize-let-form (head form for-effect) ;; Recursively enter the optimizer for the bindings and body ;; of a let or let*. This for depth-firstness: forms that ;; are more deeply nested are optimized first. (if lexical-binding (let* ((byte-optimize--lexvars byte-optimize--lexvars) + (byte-optimize--aliased-vars byte-optimize--aliased-vars) (new-lexvars nil) - (let-vars nil)) - (dolist (binding (car form)) - (let* ((name (car binding)) - (expr (byte-optimize-form (cadr binding) nil)) - (value (and (byte-optimize--substitutable-p expr) - (list expr))) - (lexical (not (or (special-variable-p name) - (memq name byte-compile-bound-variables) - (memq name byte-optimize--dynamic-vars)))) - (lexinfo (and lexical (cons name (cons nil value))))) - (push (cons name (cons expr (cdr lexinfo))) let-vars) - (when lexinfo - (push lexinfo (if (eq head 'let*) - byte-optimize--lexvars - new-lexvars))))) + (new-aliased-vars nil) + (let-vars nil) + (body (cdr form)) + (bindings (car form))) + (while bindings + (let* ((binding (car bindings)) + (name (car binding)) + (expr (byte-optimize-form (cadr binding) nil))) + (setq bindings (cdr bindings)) + (when (and (eq head 'let*) + (memq name byte-optimize--aliased-vars)) + ;; New variable shadows an aliased variable -- α-rename + ;; it in this and all subsequent bindings. + (let ((new-name (make-symbol (symbol-name name)))) + (setq bindings + (mapcar (lambda (b) + (list (byte-optimize--rename-var + name new-name (car b)) + (byte-optimize--rename-var + name new-name (cadr b)))) + bindings)) + (setq body (byte-optimize--rename-var-body name new-name body)) + (setq name new-name))) + (let* ((aliased nil) + (value (and + (or (byte-optimize--substitutable-p expr) + ;; Aliasing another lexvar. + (setq aliased + (and (symbolp expr) + (assq expr byte-optimize--lexvars)))) + (list expr))) + (lexical (not (or (special-variable-p name) + (memq name byte-compile-bound-variables) + (memq name byte-optimize--dynamic-vars)))) + (lexinfo (and lexical (cons name (cons nil value))))) + (push (cons name (cons expr (cdr lexinfo))) let-vars) + (when lexinfo + (push lexinfo (if (eq head 'let*) + byte-optimize--lexvars + new-lexvars))) + (when aliased + (push expr (if (eq head 'let*) + byte-optimize--aliased-vars + new-aliased-vars)))))) + + (setq byte-optimize--aliased-vars + (append new-aliased-vars byte-optimize--aliased-vars)) + (when (and (eq head 'let) byte-optimize--aliased-vars) + ;; Find new variables that shadow aliased variables. + (let ((shadowing-vars nil)) + (dolist (lexvar new-lexvars) + (let ((name (car lexvar))) + (when (and (memq name byte-optimize--aliased-vars) + (not (memq name shadowing-vars))) + (push name shadowing-vars)))) + ;; α-rename them + (dolist (name shadowing-vars) + (let ((new-name (make-symbol (symbol-name name)))) + (setq new-lexvars + (mapcar (lambda (lexvar) + (if (eq (car lexvar) name) + (cons new-name (cdr lexvar)) + lexvar)) + new-lexvars)) + (setq let-vars + (mapcar (lambda (v) + (if (eq (car v) name) + (cons new-name (cdr v)) + v)) + let-vars)) + (setq body (byte-optimize--rename-var-body + name new-name body)))))) (setq byte-optimize--lexvars (append new-lexvars byte-optimize--lexvars)) ;; Walk the body expressions, which may mutate some of the records, ;; and generate new bindings that exclude unused variables. (let* ((byte-optimize--dynamic-vars byte-optimize--dynamic-vars) - (opt-body (byte-optimize-body (cdr form) for-effect)) + (opt-body (byte-optimize-body body for-effect)) (bindings nil)) (dolist (var let-vars) ;; VAR is (NAME EXPR [KEEP [VALUE]]) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index ac96494cab..2832dd0246 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -551,6 +551,50 @@ (let ((n 0)) (list (mapcar (lambda (x) (assoc (setq n (1+ n)) nil)) '(a "nil")) n)) + + ;; Exercise variable-aliasing optimisations. + (let ((a (list 1))) + (let ((b a)) + (let ((a (list 2))) + (list a b)))) + + (let ((a (list 1))) + (let ((a (list 2)) + (b a)) + (list a b))) + + (let* ((a (list 1)) + (b a) + (a (list 2))) + (condition-case a + (list a b) + (error (list 'error a b)))) + + (let* ((a (list 1)) + (b a) + (a (list 2))) + (condition-case a + (/ 0) + (error (list 'error a b)))) + + (let* ((a (list 1)) + (b a) + (a (list 2)) + (f (list (lambda (x) (list x a))))) + (funcall (car f) 3)) + + (let* ((a (list 1)) + (b a) + (f (list (lambda (x) (setq a x))))) + (funcall (car f) 3) + (list a b)) + + (let* ((a (list 1)) + (b a) + (a (list 2)) + (f (list (lambda (x) (setq a x))))) + (funcall (car f) 3) + (list a b)) ) "List of expressions for cross-testing interpreted and compiled code.") commit 376a31b0cdf64f4264904e2a9d49216959a35bd2 Merge: c7aaf2fcb8 84e35ff786 Author: Eli Zaretskii Date: Sat Sep 11 17:50:42 2021 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit c7aaf2fcb87b0c7ed4205be9ba2c26051c13920b Author: Eli Zaretskii Date: Sat Sep 11 17:50:08 2021 +0300 ; * src/w32term.c (w32_read_socket): Avoid compiler warning. diff --git a/src/w32term.c b/src/w32term.c index 3eb078a66d..70e5501db1 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -5225,8 +5225,8 @@ w32_read_socket (struct terminal *terminal, && !frame_ancestor_p (f, dpyinfo->w32_focus_frame))) inev.kind = NO_EVENT; - if (!NILP (tab_bar_arg)) - inev.arg = tab_bar_arg; + if (!NILP (tab_bar_arg)) + inev.arg = tab_bar_arg; /* Is this in the tool-bar? */ if (WINDOWP (f->tool_bar_window) commit 84e35ff78667a730d6f23d995ff649ded32cd420 Author: Augusto Stoffel Date: Sat Sep 11 15:39:13 2021 +0200 Keep python.el compatible with older Emacsen * progmodes/python.el (python-shell-send-string): Don't assume comint-max-line-length is defined (bug#50503). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 9cf88ea656..d9fc5c5009 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3163,7 +3163,9 @@ t when called interactively." (python-shell--encode-string (or (buffer-file-name) ""))))) (if (or (null (process-tty-name process)) - (<= (string-bytes code) comint-max-line-length)) + (<= (string-bytes code) + (or (bound-and-true-p comint-max-line-length) + 1024))) ;; For Emacs < 28 (comint-send-string process code) (let* ((temp-file-name (with-current-buffer (process-buffer process) (python-shell--save-temp-file string))) commit ef65d717d0a1eeb6530176b59aa03cd09efb5fa9 Author: Michael Albinus Date: Sat Sep 11 15:35:51 2021 +0200 Tramp code cleanup * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory): Simplify. * lisp/net/tramp-sh.el (tramp-methods) : Don't use "%n" marker. * test/lisp/net/tramp-tests.el (tramp-test13-make-directory): Merge with `tramp-test-make-directory-helper' and `tramp-test13-make-directory-with-file-modes'. (tramp-test44-asynchronous-requests): Use always the same operation in timer. diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index eb889bb4f2..25deead813 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1574,10 +1574,10 @@ If FILE-SYSTEM is non-nil, return file system attributes." (when (and parents (not (file-directory-p ldir))) (make-directory ldir parents)) ;; Just do it. - (or (let ((mkdir-succeeded - (tramp-gvfs-send-command - v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)))) - (if mkdir-succeeded (set-file-modes dir (default-file-modes))) + (or (when-let ((mkdir-succeeded + (tramp-gvfs-send-command + v "gvfs-mkdir" (tramp-gvfs-url-file-name dir)))) + (set-file-modes dir (default-file-modes)) mkdir-succeeded) (and parents (file-directory-p dir)) (tramp-error v 'file-error "Couldn't make directory %s" dir)))))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e57145e8e7..dc049782fd 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -244,14 +244,14 @@ The string is used in `tramp-methods'.") (add-to-list 'tramp-methods `("telnet" (tramp-login-program "telnet") - (tramp-login-args (("%h") ("%p") ("%n"))) + (tramp-login-args (("%h") ("%p"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")))) (add-to-list 'tramp-methods `("nc" (tramp-login-program "telnet") - (tramp-login-args (("%h") ("%p") ("%n"))) + (tramp-login-args (("%h") ("%p"))) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-c")) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 393302d7e1..af4f45d691 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2765,12 +2765,12 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (delete-directory source 'recursive)) (ignore-errors (delete-directory target 'recursive)))))))) -(defun tramp-test-make-directory-helper (test-default-file-modes-p) - "Helper test used by tramp-test13-make-directory* tests." - (dolist (quoted (if (and (tramp--test-expensive-test) - (not test-default-file-modes-p)) - '(nil t) - '(nil))) +(ert-deftest tramp-test13-make-directory () + "Check `make-directory'. +This tests also `file-directory-p' and `file-accessible-directory-p'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "foo/bar" tmp-name1)) (unusual-file-mode-1 #o740) @@ -2784,9 +2784,9 @@ This checks also `file-name-as-directory', `file-name-directory', :type 'file-already-exists) (should (file-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1)) - (and test-default-file-modes-p - (should (equal (format "%#o" unusual-file-mode-1) - (format "%#o" (file-modes tmp-name1))))) + (when (tramp--test-supports-file-modes-p) + (should (equal (format "%#o" unusual-file-mode-1) + (format "%#o" (file-modes tmp-name1))))) (should-error (make-directory tmp-name2) :type 'file-error) @@ -2794,9 +2794,9 @@ This checks also `file-name-as-directory', `file-name-directory', (make-directory tmp-name2 'parents)) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2)) - (and test-default-file-modes-p - (should (equal (format "%#o" unusual-file-mode-2) - (format "%#o" (file-modes tmp-name2))))) + (when (tramp--test-supports-file-modes-p) + (should (equal (format "%#o" unusual-file-mode-2) + (format "%#o" (file-modes tmp-name2))))) ;; If PARENTS is non-nil, `make-directory' shall not ;; signal an error when DIR exists already. (make-directory tmp-name2 'parents)) @@ -2804,20 +2804,6 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -(ert-deftest tramp-test13-make-directory () - "Check `make-directory'. -This tests also `file-directory-p' and `file-accessible-directory-p'." - (skip-unless (tramp--test-enabled)) - (tramp-test-make-directory-helper nil)) - -(ert-deftest tramp-test13-make-directory-with-file-modes () - "Check that `make-directory' honors `default-file-modes'. -This is a separate test from `tramp-test13-make-directory' so -it can be skipped for backends that do not support file modes." - (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-supports-file-modes-p)) - (tramp-test-make-directory-helper t)) - (ert-deftest tramp-test14-delete-directory () "Check `delete-directory'." (skip-unless (tramp--test-enabled)) @@ -6763,11 +6749,6 @@ process sentinels. They shall not disturb each other." (cond ((getenv "EMACS_HYDRA_CI") 10) (t 1))) - ;; We must distinguish due to performance reasons. - (timer-operation - (cond - ((tramp--test-mock-p) #'vc-registered) - (t #'file-attributes))) ;; This is when all timers start. We check inside the ;; timer function, that we don't exceed timeout. (timer-start (current-time)) @@ -6803,7 +6784,7 @@ process sentinels. They shall not disturb each other." (cons 'remote-file-error debug-ignored-errors))) (tramp--test-message "Start timer %s %s" file (current-time-string)) - (funcall timer-operation file) + (vc-registered file) (tramp--test-message "Stop timer %s %s" file (current-time-string)) ;; Adjust timer if it takes too much time. commit 6343384348180b18be191be64d7106c4866c0675 Author: Augusto Stoffel Date: Sat Sep 11 15:02:04 2021 +0200 Allow using 'python-shell-send-file' across machines * progmodes/python.el (python-shell-eval-file-setup-code): Look for a file coding cookie on the Python rather than on the Emacs side, to avoid additional file transfers. (python-shell--save-temp-file): Allow argument to be a buffer. (python-shell-send-file): Address the case where the selected file and the inferior process are on different machines (bug#50516). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e71a8102df..9cf88ea656 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2842,14 +2842,20 @@ def __PYTHON_EL_eval(source, filename): (defconst python-shell-eval-file-setup-code "\ -def __PYTHON_EL_eval_file(filename, tempname, encoding, delete): - import codecs, os +def __PYTHON_EL_eval_file(filename, tempname, delete): + import codecs, os, re + pattern = r'^[ \t\f]*#.*?coding[:=][ \t]*([-_.a-zA-Z0-9]+)' + with codecs.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: source = file.read().encode(encoding) if delete and tempname: os.remove(tempname) return __PYTHON_EL_eval(source, filename)" - "Code used to evaluate files in inferior Python processes.") + "Code used to evaluate files in inferior Python processes. +The coding cookie regexp is specified in PEP 263.") (defun python-shell-comint-watch-for-first-prompt-output-filter (output) "Run `python-shell-first-prompt-hook' when first prompt is found in OUTPUT." @@ -3126,7 +3132,9 @@ there for compatibility with CEDET.") (temp-file-name (make-temp-file "py")) (coding-system-for-write (python-info-encoding))) (with-temp-file temp-file-name - (insert string) + (if (bufferp string) + (insert-buffer-substring string) + (insert string)) (delete-trailing-whitespace)) temp-file-name)) @@ -3402,11 +3410,15 @@ t when called interactively." (defun python-shell-send-file (file-name &optional process temp-file-name delete msg) "Send FILE-NAME to inferior Python PROCESS. + If TEMP-FILE-NAME is passed then that file is used for processing instead, while internally the shell will continue to use -FILE-NAME. If TEMP-FILE-NAME and DELETE are non-nil, then -TEMP-FILE-NAME is deleted after evaluation is performed. When -optional argument MSG is non-nil, forces display of a +FILE-NAME. FILE-NAME can be remote, but TEMP-FILE-NAME must be +in the same host as PROCESS. If TEMP-FILE-NAME and DELETE are +non-nil, then TEMP-FILE-NAME is deleted after evaluation is +performed. + +When optional argument MSG is non-nil, forces display of a user-friendly message if there's no process running; defaults to t when called interactively." (interactive @@ -3416,22 +3428,25 @@ t when called interactively." nil ; temp-file-name nil ; delete t)) ; msg - (let* ((process (or process (python-shell-get-process-or-error msg))) - (encoding (with-temp-buffer - (insert-file-contents - (or temp-file-name file-name)) - (python-info-encoding))) - (file-name (file-local-name (expand-file-name file-name))) + (setq process (or process (python-shell-get-process-or-error msg))) + (with-current-buffer (process-buffer process) + (unless (or temp-file-name + (string= (file-remote-p file-name) + (file-remote-p default-directory))) + (setq delete t + temp-file-name (with-temp-buffer + (insert-file-contents file-name) + (python-shell--save-temp-file (current-buffer)))))) + (let* ((file-name (file-local-name (expand-file-name file-name))) (temp-file-name (when temp-file-name (file-local-name (expand-file-name temp-file-name))))) (comint-send-string process (format - "__PYTHON_EL_eval_file(%s, %s, %s, %s)\n" + "__PYTHON_EL_eval_file(%s, %s, %s)\n" (python-shell--encode-string file-name) (python-shell--encode-string (or temp-file-name "")) - (python-shell--encode-string (symbol-name encoding)) (if delete "True" "False"))))) (defun python-shell-switch-to-shell (&optional msg) commit afa82b3f7f864467ebf8807d0d3b95376383d5af Author: Eli Zaretskii Date: Sat Sep 11 15:59:32 2021 +0300 ; * src/keyboard.c (make_lispy_position): Fix a recent change. diff --git a/src/keyboard.c b/src/keyboard.c index 9d435b7360..63bf29a948 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5105,8 +5105,11 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, #ifdef HAVE_WINDOW_SYSTEM if ((WINDOWP (f->tab_bar_window) && EQ (window_or_frame, f->tab_bar_window)) +#ifndef HAVE_EXT_TOOL_BAR || (WINDOWP (f->tool_bar_window) - && EQ (window_or_frame, f->tool_bar_window))) + && EQ (window_or_frame, f->tool_bar_window)) +#endif + ) { posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; /* Kludge alert: for mouse events on the tab bar and tool bar, commit e4300777e8cc7559ea29faaeab6cafd3f7ebf3b7 Author: Augusto Stoffel Date: Sat Sep 11 14:50:28 2021 +0200 Implement caching for 'python-shell-completion-at-point' * lisp/progmodes/python.el (python-shell-completion-at-point): cache results, since computing them involves talking with the inferior process and, potentially, network communications (python-shell--capf-cache): new variable, for cache (python-shell-completion-get-completions) (python-shell-completion-native-get-completions): 'import' argument is not needed anymore. (python-shell-completion-native-setup) (python-shell-completion-native-try): pass the setup code synchronously, to avoid printing a message in the shell (bug#50459). diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 2eef52de0c..e71a8102df 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -3577,13 +3577,12 @@ When a match is found, native completion is disabled." python-shell-completion-native-try-output-timeout)) (python-shell-completion-native-get-completions (get-buffer-process (current-buffer)) - nil "_"))) + "_"))) (defun python-shell-completion-native-setup () "Try to setup native completion, return non-nil on success." - (let ((process (python-shell-get-process))) - (with-current-buffer (process-buffer process) - (python-shell-send-string " + (let* ((process (python-shell-get-process)) + (output (python-shell-send-string-no-output " def __PYTHON_EL_native_completion_setup(): try: import readline @@ -3693,14 +3692,10 @@ def __PYTHON_EL_native_completion_setup(): print ('python.el: native completion setup failed, %s: %s' % sys.exc_info()[:2]) -__PYTHON_EL_native_completion_setup()" process) - (when (and - (python-shell-accept-process-output - process python-shell-completion-native-try-output-timeout) - (save-excursion - (re-search-backward - (regexp-quote "python.el: native completion setup loaded") nil t 1))) - (python-shell-completion-native-try))))) +__PYTHON_EL_native_completion_setup()" process))) + (when (string-match-p "python\\.el: native completion setup loaded" + output) + (python-shell-completion-native-try)))) (defun python-shell-completion-native-turn-off (&optional msg) "Turn off shell native completions. @@ -3760,13 +3755,10 @@ With argument MSG show activation/deactivation message." (python-shell-completion-native-turn-on msg)) python-shell-completion-native-enable)) -(defun python-shell-completion-native-get-completions (process import input) - "Get completions using native readline for PROCESS. -When IMPORT is non-nil takes precedence over INPUT for -completion." +(defun python-shell-completion-native-get-completions (process input) + "Get completions of INPUT using native readline for PROCESS." (with-current-buffer (process-buffer process) - (let* ((input (or import input)) - (original-filter-fn (process-filter process)) + (let* ((original-filter-fn (process-filter process)) (redirect-buffer (get-buffer-create python-shell-completion-native-redirect-buffer)) (trigger "\t") @@ -3818,11 +3810,8 @@ completion." :test #'string=)))) (set-process-filter process original-filter-fn))))) -(defun python-shell-completion-get-completions (process import input) - "Do completion at point using PROCESS for IMPORT or INPUT. -When IMPORT is non-nil takes precedence over INPUT for -completion." - (setq input (or import input)) +(defun python-shell-completion-get-completions (process input) + "Get completions of INPUT using PROCESS." (with-current-buffer (process-buffer process) (let ((completions (python-util-strip-string @@ -3836,6 +3825,9 @@ completion." (split-string completions "^'\\|^\"\\|;\\|'$\\|\"$" t))))) +(defvar-local python-shell--capf-cache nil + "Variable to store cached completions and invalidation keys.") + (defun python-shell-completion-at-point (&optional process) "Function for `completion-at-point-functions' in `inferior-python-mode'. Optional argument PROCESS forces completions to be retrieved @@ -3889,12 +3881,21 @@ using that one instead of current buffer's process." ;; it during a multiline statement (Bug#28051). #'ignore #'python-shell-completion-get-completions)) - (t #'python-shell-completion-native-get-completions))))) - (list start end - (completion-table-dynamic - (apply-partially - completion-fn - process import-statement))))) + (t #'python-shell-completion-native-get-completions)))) + (prev-prompt (car python-shell--capf-cache)) + (re (or (cadr python-shell--capf-cache) regexp-unmatchable)) + (prefix (buffer-substring-no-properties start end))) + ;; To invalidate the cache, we check if the prompt position or the + ;; completion prefix changed. + (unless (and (equal prev-prompt (car prompt-boundaries)) + (string-match re prefix)) + (setq python-shell--capf-cache + `(,(car prompt-boundaries) + ,(if (string-empty-p prefix) + regexp-unmatchable + (concat "\\`" (regexp-quote prefix) "\\(?:\\sw\\|\\s_\\)*\\'")) + ,@(funcall completion-fn process (or import-statement prefix))))) + (list start end (cddr python-shell--capf-cache)))) (define-obsolete-function-alias 'python-shell-completion-complete-at-point commit e40f5a91eed69b5d6131671ba1699ce3ccb92f16 Author: Alan Third Date: Wed Sep 8 17:57:50 2021 +0100 Fix display of tab-bar buttons * src/xterm.c (x_draw_image_relief): * src/w32term.c (w32_draw_image_relief): Fix the display of tab-bar buttons when mouse pointer moves off the button. (Bug#50424) diff --git a/src/w32term.c b/src/w32term.c index 9ee3b1ed1f..3eb078a66d 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -2057,11 +2057,11 @@ w32_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtab_bar_button_margin)) && FIXNUMP (XCDR (Vtab_bar_button_margin))) { - extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)); - extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; } else if (FIXNUMP (Vtab_bar_button_margin)) - extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; } if (s->face->id == TOOL_BAR_FACE_ID) diff --git a/src/xterm.c b/src/xterm.c index 4c1754ac80..2c56c73068 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3235,11 +3235,11 @@ x_draw_image_relief (struct glyph_string *s) && FIXNUMP (XCAR (Vtab_bar_button_margin)) && FIXNUMP (XCDR (Vtab_bar_button_margin))) { - extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)); - extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)); + extra_x = XFIXNUM (XCAR (Vtab_bar_button_margin)) - thick; + extra_y = XFIXNUM (XCDR (Vtab_bar_button_margin)) - thick; } else if (FIXNUMP (Vtab_bar_button_margin)) - extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin); + extra_x = extra_y = XFIXNUM (Vtab_bar_button_margin) - thick; } if (s->face->id == TOOL_BAR_FACE_ID) commit aa6cacd7138519aa8906c850950020d0546ae355 Author: Eli Zaretskii Date: Sat Sep 11 14:40:51 2021 +0300 Document tool-bar and tab-bar mouse events * doc/lispref/commands.texi (Click Events): Document the format of POSITION for tab-bar and tool-bar events. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 6d45099867..ddd74d1245 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1424,9 +1424,12 @@ binding of the key sequence. @subsection Click Events @cindex click event @cindex mouse click event +@cindex mouse wheel event When the user presses a mouse button and releases it at the same -location, that generates a @dfn{click} event. All mouse click event +location, that generates a @dfn{click} event. Depending on how your +window-system reports mouse-wheel events, turning the mouse wheel can +generate either a mouse click or a mouse-wheel event. All mouse event share the same format: @example @@ -1437,7 +1440,8 @@ share the same format: @item @var{event-type} This is a symbol that indicates which mouse button was used. It is one of the symbols @code{mouse-1}, @code{mouse-2}, @dots{}, where the -buttons are numbered left to right. +buttons are numbered left to right. For mouse-wheel event, it can be +@code{wheel-up} or @code{wheel-down}. You can also use prefixes @samp{A-}, @samp{C-}, @samp{H-}, @samp{M-}, @samp{S-} and @samp{s-} for modifiers alt, control, hyper, meta, shift @@ -1450,19 +1454,20 @@ describe events by their types; thus, if there is a key binding for @item @var{position} @cindex mouse position list -This is a @dfn{mouse position list} specifying where the mouse click +This is a @dfn{mouse position list} specifying where the mouse event occurred; see below for details. @item @var{click-count} This is the number of rapid repeated presses so far of the same mouse -button. @xref{Repeat Events}. +button or the number of repeated turns of the wheel. @xref{Repeat +Events}. @end table To access the contents of a mouse position list in the -@var{position} slot of a click event, you should typically use the +@var{position} slot of a mouse event, you should typically use the functions documented in @ref{Accessing Mouse}. -The explicit format of the list depends on where the click occurred. +The explicit format of the list depends on where the event occurred. For clicks in the text area, mode line, header line, tab line, or in the fringe or marginal areas, the mouse position list has the form @@ -1477,11 +1482,11 @@ The meanings of these list elements are as follows: @table @asis @item @var{window} -The window in which the click occurred. +The window in which the mouse event occurred. @item @var{pos-or-area} The buffer position of the character clicked on in the text area; or, -if the click was outside the text area, the window area where it +if the event was outside the text area, the window area where it occurred. It is one of the symbols @code{mode-line}, @code{header-line}, @code{tab-line}, @code{vertical-line}, @code{left-margin}, @code{right-margin}, @code{left-fringe}, or @@ -1493,10 +1498,10 @@ happens after the imaginary prefix keys for the event are registered by Emacs. @xref{Key Sequence Input}. @item @var{x}, @var{y} -The relative pixel coordinates of the click. For clicks in the text +The relative pixel coordinates of the event. For events in the text area of a window, the coordinate origin @code{(0 . 0)} is taken to be the top left corner of the text area. @xref{Window Sizes}. For -clicks in a mode line, header line or tab line, the coordinate origin +events in a mode line, header line or tab line, the coordinate origin is the top left corner of the window itself. For fringes, margins, and the vertical border, @var{x} does not have meaningful data. For fringes and margins, @var{y} is relative to the bottom edge of the @@ -1508,9 +1513,9 @@ The time at which the event occurred, as an integer number of milliseconds since a system-dependent initial time. @item @var{object} -Either @code{nil}, which means the click occurred on buffer text, or a +Either @code{nil}, which means the event occurred on buffer text, or a cons cell of the form @w{(@var{string} . @var{string-pos})} if there -is a string from a text property or an overlay at the click position. +is a string from a text property or an overlay at the event position. @table @asis @item @var{string} @@ -1595,7 +1600,8 @@ handle), @code{up} (the up arrow at one end of the scroll bar), or @end table For clicks on the frame's internal border (@pxref{Frame Layout}), -@var{position} has this form: +the frame's tool bar (@pxref{Tool Bar}) or tab bar, @var{position} +has this form: @example (@var{frame} @var{part} (@var{X} . @var{Y}) @var{timestamp}) @@ -1603,19 +1609,20 @@ For clicks on the frame's internal border (@pxref{Frame Layout}), @table @asis @item @var{frame} -The frame whose internal border was clicked on. +The frame whose internal border or tool bar or tab bar was clicked on. @item @var{part} -The part of the internal border which was clicked on. This can be one +The part of the frame which was clicked on. This can be one of the following: @table @code -@item nil -The frame does not have an internal border. This usually happens on -text-mode frames. This can also happen on GUI frames with internal -border if the frame doesn't have its @code{drag-internal-border} -parameter (@pxref{Mouse Dragging Parameters}) set to a non-@code{nil} -value. +@cindex tool-bar mouse events +@item tool-bar +The frame has a tool bar, and the event was in the tool-bar area. + +@cindex tab-bar mouse events +@item tab-bar +The frame has a tab bar, and the event was in the tab-bar area. @item left-edge @itemx top-edge @@ -1629,6 +1636,13 @@ canonical character from the border's nearest corner. @itemx bottom-right-corner @itemx bottom-left-corner The click was on the corresponding corner of the internal border. + +@item nil +The frame does not have an internal border, and the event was not on +the tab bar or the tool bar. This usually happens on text-mode +frames. This can also happen on GUI frames with internal border if +the frame doesn't have its @code{drag-internal-border} parameter +(@pxref{Mouse Dragging Parameters}) set to a non-@code{nil} value. @end table @end table commit 2e595b3e8b887068e47e64116d5a910c1045a229 Author: Eli Zaretskii Date: Sat Sep 11 13:58:10 2021 +0300 Fix tab-bar scrolling for mice that report mouse-wheel events * src/keyboard.c (make_lispy_position): Call 'window_from_coordinates' with last 2 arguments non-zero, to have it report on tool-bar and tab-bar positions. Tweak the return value according to the expectations of 'make_lispy_event'. (make_lispy_event): No more need to inject "tab-bar" into a click event on the tab bar: it's already there. diff --git a/src/keyboard.c b/src/keyboard.c index ac8c6b0d95..9d435b7360 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5092,13 +5092,39 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, enum window_part part; Lisp_Object posn = Qnil; Lisp_Object extra_info = Qnil; + int mx = XFIXNUM (x), my = XFIXNUM (y); /* Coordinate pixel positions to return. */ int xret = 0, yret = 0; /* The window or frame under frame pixel coordinates (x,y) */ Lisp_Object window_or_frame = f - ? window_from_coordinates (f, XFIXNUM (x), XFIXNUM (y), &part, 0, 0) + ? window_from_coordinates (f, mx, my, &part, true, true) : Qnil; + /* Report mouse events on the tab bar and (on GUI frames) on the + tool bar. */ +#ifdef HAVE_WINDOW_SYSTEM + if ((WINDOWP (f->tab_bar_window) + && EQ (window_or_frame, f->tab_bar_window)) + || (WINDOWP (f->tool_bar_window) + && EQ (window_or_frame, f->tool_bar_window))) + { + posn = EQ (window_or_frame, f->tab_bar_window) ? Qtab_bar : Qtool_bar; + /* Kludge alert: for mouse events on the tab bar and tool bar, + keyboard.c wants the frame, not the special-purpose window + we use to display those, and it wants frame-relative + coordinates. FIXME! */ + window_or_frame = Qnil; + } +#endif + if (!FRAME_WINDOW_P (f) + && FRAME_TAB_BAR_LINES (f) > 0 + && my >= FRAME_MENU_BAR_LINES (f) + && my < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f)) + { + posn = Qtab_bar; + window_or_frame = Qnil; /* see above */ + } + if (WINDOWP (window_or_frame)) { /* It's a click in window WINDOW at frame coordinates (X,Y) */ @@ -5111,15 +5137,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, Lisp_Object object = Qnil; /* Pixel coordinates relative to the window corner. */ - int wx = XFIXNUM (x) - WINDOW_LEFT_EDGE_X (w); - int wy = XFIXNUM (y) - WINDOW_TOP_EDGE_Y (w); + int wx = mx - WINDOW_LEFT_EDGE_X (w); + int wy = my - WINDOW_TOP_EDGE_Y (w); /* For text area clicks, return X, Y relative to the corner of this text area. Note that dX, dY etc are set below, by buffer_posn_from_coords. */ if (part == ON_TEXT) { - xret = XFIXNUM (x) - window_box_left (w, TEXT_AREA); + xret = mx - window_box_left (w, TEXT_AREA); yret = wy - WINDOW_TAB_LINE_HEIGHT (w) - WINDOW_HEADER_LINE_HEIGHT (w); } /* For mode line and header line clicks, return X, Y relative to @@ -5243,7 +5269,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, : (part == ON_RIGHT_FRINGE || part == ON_RIGHT_MARGIN || (part == ON_VERTICAL_SCROLL_BAR && WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))) - ? (XFIXNUM (x) - window_box_left (w, TEXT_AREA)) + ? (mx - window_box_left (w, TEXT_AREA)) : 0; int y2 = wy; @@ -5295,17 +5321,17 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y, make_fixnum (row)), extra_info))); } - else if (f) { /* Return mouse pixel coordinates here. */ XSETFRAME (window_or_frame, f); - xret = XFIXNUM (x); - yret = XFIXNUM (y); + xret = mx; + yret = my; #ifdef HAVE_WINDOW_SYSTEM if (FRAME_WINDOW_P (f) && FRAME_LIVE_P (f) + && NILP (posn) && FRAME_INTERNAL_BORDER_WIDTH (f) > 0 && !NILP (get_frame_param (f, Qdrag_internal_border))) { @@ -5655,11 +5681,10 @@ make_lispy_event (struct input_event *event) position = make_lispy_position (f, event->x, event->y, event->timestamp); + /* For tab-bar clicks, add the propertized string with + button information as OBJECT member of POSITION. */ if (CONSP (event->arg) && EQ (XCAR (event->arg), Qtab_bar)) - { - XSETCAR (XCDR (position), Qtab_bar); - position = nconc2 (position, Fcons (XCDR (event->arg), Qnil)); - } + position = nconc2 (position, Fcons (XCDR (event->arg), Qnil)); } #ifndef USE_TOOLKIT_SCROLL_BARS else commit 140d722848fda03b193f05e716f00eca93b854a8 Author: Tassilo Horn Date: Sat Sep 11 11:59:06 2021 +0200 ; Add some TODOs for the bug-reference--instances variables diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index d0493b3285..e5d77a0a33 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -230,6 +230,9 @@ subexpression 10." (push (match-string i url) groups)) (funcall bug-url-fmt (nreverse groups)))))) +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-gitea-instances '("gitea.com" "codeberg.org") "List of Gitea forge instances. @@ -238,6 +241,9 @@ loaded, and performed an auto-setup, evaluate `(bug-reference--setup-from-vc-alist t)' for rebuilding the value of `bug-reference--setup-from-vc-alist'.") +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-gitlab-instances '("gitlab.com" "salsa.debian.org" "framagit.org") @@ -247,6 +253,9 @@ loaded, and performed an auto-setup, evaluate `(bug-reference--setup-from-vc-alist t)' for rebuilding the value of `bug-reference--setup-from-vc-alist'.") +;; TODO: Change to alist with (HOST PROTOCOL) entries because +;; self-hosted instances might be accessed with http rather than +;; https. (defvar bug-reference-sourcehut-instances '("sr.ht") "List of SourceHut forge instances. When the value is changed after bug-reference has already been commit ccc9bd774c31ef5a7ba69729afbc9f97e710dfb2 Author: Tassilo Horn Date: Thu Sep 9 22:31:47 2021 +0200 bug-reference-bug-regexp now defines a contract for the overlay region Formerly, bug-reference-fontify placed the overlay on the complete match of bug-reference-bug-regexp. That made it impossible to encode constraints like "must not match at BOL" in the regexp without messing up fontification. Therefore, now it establishes the contract that subexpression 1 defines the overlay region. Subexpression 2 must still match the part of the bug reference injected into bug-reference-url-format if that's a string. If its a function, the interpretation of subexpressions > 1 is up to the function. For backwards compatibility, bug-reference-fontify checks if the bounds of subexpression 2..10 are within the bounds of subexpession 1. If not, or subexpression 1 doesn't even exist/match, we fall back to placing the overlay from (match-beginning 0) to (match-end 0) but issue a warning. * lisp/progmodes/bug-reference.el (bug-reference-bug-regexp): Document contract that subexpression 1 defines the overlay region and adapt the default value accordingly. (bug-reference--nonconforming-regexps): New internal variable. (bug-reference--overlay-bounds): New function. (bug-reference-fontify): Place overlay on subexpression 1's bounds if bug-reference-bug-regexp conforms to the documented contract. (bug-reference--setup-from-vc-alist): Adapt regexps to new contract. * doc/emacs/maintaining.texi (Bug Reference): Adapt regexp used in example. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 5a436a30fb..8305918336 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -3108,7 +3108,7 @@ these local variables section would do. @smallexample ;; Local Variables: -;; bug-reference-bug-regexp: "\\([Bb]ug[#-]\\)\\([0-9]+\\)" +;; bug-reference-bug-regexp: "\\([Bb]ug[#-]\\([0-9]+\\)\\)" ;; bug-reference-url-format: "https://project.org/issues/%s" ;; End: @end smallexample @@ -3118,9 +3118,9 @@ The string captured by the second regexp group in template in the @code{bug-reference-url-format}. Note that @code{bug-reference-url-format} may also be a function in -order to cater for more complex scenarios, e.g., when the part before -the actual bug number has to be used to distinguish between issues and -merge requests where each of them has a different URL. +order to cater for more complex scenarios, e.g., when different parts +of the bug reference have to be used to distinguish between issues and +merge requests resulting in different URLs. @heading Automatic Setup diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 586d4eed6c..d0493b3285 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -72,24 +72,30 @@ so that it is considered safe, see `enable-local-variables'.") (get s 'bug-reference-url-format))))) (defcustom bug-reference-bug-regexp - "\\([Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)" + "\\(\\(?:[Bb]ug ?#?\\|[Pp]atch ?#\\|RFE ?#\\|PR [a-z+-]+/\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)" "Regular expression matching bug references. -The second subexpression should match the bug reference (usually -a number). - -The complete expression's matches will be highlighted unless -there is a 99th subexpression. In that case, only the matches of -that will be highlighted. For example, this can be used to -define that bug references at the beginning of a line must not be -matched by using a regexp like - - \"[^\\n]\\\\(?99:\\\\([Bb]ug ?\\\\)\\\\(#[0-9]+\\\\)\\\\)\" - -If there wasn't this explicitly numbered group 99, the -non-newline character before the actual bug reference would be -highlighted, too." +The first subexpression defines the region of the bug-reference +overlay, i.e., the region being fontified and made clickable in +order to browse the referenced bug in the corresponding project's +issue tracker. + +If `bug-reference-url-format' is set to a format string with +single %s placeholder, the second subexpression must match +the (part of the) bug reference which needs to be injected in +place of the %s in order to form the bug's ticket URL. + +If `bug-reference-url-format' is a function, the interpretation +of the subexpressions larger than 1 is up to the function. +However, it is checked that the bounds of all matching +subexpressions from 2 to 10 are within the bounds of the +subexpression 1 defining the overlay region. Larger +subexpressions may also be used by the function but may lay +outside the bounds of subexpressions 1 and then don't contribute +to the highlighted and clickable region." :type 'regexp - :version "24.3") ; previously defconst + ; 24.3: defconst -> defcustom + ; 28.1: contract about subexpression 1 defines the overlay region. + :version "28.1") ;;;###autoload (put 'bug-reference-bug-regexp 'safe-local-variable 'stringp) @@ -119,6 +125,48 @@ highlighted, too." (defvar bug-reference-prog-mode) +(defvar bug-reference--nonconforming-regexps nil + "Holds `bug-reference-bug-regexp' values which don't conform to +the documented contract in order to warn about their +non-conformance only once.") + +(defun bug-reference--overlay-bounds () + (let ((m-b1 (match-beginning 1)) + (m-e1 (match-end 1))) + (if (and m-b1 m-e1 + (catch 'within-bounds + (let ((i 2)) + (while (<= i 10) + (when (and (match-beginning i) + (or (< (match-beginning i) m-b1) + (> (match-end i) m-e1))) + (throw 'within-bounds nil)) + (cl-incf i)) + t))) + ;; All groups 2..10 are within bounds. + (cons m-b1 m-e1) + ;; The regexp doesn't fulfil the contract of + ;; bug-reference-bug-regexp, so fall back to the old behavior. + (unless (member bug-reference-bug-regexp + bug-reference--nonconforming-regexps) + (setq bug-reference--nonconforming-regexps + (cons bug-reference-bug-regexp + bug-reference--nonconforming-regexps)) + (display-warning + 'bug-reference + (format-message + "The value of `bug-reference-bug-regexp' + + %S + +in buffer %S doesn't conform to the contract specified by its +docstring. The subexpression 1 should define the region of the +bug-reference overlay and cover all other subexpressions up to +subexpression 10." + bug-reference-bug-regexp + (buffer-name)))) + (cons (match-beginning 0) (match-end 0))))) + (defun bug-reference-fontify (start end) "Apply bug reference overlays to the region between START and END." (save-excursion @@ -132,19 +180,14 @@ highlighted, too." (when (or (not bug-reference-prog-mode) ;; This tests for both comment and string syntax. (nth 8 (syntax-ppss))) - ;; We highlight the 99th subexpression if that exists, - ;; otherwise the complete match. See the docstring of - ;; `bug-reference-bug-regexp'. - (let* ((s (or (match-beginning 99) - (match-beginning 0))) - (e (or (match-end 99) - (match-end 0))) + (let* ((bounds (bug-reference--overlay-bounds)) (overlay (or (let ((ov (pop overlays))) (when ov - (move-overlay ov s e) + (move-overlay ov (car bounds) (cdr bounds)) ov)) - (let ((ov (make-overlay s e nil t nil))) + (let ((ov (make-overlay (car bounds) (cdr bounds) + nil t nil))) (overlay-put ov 'category 'bug-reference) ov)))) ;; Don't put a link if format is undefined. @@ -232,7 +275,7 @@ for the known free software forges from the variables ;; `bug-reference-url-format' and ;; `bug-reference-bug-regexp' aren't set already. ("git\\.\\(?:sv\\|savannah\\)\\.gnu\\.org:" - "\\<\\([Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\>" + "\\<\\(\\(?:[Bb]ug ?#?\\)\\([0-9]+\\(?:#[0-9]+\\)?\\)\\)\\>" ,(lambda (_) "https://debbugs.gnu.org/%s")) ;; ;; GitHub projects. @@ -243,17 +286,17 @@ for the known free software forges from the variables ;; user/project#17 links to possibly different projects ;; are also supported. ("[/@]github.com[/:]\\([.A-Za-z0-9_/-]+\\)\\.git" - "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((ns-project (nth 1 groups))) (lambda () (concat "https://github.com/" (or ;; Explicit user/proj#18 link. - (match-string 1) + (match-string 2) ns-project) "/issues/" - (match-string 2)))))) + (match-string 3)))))) ;; ;; Gitea instances. ;; @@ -261,7 +304,7 @@ for the known free software forges from the variables (,(concat "[/@]" (regexp-opt bug-reference-gitea-instances t) "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + "\\(\\([.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((host (nth 1 groups)) (ns-project (nth 2 groups))) @@ -269,10 +312,10 @@ for the known free software forges from the variables (concat "https://" host "/" (or ;; Explicit user/proj#18 link. - (match-string 1) + (match-string 2) ns-project) "/issues/" - (match-string 2)))))) + (match-string 3)))))) ;; ;; GitLab instances. ;; @@ -283,19 +326,19 @@ for the known free software forges from the variables (,(concat "[/@]" (regexp-opt bug-reference-gitlab-instances t) "[/:]\\([.A-Za-z0-9_/-]+\\)\\.git") - "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>" + "\\(\\([.A-Za-z0-9_/-]+\\)?\\([#!]\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((host (nth 1 groups)) (ns-project (nth 2 groups))) (lambda () (concat "https://" host "/" - (or (match-string 1) + (or (match-string 2) ns-project) "/-/" (if (string= (match-string 3) "#") "issues/" "merge_requests/") - (match-string 2)))))) + (match-string 4)))))) ;; ;; Sourcehut instances. ;; @@ -311,7 +354,7 @@ for the known free software forges from the variables (,(concat "[/@]\\(?:git\\|hg\\)." (regexp-opt bug-reference-sourcehut-instances t) "[/:]\\(~[.A-Za-z0-9_/-]+\\)") - "\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\>" + "\\(\\(~[.A-Za-z0-9_/-]+\\)?\\(?:#\\)\\([0-9]+\\)\\)\\>" ,(lambda (groups) (let ((host (nth 1 groups)) (ns-project (nth 2 groups))) @@ -319,10 +362,10 @@ for the known free software forges from the variables (concat "https://todo." host "/" (or ;; Explicit user/proj#18 link. - (match-string 1) + (match-string 2) ns-project) "/" - (match-string 2)))))))))) + (match-string 3)))))))))) (defvar bug-reference-setup-from-vc-alist nil "An alist for setting up `bug-reference-mode' based on VC URL. commit 252a769b11689d13796db6f76c2935374796b079 Author: Stephen Gildea Date: Fri Sep 10 20:21:34 2021 -0700 ; * doc/lispref/files.texi (Changing Files): Fix xref to file-modes. 'file-modes' is in node "Testing Accessibility", not "File Attributes". diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 4235c4900a..3b1f2d5cb8 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1824,7 +1824,7 @@ Interactively, @var{mode} is read from the minibuffer using @code{read-file-modes} (see below), which lets the user type in either an integer or a string representing the permissions symbolically. -@xref{File Attributes}, for the function @code{file-modes}, which +@xref{Testing Accessibility}, for the function @code{file-modes}, which returns the permissions of a file. @end deffn commit edc93a5ce6a377e9b4a1b355c494196ba0aea376 Author: Basil L. Contovounesios Date: Wed Sep 8 12:41:07 2021 +0200 ; Fix grammar in efaq.texi on Emacs vs XEmacs. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 0be35396b8..9c92b2d93d 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -1467,7 +1467,7 @@ derived from a prerelease version of Emacs 19. In this FAQ, we use the name ``Emacs'' only for the official version. XEmacs last released a new version on January 30, 2009, and it lacks -many important features that exists in Emacs. In the past, it was not +many important features that exist in Emacs. In the past, it was not uncommon for Emacs packages to include code for compatibility with XEmacs. Nowadays, although some packages still maintain such compatibility code, several of the more popular built-in and third