[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/etags-regen d680a23e57 1/6: Merge branch 'master' into scratch/e
|
From: |
Dmitry Gutov |
|
Subject: |
scratch/etags-regen d680a23e57 1/6: Merge branch 'master' into scratch/etags-regen |
|
Date: |
Mon, 11 Jul 2022 14:01:43 -0400 (EDT) |
branch: scratch/etags-regen
commit d680a23e5792ed75280d3e75f003f99761e00fee
Merge: c409977cc2 108dbed4c0
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>
Merge branch 'master' into scratch/etags-regen
---
admin/README | 13 +-
doc/emacs/maintaining.texi | 141 +++++------
doc/emacs/programs.texi | 29 ++-
doc/emacs/search.texi | 13 +
doc/lispref/commands.texi | 56 +++--
doc/misc/efaq.texi | 323 +++++++++---------------
doc/misc/gnus.texi | 13 +
doc/misc/tramp.texi | 5 +-
etc/NEWS | 219 +++++++++++------
lisp/calc/calc-graph.el | 14 +-
lisp/calendar/holidays.el | 2 +-
lisp/comint.el | 9 +
lisp/emacs-lisp/byte-opt.el | 333 ++++++++++++++++---------
lisp/emacs-lisp/bytecomp.el | 9 +
lisp/emacs-lisp/comp.el | 18 ++
lisp/gnus/gnus-art.el | 8 +
lisp/gnus/gnus-sum.el | 2 +
lisp/gnus/nndiary.el | 11 +-
lisp/help-fns.el | 72 ++++--
lisp/info.el | 9 +-
lisp/isearch.el | 67 ++++-
lisp/jit-lock.el | 7 +-
lisp/mouse.el | 7 +-
lisp/net/browse-url.el | 19 +-
lisp/net/tramp-adb.el | 4 +-
lisp/net/tramp-gvfs.el | 11 +-
lisp/net/tramp-sh.el | 7 +-
lisp/net/tramp-sudoedit.el | 1 +
lisp/net/tramp.el | 11 +-
lisp/paren.el | 32 ++-
lisp/progmodes/bug-reference.el | 371 ++++++++++++++++------------
lisp/progmodes/cperl-mode.el | 421 ++++++++++++++++++--------------
lisp/progmodes/etags.el | 57 ++++-
lisp/progmodes/project.el | 45 ++--
lisp/progmodes/python.el | 272 +++++++++++----------
lisp/progmodes/ruby-mode.el | 11 +-
lisp/progmodes/xref.el | 17 +-
lisp/simple.el | 3 +-
lisp/startup.el | 16 +-
lisp/tab-bar.el | 197 +++++++++------
lisp/term/xterm.el | 3 +
lisp/vc/vc-git.el | 35 +--
src/comp.c | 58 +++++
src/dispextern.h | 4 +-
src/keyboard.c | 54 +++-
src/menu.c | 9 +-
src/pdumper.c | 15 +-
src/term.c | 17 +-
src/termchar.h | 4 +-
src/w32inevt.c | 6 +-
src/w32term.c | 39 +--
src/xdisp.c | 104 ++++----
src/xterm.c | 29 ++-
test/lisp/emacs-lisp/bytecomp-tests.el | 59 +++++
test/lisp/net/browse-url-tests.el | 8 +-
test/lisp/net/tramp-tests.el | 67 +++--
test/lisp/progmodes/cperl-mode-tests.el | 10 +-
test/lisp/progmodes/elisp-mode-tests.el | 6 +
test/lisp/progmodes/ruby-mode-tests.el | 29 ++-
test/lisp/vc/vc-tests.el | 8 +
test/src/emacs-module-tests.el | 4 +-
61 files changed, 2113 insertions(+), 1330 deletions(-)
diff --git a/admin/README b/admin/README
index 312f09839e..b0336f91ff 100644
--- a/admin/README
+++ b/admin/README
@@ -61,8 +61,19 @@ Brief description of sub-directories:
charsets scripts for generating charset map files
in ../etc/charsets
+coccinelle patches to make coccinelle work with
+ the latest Emacs version. Since they
+ apply a few minor changes in Emacs internals
+ in multiple places, they are trivial for
+ copyright purposes.
+grammars wisent and bovine grammars, used to produce
+ files in lisp/cedet/.
+notes miscellaneous notes related to administrative
+ tasks.
+nt support files for administrative tasks related
+ to building MS-Windows distributions.
unidata scripts for generating character property files
- in ../lisp/international
+ in ../lisp/international/.
This file is part of GNU Emacs.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 5b33c9bd3e..4ec2b2d72a 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1747,10 +1747,12 @@ commands (@pxref{Xref Commands}). When invoked with a
prefix
argument, this command additionally prompts for the base directory
from which to start the search; this allows, for example, to limit the
search only to project files under a certain subdirectory of the
-project root.
+project root. The way this command displays the matches is affected
+by the value of @code{xref-auto-jump-to-first-xref} (@pxref{Identifier
+Search}).
@findex project-search
- @kbd{M-x project-search} is an interactive variant of
+ @kbd{M-x project-search} is a sequential variant of
@code{project-find-regexp}. It prompts for a regular expression to
search in the current project's files, but instead of finding all the
matches and displaying them, it stops when it finds a match and visits
@@ -2139,40 +2141,15 @@ Switch @code{xref} to use the @code{etags} backend.
@kindex M-.
@findex xref-find-definitions
@vindex xref-prompt-for-identifier
- @kbd{M-.}@: (@code{xref-find-definitions}) shows the definitions of
+ @kbd{M-.}@: (@code{xref-find-definitions}) shows the definition of
the identifier at point. With a prefix argument, or if there's no
identifier at point, it prompts for the identifier. (If you want it
to always prompt, customize @code{xref-prompt-for-identifier} to
@code{t}.)
-@vindex xref-auto-jump-to-first-definition
-If the specified identifier has only one definition, the command jumps
-to it. If the identifier has more than one possible definition (e.g.,
-in an object-oriented language, or if there's a function and a
-variable by the same name), the command shows the candidate
-definitions in the @file{*xref*} buffer, together with the files in
-which these definitions are found. Selecting one of these candidates
-by typing @kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer
-showing the corresponding definition. If the value of the variable
-@code{xref-auto-jump-to-first-definition} is @code{move}, the first
-candidate is automatically selected, and if it's @code{t} or
-@code{show}, the first candidate is automatically shown. The default
-value is @code{nil}, which just shows the candidates in the
-@file{*xref*} buffer, but doesn't select any of them.
-
-@vindex xref-auto-jump-to-first-xref
- If the value of the variable @code{xref-auto-jump-to-first-xref} is
-@code{t}, @emph{all} Xref commands automatically jump to the first
-result. If the value is @code{show}, the first result is shown, but
-the window showing the @file{*xref*} buffer is left selected. If the
-value is @code{move}, the first result is selected in the
-@file{*xref*} buffer, but is not shown. The default value is
-@code{nil}, which just shows the results in the @file{*xref*} buffer,
-but doesn't select any of them.
-
- When entering the identifier argument to @kbd{M-.}, the usual
-minibuffer completion commands can be used (@pxref{Completion}), with
-the known identifier names as completion candidates.
+ When entering the identifier argument to @kbd{M-.}, you can use the
+usual minibuffer completion commands (@pxref{Completion}), with the
+known identifier names being the completion candidates.
@kindex C-x 4 .
@findex xref-find-definitions-other-window
@@ -2190,23 +2167,40 @@ former is @w{@kbd{C-x 4 .}}
or around the place of a mouse event. This command is intended to be
bound to a mouse event, such as @kbd{C-M-mouse-1}, for example.
-@findex xref-find-apropos
@kindex C-M-.
- The command @kbd{C-M-.} (@code{xref-find-apropos}) finds the
-definitions of one or more identifiers that match a specified regular
-expression. It is just like @kbd{M-.} except that it does regexp
+@findex xref-find-apropos
+@vindex tags-apropos-additional-actions
+ The command @kbd{C-M-.}@: (@code{xref-find-apropos}) is like
+@code{apropos} for tags (@pxref{Apropos}). It displays a list of
+identifiers in the selected tags table whose names match the specified
+@var{regexp}. This is just like @kbd{M-.}, except that it does regexp
matching of identifiers instead of matching symbol names as fixed
-strings.
+strings. By default, the command pops up the @file{*xref*} buffer,
+like @kbd{M-.}, but you can display additional output by customizing
+the variable @code{tags-apropos-additional-actions}; see its
+documentation for details.
- When any of the above commands finds more than one definition, it
-presents the @file{*xref*} buffer showing the definition candidates.
-In that buffer, you have several specialized commands, described in
-@ref{Xref Commands}.
+@vindex xref-auto-jump-to-first-definition
+ If any of the above commands finds more than one matching
+definition, it by default pops up the @file{*xref*} buffer showing the
+matching candidates. (@kbd{C-M-.}@: @emph{always} pops up the
+@file{*xref*} buffer if it finds at least one match.) The candidates
+are normally shown in that buffer as the name of a file and the
+matching identifier(s) in that file. In that buffer, you can select
+any of the candidates for display, and you have several additional
+commands, described in @ref{Xref Commands}. However, if the value of
+the variable @code{xref-auto-jump-to-first-definition} is @code{move},
+the first of these candidates is automatically selected in the
+@file{*xref*} buffer, and if it's @code{t} or @code{show}, the first
+candidate is automatically shown in its own window; @code{t} also
+selects the window showing the first candidate. The default value is
+@code{nil}, which just shows the candidates in the @file{*xref*}
+buffer, but doesn't select any of them.
@kindex M-,
@findex xref-pop-marker-stack
@vindex xref-marker-ring-length
- To go back to places @emph{from where} you found the definition,
+ To go back to places @emph{from where} you've displayed the definition,
use @kbd{M-,} (@code{xref-pop-marker-stack}). It jumps back to the
point of the last invocation of @kbd{M-.}. Thus you can find and
examine the definition of something with @kbd{M-.} and then return to
@@ -2337,6 +2331,16 @@ identifier, showing the file name and the line where the
identifier is
referenced. The XREF mode commands are available in this buffer, see
@ref{Xref Commands}.
+@vindex xref-auto-jump-to-first-xref
+ If the value of the variable @code{xref-auto-jump-to-first-xref} is
+@code{t}, @code{xref-find-references} automatically jumps to the first
+result and selects the window where it is displayed. If the value is
+@code{show}, the first result is shown, but the window showing the
+@file{*xref*} buffer is left selected. If the value is @code{move},
+the first result is selected in the @file{*xref*} buffer, but is not
+shown. The default value is @code{nil}, which just shows the results
+in the @file{*xref*} buffer, but doesn't select any of them.
+
@findex xref-query-replace-in-results
@kbd{M-x xref-query-replace-in-results} reads a regexp to match identifier
names and a replacement string, just like ordinary @kbd{M-x
@@ -2407,13 +2411,14 @@ Searching}.
Perform completion on the text around point, possibly using the
selected tags table if one is loaded (@code{completion-at-point}).
-@item M-x xref-find-apropos @key{RET} @var{regexp} @key{RET}
-Display a list of all known identifiers matching @var{regexp}.
-
@item M-x list-tags @key{RET} @var{file} @key{RET}
Display a list of the identifiers defined in the program file
@var{file}.
+@item C-M-. @var{regexp} @key{RET}
+Display a list of all identifiers matching @var{regexp}
+(@code{xref-find-apropos}). @xref{Looking Up Identifiers}.
+
@item M-x tags-next-file
Visit files recorded in the selected tags table.
@end table
@@ -2435,26 +2440,6 @@ for the project to be available. @xref{Tags Tables}.
If used
interactively, the default tag is file name of the current buffer if
used interactively.
-@c Sadly, the new-and-improved Xref feature doesn't provide anything
-@c close to the described below features of the now-obsoleted
-@c tags-apropos. I'm leaving this here to encourage enhancements to
-@c xref.el.
-@ignore
-@findex tags-apropos
-@vindex tags-apropos-verbose
-@vindex tags-tag-face
-@vindex tags-apropos-additional-actions
- @kbd{M-x tags-apropos} is like @code{apropos} for tags
-(@pxref{Apropos}). It displays a list of tags in the selected tags
-table whose entries match @var{regexp}. If the variable
-@code{tags-apropos-verbose} is non-@code{nil}, it displays the names
-of the tags files together with the tag names. You can customize the
-appearance of the output by setting the variable @code{tags-tag-face}
-to a face. You can display additional output by customizing the
-variable @code{tags-apropos-additional-actions}; see its documentation
-for details.
-@end ignore
-
@findex tags-next-file
@kbd{M-x tags-next-file} visits files covered by the selected tags table.
The first time it is called, it visits the first file covered by the
@@ -3123,19 +3108,23 @@ 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
+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}.
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
@@ -3150,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/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 09216c278b..37a15b6d5f 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -809,41 +809,46 @@ displayed. The default is 102400.
@cindex Show Paren mode
@cindex highlighting matching parentheses
@findex show-paren-mode
- Show Paren mode, a global minor mode, provides a more powerful kind
+@findex show-paren-local-mode
+ Show Paren mode is a minor mode that provides a more powerful kind
of automatic matching. Whenever point is before an opening delimiter
or after a closing delimiter, the delimiter, its matching delimiter,
and optionally the text between them are highlighted. To toggle Show
-Paren mode, type @kbd{M-x show-paren-mode}. To customize it, type
-@kbd{M-x customize-group @key{RET} paren-showing}. The customizable
-options which control the operation of this mode include:
+Paren mode globally, type @kbd{M-x show-paren-mode}. To toggle it
+only in the current buffer, type @kbd{M-x show-paren-local-mode}. To
+customize it, type @w{@kbd{M-x customize-group @key{RET} paren-showing}}.
+The customizable options which control the operation of this mode
+include:
@itemize @bullet
@item
@vindex show-paren-highlight-openparen
@code{show-paren-highlight-openparen} controls whether to highlight
-an open paren when point stands just before it, and hence its position
+an open paren when point is just before it, and hence its position
is marked by the cursor anyway. The default is non-@code{nil} (yes).
@item
@vindex show-paren-style
@code{show-paren-style} controls whether just the two parens, or also
-the space between them get highlighted. The valid options here are
+the text between them get highlighted. The valid options here are
@code{parenthesis} (show the matching paren), @code{expression}
(highlight the entire expression enclosed by the parens), and
-@code{mixed} (highlight the matching paren if it is visible, the
-expression otherwise).
+@code{mixed} (highlight the matching paren if it is visible in the
+window, the expression otherwise).
@item
@vindex show-paren-when-point-inside-paren
@code{show-paren-when-point-inside-paren}, when non-@code{nil}, causes
-highlighting also when point is on the inside of a parenthesis.
+highlighting also when point is inside of the parentheses. The
+default is @code{nil}.
@item
@vindex show-paren-when-point-in-periphery
@code{show-paren-when-point-in-periphery}, when non-@code{nil}, causes
-highlighting also when point is in whitespace at the beginning or end
-of a line, and there is a paren at, respectively, the first or last,
-or the last, non-whitespace position on the line.
+highlighting also when point is in whitespace at the beginning of a
+line and there is a paren at the first or last non-whitespace position
+on the line, or when point is at the end of a line and there is a
+paren at the last non-whitespace position on the line.
@end itemize
@cindex Electric Pair mode
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index a1760ad66f..e4322e361f 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -593,6 +593,19 @@ or the selected window and frame. The command must not
itself attempt
an incremental search. This feature is disabled if
@code{isearch-allow-scroll} is @code{nil} (which it is by default).
+@vindex isearch-allow-motion
+@vindex isearch-motion-changes-direction
+ Likewise, if you change the variable @code{isearch-allow-motion}
+to a non-@code{nil} value, this enables the use of the keyboard motion
+commands @kbd{M-<}, @kbd{M->}, @kbd{C-v} and @kbd{M-v}, to move
+respectively to the first occurrence of the current search string in
+the buffer, the last one, the first one after the current window,
+and the last one before the current window. The search direction
+does not change when these motion commands are used, unless you change
+the variable @code{isearch-motion-changes-direction} to a non-@code{nil}
+value, in which case the search direction is forward after @kbd{M-<} and
+@kbd{C-v}, and backward after @kbd{M->} and @kbd{M-v}.
+
@item Motion Commands
@cindex motion commands, during incremental search
When @code{isearch-yank-on-move} is customized to @code{shift},
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
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index d66c12f9fc..d5d1eb5e65 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -7,10 +7,6 @@
@include emacsver.texi
-@c This file is maintained by Romain Francoise <rfrancoise@gnu.org>.
-@c Feel free to install changes without prior permission (but I'd
-@c appreciate a notice if you do).
-
@copying
Copyright @copyright{} 2001--2021 Free Software Foundation, Inc.@*
Copyright @copyright{} 1994, 1995, 1996, 1997, 1998, 1999, 2000
@@ -86,7 +82,7 @@ Emacs, the Emacs manual is often the best starting point.
* FAQ notation::
* General questions::
* Getting help::
-* Status of Emacs::
+* History of Emacs::
* Common requests::
* Bugs and problems::
* Compiling and installing Emacs::
@@ -215,11 +211,6 @@ completion, @kbd{?} for a list of possibilities, and
@kbd{M-p} and
@kbd{M-n} (or up-arrow and down-arrow) to see previous commands entered.
An Emacs @dfn{command} is an @dfn{interactive} Emacs function.
-@cindex @key{Do} key
-Your system administrator may have bound other key sequences to invoke
-@code{execute-extended-command}. A function key labeled @kbd{Do} is a
-good candidate for this, on keyboards that have such a key.
-
If you need to run non-interactive Emacs functions, see @ref{Evaluating
Emacs Lisp code}.
@@ -231,7 +222,7 @@ Emacs Lisp code}.
@cindex Info, finding topics in
When we refer you to some @var{topic} in the Emacs manual, you can
-read this manual node inside Emacs (assuming nothing is broken) by
+read this manual node inside Emacs by
typing @kbd{C-h i m emacs @key{RET} m @var{topic} @key{RET}}.
This invokes Info, the GNU hypertext documentation browser. If you don't
@@ -240,9 +231,8 @@ already know how to use Info, type @kbd{?} from within Info.
If we refer to @var{topic}:@var{subtopic}, type @kbd{C-h i m emacs
@key{RET} m @var{topic} @key{RET} m @var{subtopic} @key{RET}}.
-If these commands don't work as expected, your system administrator may
-not have installed the Info files, or may have installed them
-improperly. In this case you should complain.
+(If these commands don't work as expected, your system may be missing
+the Info files, or they may not be installed properly.)
If you are reading this FAQ in Info, you can simply press @key{RET} on a
reference to follow it.
@@ -304,6 +294,9 @@ Richard Matthew Stallman
@item GPL
GNU General Public License
+See @uref{https://gnu.org/licenses/, the GNU web site} for more
+information about the GPL.
+
@end table
The word ``free'' in the title of the Free Software Foundation refers to
@@ -322,7 +315,6 @@ This chapter contains general questions having to do with
Emacs, the
Free Software Foundation, and related organizations.
@menu
-* Real meaning of copyleft::
* Guidelines for mailing list postings::
* Mailing list archives::
* Reporting bugs::
@@ -330,67 +322,31 @@ Free Software Foundation, and related organizations.
* Contacting the FSF::
@end menu
-@node Real meaning of copyleft
-@section What is the real legal meaning of the GNU copyleft?
-@cindex Copyleft, real meaning of
-@cindex GPL, real meaning of
-@cindex General Public License, real meaning of
-@cindex Discussion of the GPL
-
-The real legal meaning of the GNU General Public License (copyleft) will
-only be known if and when a judge rules on its validity and scope.
-There has never been a copyright infringement case involving the GPL to
-set any precedents. Although legal actions have been brought against
-companies for violating the terms of the GPL, so far all have been
-settled out of court (in favor of the plaintiffs). Please take any
-discussion regarding this issue to
-@uref{https://lists.gnu.org/mailman/listinfo/gnu-misc-discuss, the
-gnu-misc-discuss mailing list}, which was created to hold the
-extensive flame wars on the subject.
-
-RMS writes:
-
-@quotation
-The legal meaning of the GNU copyleft is less important than the spirit,
-which is that Emacs is a free software project and that work pertaining
-to Emacs should also be free software. ``Free'' means that all users
-have the freedom to study, share, change and improve Emacs. To make
-sure everyone has this freedom, pass along source code when you
-distribute any version of Emacs or a related program, and give the
-recipients the same freedom that you enjoyed.
-@end quotation
-
@node Guidelines for mailing list postings
@section What are appropriate messages for the various Emacs mailing lists?
-@cindex Newsgroups, appropriate messages for
-@cindex GNU newsgroups, appropriate messages for
-@cindex GNU mailing lists, appropriate messages for
-@cindex Usenet groups, appropriate messages for
@cindex Mailing lists, appropriate messages for
@cindex Posting messages to mailing lists
-
@cindex GNU mailing lists
-The Emacs mailing lists are described at
+
+There are various Emacs mailing lists, described at
@uref{https://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah
page}.
-Messages advocating ``non-free'' software are considered unacceptable
-on any of the GNU mailing lists, except for
-@url{https://lists.gnu.org/mailman/listinfo/gnu-misc-discuss, the
-gnu-misc-discuss mailing list} which was created to hold the extensive
-flame-wars on the subject.
-
-``Non-free'' software includes any software for which the end user
-can't freely modify the source code and exchange enhancements. Be
-careful to remove any GNU mailing lists from @samp{Cc:} when posting a
-reply that recommends such software.
-
-@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
-bug-gnu-emacs list} is a place where bug reports appear, but we
-recommend using the commands @kbd{M-x report-emacs-bug} or @kbd{M-x
-submit-emacs-patch} if at all possible (@pxref{Reporting bugs}).
-
-Some GNU mailing lists are gatewayed to (Usenet) newsgroups.
+The main ones are: @code{help-gnu-emacs}, @code{bug-gnu-emacs},
+and @code{emacs-devel}.
+
+Messages advocating ``non-free'' software are considered unacceptable on
+any of the GNU mailing lists, except for
+@url{https://lists.gnu.org/mailman/listinfo/gnu-misc-discuss,
+the gnu-misc-discuss mailing list}.
+``Non-free'' software includes any software for which the end user can't
+freely modify the source code and exchange enhancements. Please
+remove GNU mailing lists from the recipients when
+posting a reply that recommends such software.
+
+@cindex newsgroups
+Some of the GNU mailing lists are gatewayed to newsgroups (although
+the connection is occasionally unreliable).
For example, sending an email to
@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
bug-gnu-emacs list} has the effect of posting on the newsgroup
@@ -412,6 +368,8 @@ years, although there may be some unintentional gaps in
coverage. The
archive can be browsed over the web at
@uref{https://lists.gnu.org/r/, the GNU mail archive}.
+@cindex Usenet archives for GNU groups
+@cindex Old Usenet postings for GNU groups
Some web-based Usenet search services also archive the @code{gnu.*}
newsgroups.
@@ -422,15 +380,8 @@ newsgroups.
@cindex How to submit a bug report
@cindex Reporting bugs
-The correct way to report Emacs bugs is to use the command
-@kbd{M-x report-emacs-bug}. It sets up a mail buffer with the
-essential information and the correct e-mail address,
-@email{bug-gnu-emacs@@gnu.org}.
-
-Be sure to read the ``Bugs'' section of the Emacs manual before reporting
-a bug! The manual describes in detail how to submit a useful bug
-report (@pxref{Bugs, , Reporting Bugs, emacs, The GNU Emacs Manual}).
-(@xref{Emacs manual}, if you don't know how to read the manual.)
+Please see the Emacs manual for information on how to report bugs.
+@xref{Checklist, , Checklist for Bug Reports, emacs, The GNU Emacs Manual}.
Sending bug reports to
@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, the
@@ -444,7 +395,7 @@ more messages about Emacs than the others.
If you have reported a bug and you don't hear about a possible fix,
then after a suitable delay (such as a week) it is okay to post on
-@code{help-gnu-emacs@@gnu.org} asking if anyone can help you.
+the help list asking if anyone can help you.
If you are unsure whether you have found a bug, consider the following
non-exhaustive list, courtesy of RMS:
@@ -863,12 +814,9 @@ Emacs news, a history of recent user-visible changes
@end table
-More GNU information, including back issues of the @cite{GNU's
-Bulletin}, are at
+More GNU and FSF information is available at
-@uref{https://www.gnu.org/bulletins/bulletins.html} and
-
-@uref{https://www.cs.pdx.edu/~trent/gnu/gnu.html}
+@uref{https://www.gnu.org} and @uref{http://www.fsf.org}
@node Help installing Emacs
@section Where can I get help in installing Emacs?
@@ -894,12 +842,9 @@ C-f} (@kbd{M-x view-emacs-FAQ}). The very latest version
is available
in the Emacs development repository (@pxref{Latest version of Emacs}).
@c ------------------------------------------------------------
-@node Status of Emacs
-@chapter Status of Emacs
-@cindex Status of Emacs
-
-This chapter gives you basic information about Emacs, including the
-status of its latest version.
+@node History of Emacs
+@chapter History of Emacs
+@cindex History of Emacs
@menu
* Origin of the term Emacs::
@@ -912,6 +857,7 @@ status of its latest version.
* New in Emacs 22::
* New in Emacs 21::
* New in Emacs 20::
+* What was XEmacs?::
@end menu
@node Origin of the term Emacs
@@ -950,7 +896,6 @@ conventions}).
@cindex Latest version of Emacs
@cindex Development, Emacs
@cindex Repository, Emacs
-@cindex Bazaar repository, Emacs
Emacs @value{EMACSVER} is the current version as of this writing. A version
number with two components (e.g., @samp{24.5}) indicates a released
@@ -1475,6 +1420,28 @@ several languages in the same document; the
``Customize'' facility for
modifying variables without having to use Lisp; and automatic conversion
of files from Macintosh, Microsoft, and Unix platforms.
+@node What was XEmacs?
+@section What was XEmacs?
+@cindex XEmacs
+
+XEmacs was a branch version of Emacs that is no longer actively
+developed. XEmacs last released a new version on January 30, 2009,
+and it lacks many important features that exist in Emacs. Since its
+development has stopped, we do not expect to see any new releases.
+
+In the past, it was not uncommon for Emacs packages to include code
+for compatibility with XEmacs. Nowadays, most built-in and third party
+packages have either stopped supporting XEmacs or were developed
+exclusively for Emacs.
+
+XEmacs was initially derived from a prerelease version of Emacs 19.
+If you want to talk about these two versions and distinguish them,
+please call them ``Emacs'' and ``XEmacs.'' To contrast ``XEmacs''
+with ``GNU Emacs'' would be misleading, since XEmacs too has its
+origin in the work of the GNU Project. Terms such as ``Emacsen'' and
+``(X)Emacs'' are not wrong, but they are not very clear, so it
+is better to write ``Emacs and XEmacs.''
+
@c ------------------------------------------------------------
@node Common requests
@chapter Common requests
@@ -1598,7 +1565,7 @@ capabilities.
The command @kbd{M-x list-colors-display} pops up a window which
exhibits all the colors Emacs knows about on the current display.
-Syntax highlighting is on by default since version 22.1.
+Syntax highlighting is on by default.
@cindex direct color in terminals
Emacs 26.1 and later support direct color mode in terminals. If Emacs
@@ -3380,6 +3347,7 @@ dired, @code{directory-listing-before-filename-regexp}.
@menu
* Installing Emacs::
+* Emacs for other operating systems::
* Problems building Emacs::
@end menu
@@ -3392,9 +3360,7 @@ dired, @code{directory-listing-before-filename-regexp}.
@cindex Source code, building Emacs from
This answer is meant for users of Unix and Unix-like systems. Users of
-other operating systems should see the series of questions beginning
-with @ref{Emacs for MS-DOS}, which describe where to get non-Unix source
-and binaries, and how to install Emacs on those systems.
+other operating systems should see @xref{Emacs for other operating systems}.
Most GNU/Linux distributions provide pre-built Emacs packages.
If Emacs is not installed already, you can install it by running (as
@@ -3413,20 +3379,20 @@ a list of sites that make them available. On
@url{https://ftp.gnu.org},
the main GNU distribution site, sources are available as
@c Don't include VER in the file name, because pretests are not there.
-@uref{https://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz}
+@uref{https://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.xz}
(Replace @samp{VERSION} with the relevant version number, e.g., @samp{28.1}.)
@item
Next uncompress and extract the source files. This requires
-the @code{gzip} and @code{tar} programs, which are standard utilities.
+the @code{xz} and @code{tar} programs, which are standard utilities.
If your system does not have them, these can also be downloaded from
@url{https://ftp.gnu.org}.
GNU @code{tar} can uncompress and extract in a single-step:
@example
-tar -zxvf emacs-VERSION.tar.gz
+tar -axvf emacs-VERSION.tar.xz
@end example
@item
@@ -3440,9 +3406,8 @@ cd emacs-VERSION
make # use Makefile to build components, then Emacs
@end example
-If the @code{make} completes successfully, the odds are fairly good that
-the build has gone well. (@xref{Problems building Emacs}, if you weren't
-successful.)
+If the @code{make} completes successfully, you can go on to install it.
+(@xref{Problems building Emacs}, if you weren't successful.)
@item
By default, Emacs is installed in @file{/usr/local}. To actually
@@ -3457,6 +3422,46 @@ and any Emacs Info files that might be in
@file{/usr/local/share/info/}.
@end itemize
+@node Emacs for other operating systems
+@section Where can I get Emacs for macOS, MS Windows, etc?
+
+@cindex Apple computers, Emacs for
+@cindex Macintosh, Emacs for
+@cindex macOS, Emacs for
+Beginning with version 22.1, Emacs supports macOS natively.
+See the file @file{nextstep/INSTALL} in the distribution.
+
+@cindex FAQ for Emacs on MS-Windows
+@cindex Emacs for MS-Windows
+@cindex Microsoft Windows, Emacs for
+There is a separate FAQ for Emacs on MS-Windows,
+@pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}.
+
+@cindex GNUstep, Emacs for
+Beginning with version 23.1, Emacs supports GNUstep natively.
+See the file @file{nextstep/INSTALL} in the distribution.
+
+@cindex MS-DOS, Emacs for
+@cindex DOS, Emacs for
+@cindex Compiling Emacs for DOS
+@cindex Emacs for MS-DOS
+To build Emacs from source for MS-DOS, see the instructions in the file
+@file{msdos/INSTALL} in the distribution. The DOS port builds and runs
+on plain DOS, and also on all versions of MS-Windows from version 3.X
+onwards, including Windows XP and Vista. Pre-built binaries may be
+available at
+@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
+
+For a list of other implementations of Emacs (and Emacs
+look-alikes), consult the list of ``Emacs implementations and literature,''
+available at
+
+@uref{http://www.finseth.com/emacs.html}
+
+Note that while many of these programs look similar to Emacs, they often
+lack certain features, such as the Emacs Lisp extension language.
+
+
@node Problems building Emacs
@section What should I do if I have trouble building Emacs?
@cindex Problems building Emacs
@@ -3480,26 +3485,20 @@ problem (@pxref{Reporting bugs}).
@cindex Finding Emacs and related packages
@menu
-* Finding Emacs on the Internet::
+* Downloading Emacs::
* Finding a package with particular functionality::
* Packages that do not come with Emacs::
* Spell-checkers::
* Current GNU distributions::
-* What was XEmacs?::
* Emacs for minimalists::
-* Emacs for MS-DOS::
-* Emacs for MS-Windows::
-* Emacs for GNUstep::
-* Emacs for macOS::
@end menu
-@node Finding Emacs on the Internet
-@section Where can I get Emacs on the net?
-@cindex Finding Emacs on the Internet
+@node Downloading Emacs
+@section Downloading Emacs
@cindex Downloading Emacs
Information on downloading Emacs is available at
-@uref{https://www.gnu.org/software/emacs/, the Emacs home-page}.
+@uref{https://www.gnu.org/software/emacs/, the Emacs website}.
@xref{Installing Emacs}, for information on how to obtain and build the latest
version of Emacs, and see @ref{Current GNU distributions}, for a list of
@@ -3511,25 +3510,22 @@ archive sites that make GNU software available.
@cindex Finding an Emacs Lisp package
@cindex Functionality, finding a particular package
-First of all, you should check to make sure that the package isn't
-already available. For example, typing @kbd{M-x apropos @key{RET}
-python @key{RET}} lists all functions and variables containing the
-string @samp{python}.
-
-It is also possible that the package is on your system, but has not been
-loaded. To see which packages are available for loading, look through
-your computer's lisp directory (@pxref{File-name conventions}). The Lisp
-source to most packages contains a short description of how they
-should be loaded, invoked, and configured---so before you use or
-modify a Lisp package, see if the author has provided any hints in the
-source code.
-
The command @kbd{C-h p} (@code{finder-by-keyword}) allows you to browse
-the constituent Emacs packages.
+the packages that come with Emacs.
For advice on how to find extra packages that are not part of Emacs,
see @ref{Packages that do not come with Emacs}.
+Other techniques that might be useful:
+
+Typing @kbd{M-x apropos @key{RET} python @key{RET}} lists all
+functions and variables containing the string @samp{python}.
+
+You can look through your computer's lisp directory (@pxref{File-name
+conventions}). The Lisp source to most packages contains a short
+description of what they do and how they should be used.
+
+
@c Note that M-x view-external-packages references this node.
@node Packages that do not come with Emacs
@section Where can I get Emacs Lisp packages that don't come with Emacs?
@@ -3619,28 +3615,6 @@ A list of sites mirroring @samp{ftp.gnu.org} can be
found at
@uref{https://www.gnu.org/prep/ftp}
-@node What was XEmacs?
-@section What was XEmacs?
-@cindex XEmacs
-
-XEmacs was a branch version of Emacs that is no longer actively
-developed. XEmacs last released a new version on January 30, 2009,
-and it lacks many important features that exist in Emacs. Since its
-development has stopped, we do not expect to see any new releases.
-
-In the past, it was not uncommon for Emacs packages to include code
-for compatibility with XEmacs. Nowadays, most built-in and third party
-packages have either stopped supporting XEmacs or were developed
-exclusively for Emacs.
-
-XEmacs was initially derived from a prerelease version of Emacs 19.
-If you want to talk about these two versions and distinguish them,
-please call them ``Emacs'' and ``XEmacs.'' To contrast ``XEmacs''
-with ``GNU Emacs'' would be misleading, since XEmacs too has its
-origin in the work of the GNU Project. Terms such as ``Emacsen'' and
-``(X)Emacs'' are not wrong, but they are not very clear, so it
-is better to write ``Emacs and XEmacs.''
-
@node Emacs for minimalists
@section I don't have enough disk space to install Emacs
@cindex Zile
@@ -3654,63 +3628,6 @@ information is available from
@uref{https://www.gnu.org/software/zile/}
-
-@node Emacs for MS-DOS
-@section Where can I get Emacs for MS-DOS?
-@cindex MS-DOS, Emacs for
-@cindex DOS, Emacs for
-@cindex Compiling Emacs for DOS
-@cindex Emacs for MS-DOS
-
-To build Emacs from source for MS-DOS, see the instructions in the file
-@file{msdos/INSTALL} in the distribution. The DOS port builds and runs
-on plain DOS, and also on all versions of MS-Windows from version 3.X
-onwards, including Windows XP and Vista.
-
-The file @file{etc/PROBLEMS} contains some additional information
-regarding Emacs under MS-DOS.
-
-A pre-built binary distribution of the old Emacs 24 is available, as
-described at
-
-@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
-
-For a list of other MS-DOS implementations of Emacs (and Emacs
-look-alikes), consult the list of ``Emacs implementations and literature,''
-available at
-
-@uref{https://www.finseth.com/emacs.html}
-
-Note that while many of these programs look similar to Emacs, they often
-lack certain features, such as the Emacs Lisp extension language.
-
-@node Emacs for MS-Windows
-@section Where can I get Emacs for Microsoft Windows?
-@cindex FAQ for Emacs on MS-Windows
-@cindex Emacs for MS-Windows
-@cindex Microsoft Windows, Emacs for
-
-There is a separate FAQ for Emacs on MS-Windows,
-@pxref{Top,,,efaq-w32,FAQ for Emacs on MS Windows}.
-For MS-DOS, @pxref{Emacs for MS-DOS}.
-
-
-@node Emacs for GNUstep
-@section Where can I get Emacs for GNUstep?
-@cindex GNUstep, Emacs for
-
-Emacs supports GNUstep natively. See the file @file{nextstep/INSTALL}
-in the distribution.
-
-@node Emacs for macOS
-@section Where can I get Emacs for macOS?
-@cindex Apple computers, Emacs for
-@cindex Macintosh, Emacs for
-@cindex macOS, Emacs for
-
-Emacs supports macOS natively. See the file @file{nextstep/INSTALL}
-in the distribution.
-
@c ------------------------------------------------------------
@node Key bindings
@chapter Key bindings
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 5f3fba00df..4559ae8e31 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -9374,6 +9374,12 @@ Use html2text---a simple @acronym{HTML} converter
included with Gnus.
@end table
+@item W D F
+@kindex W D F @r{(Summary)}
+@findex gnus-article-toggle-fonts
+Toggle proportional fonts for @acronym{HTML} articles. This temporarily
+changes the @code{shr-use-fonts} variable in the current article buffer.
+
@item W b
@kindex W b @r{(Summary)}
@findex gnus-article-add-buttons
@@ -22721,6 +22727,13 @@ output lines in the various buffers. There's quite a
lot of them.
Fortunately, they all use the same syntax, so there's not that much to
be annoyed by.
+Gnus does not use the font locking machinery used by most modes in
+Emacs, so switching @code{font-lock-mode} on in the Gnus
+group/summary/article buffers usually doesn't do anything
+useful---instead it'll just mess up the faces that Gnus has already
+put in the buffer. (This is also the case for other minor modes that
+use the font locking machinery, like @code{whitespace-mode}.)
+
Here's an example format spec (from the group buffer): @samp{%M%S%5y:
%(%g%)\n}. We see that it is indeed extremely ugly, and that there are
lots of percentages everywhere.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index b2dcddc793..7109ca67dc 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3231,7 +3231,10 @@ directory @file{/sbin} on your local host.
Type @kbd{s h @value{postfixhop}} for the minibuffer completion to
@samp{@value{prefix}ssh@value{postfixhop}}. Typing @kbd{@key{TAB}}
shows host names @value{tramp} extracts from @file{~/.ssh/config}
-file, for example.
+@c bug#50387
+file, for example@footnote{Some completion styles, like
+@code{substring} or @code{flex}, require to type at least one
+character after the trailing @samp{@value{postfixhop}}.}.
@example
@group
diff --git a/etc/NEWS b/etc/NEWS
index f033176e9f..50cf0748b1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -178,7 +178,8 @@ When this mode is enabled, clicking 'down-mouse-3' anywhere
in the buffer
pops up a menu whose contents depends on surrounding context near the
mouse click. You can change the order of the default sub-menus in the
context menu by customizing the user option 'context-menu-functions'.
-You can also invoke the context menu by pressing 'S-<F10>'.
+You can also invoke the context menu by pressing 'S-<F10>' or,
+on macOS, by clicking 'C-down-mouse-1'.
+++
** A new keymap for buffer actions has been added.
@@ -410,10 +411,17 @@ command 'other-tab-prefix'.
+++
*** New command 'C-x t C-r' to open file read-only in the other tab.
+*** The tab bar now supports more mouse commands.
+Clicking 'mouse-2' closes the tab, 'mouse-3' displays the context menu
+with items that operate on the clicked tab. Dragging the tab with
+'mouse-1' moves it to another position on the tab bar. Mouse wheel
+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.
-Show/hide the tab bar independently for each frame, according to the
-value of 'tab-bar-show'.
+You can show/hide the tab bar independently for each frame, according
+to the value of 'tab-bar-show'.
---
*** New command 'toggle-frame-tab-bar'.
@@ -430,8 +438,14 @@ When 'tab-bar-format-tabs' is replaced with
'tab-bar-format-tabs-groups',
the tab bar displays tab groups.
---
-*** 'Mod-9' bound to 'tab-last' now switches to the last tab.
-It also supports a negative argument.
+*** New optional key binding for 'tab-last'.
+If you customize the variable 'tab-bar-select-tab-modifiers' for
+selecting tabs using its index numbers, the '<MODIFIER>-9' key is
+bound to 'tab-last', and switches to the last tab. Here <MODIFIER> is
+any of the modifiers in the list that is the value of
+'tab-bar-select-tab-modifiers'. You can also use negative indices,
+which count from the last tab: -1 is the last tab, -2 the one before
+that, etc.
---
*** New command 'tab-duplicate' bound to 'C-x t n'.
@@ -513,6 +527,12 @@ built without SVG support, the old icons will be used
instead.
** Help
+---
+*** The order things are displayed in the *Help* buffer has been changed.
+The indented "administrative" block (containing the "probably
+introduced" and "other relevant functions" (and similar things) has
+been moved to after the doc string.
+
+++
*** New command 'describe-command' shows help for a command.
This can be used instead of 'describe-function' for interactive
@@ -963,6 +983,10 @@ achieve that.
It used to be enabled when Emacs is started in GUI mode but not when started
in text mode. The cursor still only actually blinks in GUI frames.
+** New minor mode 'show-paren-local-mode'.
+It serves as a local counterpart for 'show-paren-mode', allowing you
+to toggle it separately in different buffers.
+
* Changes in Specialized Modes and Packages in Emacs 28.1
@@ -1011,6 +1035,12 @@ search string is at least this long.
'lazy-highlight-initial-delay'
still applies for shorter search strings, which avoids flicker in the
search buffer due to too many matches being highlighted.
+---
+*** The default 'search-whitespace-regexp' value has changed.
+This used to be "\\s-+", which meant that it was mode-dependent whether
+newlines were included in the whitespace set. This has now been
+changed to only match spaces and tab characters.
+
** Dired
+++
@@ -1106,6 +1136,18 @@ keys, add the following to your init file:
Using it instead of 'read-char-choice' allows using 'C-x o'
to switch to the help window displayed after typing 'C-h'.
++++
+** New user option 'isearch-allow-motion'.
+When 'isearch-allow-motion' is set, the commands 'beginning-of-buffer',
+'end-of-buffer', 'scroll-up-command' and 'scroll-down-command', when
+invoked during I-search, move respectively to the first occurrence of
+the current search string in the buffer, the last one, the first one
+after the current window, and the last one before the current window.
+Additionally, users can change the meaning of other motion commands
+during I-search by using their 'isearch-motion' property. The
+option 'isearch-motion-changes-direction' controls whether the
+direction of the search changes after a motion command.
+
** Outline
+++
@@ -1463,6 +1505,8 @@ passed to the browser.
This support has been obsolete since 25.1.
** Completion List Mode
+
+*** Improved navigation in the "*Completions*" buffer.
New key bindings have been added to 'completion-list-mode': 'n' and
'p' now navigate completions, and 'M-g M-c' switches to the
minibuffer and back to the completion list buffer.
@@ -1534,11 +1578,6 @@ will now choose the completion under point instead.
Also when this option
is nil, completions are not shown when the minibuffer reads a file name
with initial input as the default directory.
-** mspool.el
-
----
-*** Autoload the main entry point 'mspool-show'.
-
** Windmove
+++
@@ -1574,10 +1613,6 @@ This is a fully compatible change to the internal
occur-mode
implementation, and code creating their own occur-mode buffers will
work as before.
-** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
-The mode provides refined highlighting of built-in functions, types,
-and variables.
-
** Emacs Lisp mode
*** The mode-line now indicates whether we're using lexical or dynamic scoping.
@@ -1587,6 +1622,17 @@ The presence of a space between an open paren and a
symbol now is
taken as a statement by the programmer that this should be indented
as a data list rather than as a piece of code.
+** Lisp Mode
+
+*** New minor mode 'cl-font-lock-built-in-mode' for 'lisp-mode'.
+The mode provides refined highlighting of built-in functions, types,
+and variables.
+
+---
+*** Lisp mode now uses 'common-lisp-indent-function'.
+To revert to the previous behavior,
+'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
+
** Change Logs and VC
+++
@@ -1856,11 +1902,6 @@ messages, and will then be used when sending with
A server entry retrieved by auth-source can request a desired smtp
authentication mechanism by setting a value for the key 'smtp-auth'.
----
-** Lisp mode now uses 'common-lisp-indent-function'.
-To revert to the previous behavior,
-'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
-
** ElDoc
+++
@@ -1918,7 +1959,7 @@ security key, like yubikey, solokey, or nitrokey.
+++
*** Trashed remote files are moved to the local trash directory.
-All remote files, which are trashed, are moved to the local trash
+All remote files that are trashed are moved to the local trash
directory, except remote encrypted files, which are always deleted.
+++
@@ -1954,12 +1995,8 @@ Writing auto-save, backup or lock files to the local
temporary
directory must be confirmed. In order to suppress this confirmation,
set user option 'tramp-allow-unsafe-temporary-files' to t.
-** Tempo
-
----
-*** 'tempo-define-template' can now re-assign templates to tags.
-Previously, assigning a new template to an already defined tag had no
-effect.
++++
+*** 'make-directory' of a remote directory honors the default file modes.
** gdb-mi
@@ -2116,30 +2153,6 @@ To enable, add it to appropriate entries in
'c-offsets-alist', e.g.:
c-lineup-arglist))
(c-set-offset 'statement-cont '(c-lineup-ternary-bodies +))
-** SHR
-
----
-*** The command 'shr-browse-url' now supports custom mailto handlers.
-Clicking on or otherwise following a 'mailto:' link in a HTML buffer
-rendered by SHR previously invoked the command 'browse-url-mailto'.
-This is still the case by default, but if you customize
-'browse-url-mailto-function' or 'browse-url-handlers' to call some
-other function, it will now be called instead of the default.
-
-+++
-*** New user option 'shr-max-width'.
-If this user option is non-nil, and 'shr-width' is nil, then SHR will
-use the value of 'shr-max-width' to limit the width of the rendered
-HTML. The default is 120 characters, so even if you have very wide
-frames, HTML text will be rendered more narrowly, which usually leads
-to a more readable text. Set this user option to nil to get the
-previous behavior of rendering as wide as the 'window-width' allows.
-If 'shr-width' is non-nil, it overrides this variable.
-
----
-*** New faces for heading elements.
-Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
-
** Images
---
@@ -2258,12 +2271,36 @@ The function that is invoked when clicking on or
otherwise following a
'mailto:' link in an EWW buffer can now be customized. For more
information, see the related entry about 'shr-browse-url' above.
+** SHR
+
+---
+*** The command 'shr-browse-url' now supports custom mailto handlers.
+Clicking on or otherwise following a 'mailto:' link in a HTML buffer
+rendered by SHR previously invoked the command 'browse-url-mailto'.
+This is still the case by default, but if you customize
+'browse-url-mailto-function' or 'browse-url-handlers' to call some
+other function, it will now be called instead of the default.
+
++++
+*** New user option 'shr-max-width'.
+If this user option is non-nil, and 'shr-width' is nil, then SHR will
+use the value of 'shr-max-width' to limit the width of the rendered
+HTML. The default is 120 characters, so even if you have very wide
+frames, HTML text will be rendered more narrowly, which usually leads
+to a more readable text. Set this user option to nil to get the
+previous behavior of rendering as wide as the 'window-width' allows.
+If 'shr-width' is non-nil, it overrides this variable.
+
+---
+*** New faces for heading elements.
+Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'.
+
** Project
*** New user option 'project-vc-merge-submodules'.
*** Project commands now have their own history.
-Previously, used project directories are now suggested by all commands
+Previously used project directories are now suggested by all commands
that prompt for a project directory.
+++
@@ -2317,13 +2354,18 @@ before navigating to the selected location.
+++
*** New user options to automatically show the first Xref match.
The new user option 'xref-auto-jump-to-first-definition' controls the
-behavior of 'xref-find-definitions' and related commands: if it's t or
-'show', the first match is automatically displayed; if it's 'move',
-point in the "*xref*" buffer is automatically moved to the first match
-without displaying it.
-The new user option 'xref-auto-jump-to-first-xref' changes the behavior of
-all Xref commands in the same way as 'xref-auto-jump-to-first-definition'
-affects the "find-definitions" commands.
+behavior of 'xref-find-definitions' and its variants, like
+'xref-find-definitions-other-window': if it's t or 'show', the first
+match is automatically displayed; if it's 'move', point in the
+"*xref*" buffer is automatically moved to the first match without
+displaying it.
+The new user option 'xref-auto-jump-to-first-xref' changes the
+behavior of Xref commands such as 'xref-find-references',
+'xref-find-apropos', and 'project-find-regexp', which are expected to
+display many matches that the user would like to
+visit. 'xref-auto-jump-to-first-xref' changes their behavior much in
+the same way as 'xref-auto-jump-to-first-definition' affects the
+"find-definitions" commands.
*** New user options 'xref-search-program' and 'xref-search-program-alist'.
So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better
@@ -2365,6 +2407,11 @@ binding in 'xref--xref-buffer-mode-map'.
When non-nil, matches for identifiers in the file visited by the
current buffer will be shown first in the "*xref*" buffer.
+*** The etags Xref backend now honors 'tags-apropos-additional-actions'.
+You can customize it to augment the output of 'xref-find-apropos',
+like it affected the output of 'tags-apropos', which is obsolete since
+Emacs 25.1.
+
** Battery
---
@@ -2436,20 +2483,6 @@ This face is used for error messages from 'diff'.
*** New command 'diff-refresh-hunk'.
This new command (bound to 'C-c C-l') regenerates the current hunk.
-** Buttons
-
-+++
-*** New minor mode 'button-mode'.
-This minor mode does nothing else than install 'button-buffer-map' as
-a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
-to buttons), and can be used in any view-mode-like buffer that has
-buttons in it.
-
-+++
-*** New utility function 'button-buttonize'.
-This function takes a string and returns a string propertized in a way
-that makes it a valid button.
-
** thing-at-point
+++
@@ -2575,7 +2608,7 @@ sequences.
*** 'comint-delete-output' can now save deleted text in the kill-ring.
Interactively, 'C-u C-c C-o' triggers this new optional behavior.
-** erc
+** ERC
---
*** erc-services.el now supports NickServ passwords from auth-source.
@@ -2759,6 +2792,11 @@ The new commands 'doc-view-center-page-horizontally'
(bound to 'c h')
and 'doc-view-center-page-vertically' (bound to 'c v') center the page
horizontally and vertically, respectively.
+---
+*** 'tempo-define-template' can now re-assign templates to tags.
+Previously, assigning a new template to an already defined tag had no
+effect.
+
---
*** The width of the buffer-name column in 'list-buffers' is now dynamic.
The width now depends of the width of the window, but will never be
@@ -2776,10 +2814,26 @@ different timezone causing a difference in the date.
---
*** The old non-SMIE indentation of 'sh-mode' has been removed.
+---
+*** 'mspools-show' is now autoloaded.
+
*** Loading dunnet.el in batch mode doesn't start the game any more.
Instead you need to do "emacs -f dun-batch" to start the game in
batch mode.
+** Ruby Mode
+
+---
+** 'ruby-use-smie' is declared obsolete.
+SMIE is now always enabled and 'ruby-use-smie' only controls whether
+indentation is done using SMIE or with the old ad-hoc code.
+
+---
+** Indentation has changed when 'ruby-align-chained-calls' is non-nil.
+This previously used to align subsequent lines with the last sibling,
+but it now aligns with the first sibling (which is the preferred style
+in Ruby).
+
* New Modes and Packages in Emacs 28.1
@@ -3103,11 +3157,6 @@ back in Emacs 23.1. The affected functions are:
'make-obsolete',
'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal'
and 'play-sound-file'.
----
-** 'ruby-use-smie' is declared obsolete.
-SMIE is now always enabled and 'ruby-use-smie' only controls whether
-indentation is done using SMIE or with the old ad-hoc code.
-
---
** 'sql-*-statement-starters' are no longer user options.
These variables describe facts about the SQL standard and
@@ -3953,6 +4002,20 @@ They carry now the destination and the error-name of an
event. They
also keep the type information of their arguments. Use the
'dbus-event-*' accessor functions.
+** Buttons
+
++++
+*** New minor mode 'button-mode'.
+This minor mode does nothing else than install 'button-buffer-map' as
+a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate
+to buttons), and can be used in any view-mode-like buffer that has
+buttons in it.
+
++++
+*** New utility function 'button-buttonize'.
+This function takes a string and returns a string propertized in a way
+that makes it a valid button.
+
---
** 'text-scale-mode' can now adjust font size of the header line.
When the new buffer local variable 'text-scale-remap-header-line'
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)
diff --git a/lisp/comint.el b/lisp/comint.el
index e058e6b8cf..02878cc641 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -479,6 +479,15 @@ executed once, when the buffer is created."
:group 'comint
:version "26.1")
+(defconst comint-max-line-length
+ (pcase system-type
+ ('gnu/linux 4096)
+ ('windows-nt 8196)
+ (_ 1024))
+ "Maximum line length, in bytes, accepted by the inferior process.
+This setting is only meaningful when communicating with subprocesses
+via PTYs.")
+
(defvar comint-mode-map
(let ((map (make-sparse-keymap)))
;; Keys:
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 6475f69ede..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
@@ -327,6 +320,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
@@ -425,19 +425,19 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(`(,(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 <x>) --> <x>.
(if (cdr exps)
@@ -463,22 +463,15 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; 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
@@ -487,19 +480,11 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; 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)
@@ -508,13 +493,11 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; 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))
@@ -526,19 +509,18 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
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
@@ -547,8 +529,7 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
;; 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
@@ -558,16 +539,8 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
. ,(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))))
-
- (`(ignore . ,exps)
- ;; Don't treat the args to `ignore' as being
- ;; computed for effect. We want to avoid the warnings
- ;; that might occur if they were treated that way.
- ;; However, don't actually bother calling `ignore'.
- `(progn ,@(mapcar #'byte-optimize-form exps) nil))
+ `(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 . ,_)
@@ -602,7 +575,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))
@@ -673,34 +654,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]])
@@ -734,8 +823,12 @@ Same format as `byte-optimize--lexvars', with shared
structure and contents.")
(while rest
(setq fe (or all-for-effect (cdr rest)))
(setq new (and (car rest) (byte-optimize-form (car rest) fe)))
- (if (or new (not fe))
- (setq result (cons new result)))
+ (when (and (consp new) (eq (car new) 'progn))
+ ;; Flatten `progn' form into the body.
+ (setq result (append (reverse (cdr new)) result))
+ (setq new (pop result)))
+ (when (or new (not fe))
+ (setq result (cons new result)))
(setq rest (cdr rest)))
(nreverse result)))
@@ -967,24 +1060,25 @@ See Info node `(elisp) Integer Basics'."
(_ (byte-optimize-binary-predicate form))))
(defun byte-optimize-member (form)
- ;; Replace `member' or `memql' with `memq' if the first arg is a symbol,
- ;; or the second arg is a list of symbols. Same with fixnums.
- (if (= (length (cdr form)) 2)
- (if (or (byte-optimize--constant-symbol-p (nth 1 form))
- (byte-optimize--fixnump (nth 1 form))
- (let ((arg2 (nth 2 form)))
- (and (macroexp-const-p arg2)
- (let ((listval (eval arg2)))
- (and (listp listval)
- (not (memq nil (mapcar
- (lambda (o)
- (or (symbolp o)
- (byte-optimize--fixnump o)))
- listval))))))))
- (cons 'memq (cdr form))
- form)
- ;; Arity errors reported elsewhere.
- form))
+ (cond
+ ((/= (length (cdr form)) 2) form) ; arity error
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; Replace `member' or `memql' with `memq' if the first arg is a symbol
+ ;; or fixnum, or the second arg is a list of symbols or fixnums.
+ ((or (byte-optimize--constant-symbol-p (nth 1 form))
+ (byte-optimize--fixnump (nth 1 form))
+ (let ((arg2 (nth 2 form)))
+ (and (macroexp-const-p arg2)
+ (let ((listval (eval arg2)))
+ (and (listp listval)
+ (not (memq nil (mapcar
+ (lambda (o)
+ (or (symbolp o)
+ (byte-optimize--fixnump o)))
+ listval))))))))
+ (cons 'memq (cdr form)))
+ (t form)))
(defun byte-optimize-assoc (form)
;; Replace 2-argument `assoc' with `assq', `rassoc' with `rassq',
@@ -992,22 +1086,35 @@ See Info node `(elisp) Integer Basics'."
(cond
((/= (length form) 3)
form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
((or (byte-optimize--constant-symbol-p (nth 1 form))
(byte-optimize--fixnump (nth 1 form)))
(cons (if (eq (car form) 'assoc) 'assq 'rassq)
(cdr form)))
(t (byte-optimize-constant-args form))))
+(defun byte-optimize-assq (form)
+ (cond
+ ((/= (length form) 3)
+ form)
+ ((null (nth 2 form)) ; empty list
+ `(progn ,(nth 1 form) nil))
+ (t (byte-optimize-constant-args form))))
+
(defun byte-optimize-memq (form)
- ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
(if (= (length (cdr form)) 2)
(let ((list (nth 2 form)))
- (if (and (eq (car-safe list) 'quote)
- (listp (setq list (cadr list)))
- (= (length list) 1))
- `(and (eq ,(nth 1 form) ',(nth 0 list))
- ',list)
- form))
+ (cond
+ ((null list) ; empty list
+ `(progn ,(nth 1 form) nil))
+ ;; (memq foo '(bar)) => (and (eq foo 'bar) '(bar))
+ ((and (eq (car-safe list) 'quote)
+ (listp (setq list (cadr list)))
+ (= (length list) 1))
+ `(and (eq ,(nth 1 form) ',(nth 0 list))
+ ',list))
+ (t form)))
;; Arity errors reported elsewhere.
form))
@@ -1044,6 +1151,8 @@ See Info node `(elisp) Integer Basics'."
(put 'member 'byte-optimizer #'byte-optimize-member)
(put 'assoc 'byte-optimizer #'byte-optimize-assoc)
(put 'rassoc 'byte-optimizer #'byte-optimize-assoc)
+(put 'assq 'byte-optimizer #'byte-optimize-assq)
+(put 'rassq 'byte-optimizer #'byte-optimize-assq)
(put '+ 'byte-optimizer #'byte-optimize-plus)
(put '* 'byte-optimizer #'byte-optimize-multiply)
@@ -1403,7 +1512,9 @@ See Info node `(elisp) Integer Basics'."
fixnump floatp following-char framep
get-largest-window get-lru-window
hash-table-p
- identity ignore integerp integer-or-marker-p interactive-p
+ ;; `ignore' isn't here because we don't want calls to it elided;
+ ;; see `byte-compile-ignore'.
+ identity integerp integer-or-marker-p interactive-p
invocation-directory invocation-name
keymapp keywordp
list listp
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 145cdbaa6e..47b3c82456 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2257,6 +2257,9 @@ With argument ARG, insert value in current buffer after
the form."
(push `(native-comp-speed . ,native-comp-speed)
byte-native-qualities)
(defvar native-comp-debug)
(push `(native-comp-debug . ,native-comp-debug)
byte-native-qualities)
+ (defvar native-comp-compiler-options)
+ (push `(native-comp-compiler-options . ,native-comp-compiler-options)
+ byte-native-qualities)
(defvar native-comp-driver-options)
(push `(native-comp-driver-options . ,native-comp-driver-options)
byte-native-qualities)
@@ -4207,6 +4210,7 @@ discarding."
(byte-defop-compiler-1 funcall)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let* byte-compile-let)
+(byte-defop-compiler-1 ignore)
(defun byte-compile-progn (form)
(byte-compile-body-do-effect (cdr form)))
@@ -4222,6 +4226,11 @@ discarding."
(if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
,tag))
+(defun byte-compile-ignore (form)
+ (dolist (arg (cdr form))
+ (byte-compile-form arg t))
+ (byte-compile-form nil))
+
;; Return the list of items in CONDITION-PARAM that match PRED-LIST.
;; Only return items that are not in ONLY-IF-NOT-PRESENT.
(defun byte-compile-find-bound-condition (condition-param
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 80a1da5ad8..bb135457e2 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -166,6 +166,16 @@ if `confirm-kill-processes' is non-nil."
:type 'boolean
:version "28.1")
+(defcustom native-comp-compiler-options nil
+ "Command line options passed verbatim to GCC compiler.
+Note that not all options are meaningful and some options might even
+break your Emacs. Use at your own risk.
+
+Passing these options is only available in libgccjit version 9
+and above."
+ :type '(repeat string)
+ :version "28.1")
+
(defcustom native-comp-driver-options nil
"Options passed verbatim to the native compiler's back-end driver.
Note that not all options are meaningful; typically only the options
@@ -755,6 +765,8 @@ Returns ELT."
:documentation "Default speed for this compilation unit.")
(debug native-comp-debug :type number
:documentation "Default debug level for this compilation unit.")
+ (compiler-options native-comp-compiler-options :type list
+ :documentation "Options for the GCC compiler.")
(driver-options native-comp-driver-options :type list
:documentation "Options for the GCC driver.")
(top-level-forms () :type list
@@ -1347,6 +1359,8 @@ clashes."
byte-native-qualities)
(comp-ctxt-debug comp-ctxt) (alist-get 'native-comp-debug
byte-native-qualities)
+ (comp-ctxt-compiler-options comp-ctxt) (alist-get
'native-comp-compiler-options
+ byte-native-qualities)
(comp-ctxt-driver-options comp-ctxt) (alist-get
'native-comp-driver-options
byte-native-qualities)
(comp-ctxt-top-level-forms comp-ctxt)
@@ -3663,6 +3677,8 @@ Prepare every function for final compilation and drive
the C back-end."
comp-libgccjit-reproducer ,comp-libgccjit-reproducer
comp-ctxt ,comp-ctxt
native-comp-eln-load-path
',native-comp-eln-load-path
+ native-comp-compiler-options
+ ',native-comp-compiler-options
native-comp-driver-options
',native-comp-driver-options
load-path ',load-path)
@@ -3926,6 +3942,8 @@ display a message."
comp-libgccjit-reproducer
,comp-libgccjit-reproducer
comp-async-compilation t
native-comp-eln-load-path
',native-comp-eln-load-path
+ native-comp-compiler-options
+ ',native-comp-compiler-options
native-comp-driver-options
',native-comp-driver-options
load-path ',load-path
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 3c1403e155..c4fa1e960b 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -2243,6 +2243,14 @@ This only works if the article in question is HTML."
(funcall function (get-text-property start 'image-url)
start end)))))))
+(defun gnus-article-toggle-fonts ()
+ "Toggle the use of proportional fonts for HTML articles."
+ (interactive nil gnus-article-mode gnus-summary-mode)
+ (gnus-with-article-buffer
+ (when (eq mm-text-html-renderer 'shr)
+ (setq-local shr-use-fonts (not shr-use-fonts))
+ (gnus-summary-show-article))))
+
(defun gnus-article-treat-fold-newsgroups ()
"Fold the Newsgroups and Followup-To message headers."
(interactive nil gnus-article-mode gnus-summary-mode)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 856e95c0ba..c28e38e315 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -2252,6 +2252,7 @@ increase the score of each group you read."
"s" gnus-treat-smiley
"D" gnus-article-remove-images
"W" gnus-article-show-images
+ "F" gnus-article-toggle-fonts
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
"n" gnus-treat-newsgroups-picon
@@ -2561,6 +2562,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Unfold headers" gnus-article-treat-unfold-headers t]
["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
["Html" gnus-article-wash-html t]
+ ["Toggle HTML fonts" gnus-article-toggle-fonts t]
["Unsplit URLs" gnus-article-unsplit-urls t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
["Decode HZ" gnus-article-decode-HZ t]
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index adf4427523..133e0307a5 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -416,6 +416,11 @@ all. This may very well take some time.")
(deffoo nndiary-open-server (server &optional defs)
(nnoo-change-server 'nndiary server defs)
+ (dolist (header nndiary-headers)
+ (setq header (intern (format "X-Diary-%s" (car header))))
+ ;; Required for building NOV databases and some other stuff.
+ (add-to-list 'gnus-extra-headers header)
+ (add-to-list 'nnmail-extra-headers header))
(when (not (file-exists-p nndiary-directory))
(ignore-errors (make-directory nndiary-directory t)))
(cond
@@ -1557,12 +1562,6 @@ all. This may very well take some time.")
;; The end... ===============================================================
-(dolist (header nndiary-headers)
- (setq header (intern (format "X-Diary-%s" (car header))))
- ;; Required for building NOV databases and some other stuff.
- (add-to-list 'gnus-extra-headers header)
- (add-to-list 'nnmail-extra-headers header))
-
(unless (assoc "nndiary" gnus-valid-select-methods)
(gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 2c7956d968..a7219ede94 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -64,6 +64,12 @@ described in `help-fns-describe-variable-functions', except
that
the functions are called with two parameters: The face and the
frame.")
+(defvar help-fns--activated-functions nil
+ "Internal variable let-bound to help functions that have triggered.
+Help functions can check the contents of this list to see whether
+a specific previous help function has inserted something in the
+current help buffer.")
+
;; Functions
(defvar help-definition-prefixes nil
@@ -723,8 +729,12 @@ FILE is the file where FUNCTION was probably defined."
(add-hook 'help-fns-describe-variable-functions
#'help-fns--mention-first-release)
(defun help-fns--mention-first-release (object)
- (let ((first (if (symbolp object) (help-fns--first-release object))))
- (when first
+ ;; Don't output anything if we've already output the :version from
+ ;; the `defcustom'.
+ (unless (memq 'help-fns--customize-variable-version
+ help-fns--activated-functions)
+ (when-let ((first (and (symbolp object)
+ (help-fns--first-release object))))
(with-current-buffer standard-output
(insert (format " Probably introduced at or before Emacs version
%s.\n"
first))))))
@@ -950,9 +960,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
;; E.g. an alias for a not yet defined function.
((invalid-function void-function) doc-raw))))
(help-fns--ensure-empty-line)
- (run-hook-with-args 'help-fns-describe-function-functions function)
- (help-fns--ensure-empty-line)
- (insert (or doc "Not documented.")))
+ (insert (or doc "Not documented."))
+ (help-fns--run-describe-functions
+ help-fns-describe-function-functions function))
;; Avoid asking the user annoying questions if she decides
;; to save the help buffer, when her locale's codeset
;; isn't UTF-8.
@@ -1186,10 +1196,6 @@ it is displayed along with the global value."
;; of a symbol.
(set-syntax-table emacs-lisp-mode-syntax-table)
(goto-char val-start-pos)
- ;; The line below previously read as
- ;; (delete-region (point) (progn (end-of-line) (point)))
- ;; which suppressed display of the buffer local value for
- ;; large values.
(when (looking-at "value is") (replace-match ""))
(save-excursion
(insert "\n\nValue:")
@@ -1210,19 +1216,40 @@ it is displayed along with the global value."
(documentation-property
alias 'variable-documentation))))
+ (with-current-buffer standard-output
+ (insert (or doc "Not documented as a variable.")))
+
+ ;; Output the indented administrative bits.
(with-current-buffer buffer
- (run-hook-with-args 'help-fns-describe-variable-functions
- variable))
+ (help-fns--run-describe-functions
+ help-fns-describe-variable-functions variable))
(with-current-buffer standard-output
- (help-fns--ensure-empty-line))
- (with-current-buffer standard-output
- (insert (or doc "Not documented as a variable."))))
+ ;; If we have the long value of the variable at the
+ ;; end, remove superfluous empty lines before it.
+ (unless (eobp)
+ (while (looking-at-p "\n")
+ (delete-char 1)))))
(with-current-buffer standard-output
;; Return the text we displayed.
(buffer-string))))))))
+(defun help-fns--run-describe-functions (functions &rest args)
+ (with-current-buffer standard-output
+ (unless (bolp)
+ (insert "\n"))
+ (help-fns--ensure-empty-line))
+ (let ((help-fns--activated-functions nil))
+ (dolist (func functions)
+ (let ((size (buffer-size standard-output)))
+ (apply func args)
+ ;; This function inserted something, so register it.
+ (when (> (buffer-size standard-output) size)
+ (push func help-fns--activated-functions)))))
+ (with-current-buffer standard-output
+ (help-fns--ensure-empty-line)))
+
(add-hook 'help-fns-describe-variable-functions #'help-fns--customize-variable)
(defun help-fns--customize-variable (variable &optional text)
;; Make a link to customize if this variable can be customized.
@@ -1234,13 +1261,15 @@ it is displayed along with the global value."
(re-search-backward
(concat "\\(" customize-label "\\)") nil t)
(help-xref-button 1 'help-customize-variable variable)))
- (terpri))
+ (terpri))))
+
+(add-hook 'help-fns-describe-variable-functions
+ #'help-fns--customize-variable-version)
+(defun help-fns--customize-variable-version (variable)
+ (when (custom-variable-p variable)
;; Note variable's version or package version.
- (let ((output (describe-variable-custom-version-info variable)))
- (when output
- ;; (terpri)
- ;; (terpri)
- (princ output)))))
+ (when-let ((output (describe-variable-custom-version-info variable)))
+ (princ output))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local)
(defun help-fns--var-safe-local (variable)
@@ -1479,7 +1508,8 @@ If FRAME is omitted or nil, use the selected frame."
(terpri)
(terpri))))
(terpri)
- (run-hook-with-args 'help-fns-describe-face-functions f frame))))))
+ (help-fns--run-describe-functions
+ help-fns-describe-face-functions f frame))))))
(add-hook 'help-fns-describe-face-functions
#'help-fns--face-custom-version-info)
diff --git a/lisp/info.el b/lisp/info.el
index 5589321856..c09c75ad48 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1455,6 +1455,7 @@ is non-nil)."
(defvar Info-streamline-headings
'(("Emacs" . "Emacs")
("Software development\\|Programming" . "Software development")
+ ("Compression\\|Data Compression" . "Compression")
("Libraries" . "Libraries")
("Network applications\\|World Wide Web\\|Net Utilities"
. "Network applications"))
@@ -1735,10 +1736,12 @@ escaped (\\\",\\\\)."
(if (stringp Info-current-file)
(string-replace
"%" "%%"
- (file-name-sans-extension
- (file-name-nondirectory Info-current-file)))
+ ;; Remove trailing ".info" and ".info.gz", etc.
+ (replace-regexp-in-string
+ "\\..*\\'" ""
+ (file-name-nondirectory Info-current-file)))
(format "*%S*" Info-current-file))
- 'help-echo "Info file name")
+ 'help-echo "Manual name")
") ")
(if Info-current-node
(propertize (string-replace
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 1c776a06e1..efa7db6fe9 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -114,7 +114,7 @@ is called to let you enter the search string, and RET
terminates editing
and does a nonincremental search.)"
:type 'boolean)
-(defcustom search-whitespace-regexp (purecopy "\\s-+")
+(defcustom search-whitespace-regexp (purecopy "[ \t]+")
"If non-nil, regular expression to match a sequence of whitespace chars.
When you enter a space or spaces in the incremental search, it
will match any sequence matched by this regexp. As an exception,
@@ -134,7 +134,7 @@ add any capturing groups into this value; that can change
the
numbering of existing capture groups in unexpected ways."
:type '(choice (const :tag "Match Spaces Literally" nil)
regexp)
- :version "24.3")
+ :version "28.1")
(defcustom search-invisible 'open
"If t incremental search/query-replace can match hidden text.
@@ -2009,7 +2009,8 @@ type \\[isearch-repeat-forward] with a numeric argument."
;; don't forward char in isearch-repeat
(setq isearch-just-started t)
(goto-char (point-min))
- (isearch-repeat 'forward arg)))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'forward arg))))
(defun isearch-end-of-buffer (&optional arg)
"Go to the last occurrence of the current search string.
@@ -2023,7 +2024,8 @@ type \\[isearch-repeat-backward] with a numeric argument."
(isearch-beginning-of-buffer (abs arg))
(setq isearch-just-started t)
(goto-char (point-max))
- (isearch-repeat 'backward arg)))
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat 'backward arg))))
;;; Toggles for `isearch-regexp-function' and `search-default-mode'.
@@ -2925,12 +2927,49 @@ If non-nil, scrolling commands can be used in Isearch
mode.
However, you cannot scroll far enough that the current match is
no longer visible (is off screen). But if the value is `unlimited'
that limitation is removed and you can scroll any distance off screen.
-If nil, scrolling commands exit Isearch mode."
+If nil, scrolling commands exit Isearch mode.
+See also the related option `isearch-allow-motion'."
:type '(choice (const :tag "Scrolling exits Isearch" nil)
(const :tag "Scrolling with current match on screen" t)
(const :tag "Scrolling with current match off screen"
unlimited))
:group 'isearch)
+(put 'beginning-of-buffer 'isearch-motion
+ '((lambda () (goto-char (point-min))) . forward))
+(put 'end-of-buffer 'isearch-motion
+ '((lambda () (goto-char (point-max))) . backward))
+(put 'scroll-up-command 'isearch-motion
+ '((lambda () (goto-char (window-end)) (recenter 1 t)) . forward))
+(put 'scroll-down-command 'isearch-motion
+ '((lambda () (goto-char (window-start)) (recenter -1 t)) . backward))
+
+(defcustom isearch-allow-motion nil
+ "Whether to allow movement between isearch matches by cursor motion commands.
+If non-nil, the four motion commands \\[beginning-of-buffer],
\\[end-of-buffer], \
+\\[scroll-up-command] and \\[scroll-down-command], when invoked during
+Isearch, move respectively to the first occurrence of the current search string
+in the buffer, the last one, the first one after the current window, and the
+last one before the current window.
+If nil, these motion commands normally exit Isearch and are executed.
+See also the related options `isearch-motion-changes-direction' and
+`isearch-allow-scroll'."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t))
+ :group 'isearch
+ :version "28.1")
+
+(defcustom isearch-motion-changes-direction nil
+ "Whether motion commands during incremental search change search direction.
+If nil, the search direction (forward or backward) does not change when
+motion commands are used during incremental search, except when wrapping.
+If non-nil, the search direction is forward after \\[beginning-of-buffer] and \
+\\[scroll-up-command], and
+backward after \\[end-of-buffer] and \\[scroll-down-command]."
+ :type '(choice (const :tag "Off" nil)
+ (const :tag "On" t))
+ :group 'isearch
+ :version "28.1")
+
(defcustom isearch-allow-prefix t
"Whether prefix arguments are allowed during incremental search.
If non-nil, entering a prefix argument will not terminate the
@@ -3032,6 +3071,24 @@ See more for options in `search-exit-option'."
;; Optionally edit the search string instead of exiting.
((eq search-exit-option 'edit)
(setq this-command 'isearch-edit-string))
+ ;; Handle motion command functions.
+ ((and isearch-allow-motion
+ (symbolp this-command)
+ (get this-command 'isearch-motion))
+ (let* ((property (get this-command 'isearch-motion))
+ (function (car property))
+ (current-direction (if isearch-forward 'forward 'backward))
+ (direction (or (cdr property)
+ (if isearch-forward 'forward 'backward))))
+ (funcall function)
+ (setq isearch-just-started t)
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat direction))
+ (when (and isearch-success (not isearch-motion-changes-direction))
+ (unless (eq direction current-direction)
+ (let ((isearch-repeat-on-direction-change nil))
+ (isearch-repeat current-direction))))
+ (setq this-command 'ignore)))
;; Handle a scrolling function or prefix argument.
((or (and isearch-allow-prefix
(memq this-command '(universal-argument universal-argument-more
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index a905936b6b..c1a5bbe947 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -44,10 +44,13 @@ Preserves the `buffer-modified-p' state of the current
buffer."
:version "21.1"
:group 'font-lock)
-(defcustom jit-lock-chunk-size 500
+(defcustom jit-lock-chunk-size 1500
"Jit-lock fontifies chunks of at most this many characters at a time.
-This variable controls both display-time and stealth fontification."
+This variable controls both display-time and stealth fontification.
+
+The optimum value is a little over the typical number of buffer
+characters which fit in a typical window."
:type 'integer)
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 7d3ed9a0e4..8c6fb2c71b 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1408,9 +1408,10 @@ its value is returned."
;; Mouse clicks in the fringe come with a position in
;; (nth 5). This is useful but is not exactly where we clicked, so
;; don't look up that position's properties!
- (and pt (not (memq (posn-area pos) '(left-fringe right-fringe
- left-margin right-margin)))
- (get-char-property pt property w))))
+ (and pt (not (memq (posn-area pos)
+ '(left-fringe right-fringe
+ left-margin right-margin tab-bar)))
+ (get-char-property pt property w))))
(get-char-property pos property)))
(defun mouse-on-link-p (pos)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 73b8c439f2..bf77ecc7af 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -692,16 +692,11 @@ alist is deprecated. Use `browse-url-handlers' instead.")
(defun browse-url-url-encode-chars (text chars)
"URL-encode the chars in TEXT that match CHARS.
-CHARS is a regexp-like character alternative (e.g., \"[)$]\")."
- (let ((encoded-text (copy-sequence text))
- (s 0))
- (while (setq s (string-match chars encoded-text s))
- (setq encoded-text
- (replace-match (format "%%%X"
- (string-to-char (match-string 0
encoded-text)))
- t t encoded-text)
- s (1+ s)))
- encoded-text))
+CHARS is a regexp that matches a character."
+ (replace-regexp-in-string chars
+ (lambda (s)
+ (format "%%%X" (string-to-char s)))
+ text))
(defun browse-url-encode-url (url)
"Escape annoying characters in URL.
@@ -710,7 +705,7 @@ regarding its parameter treatment."
;; FIXME: Is there an actual example of a web browser getting
;; confused? (This used to encode commas, but at least Firefox
;; handles commas correctly and doesn't accept encoded commas.)
- (browse-url-url-encode-chars url "[\")$] "))
+ (browse-url-url-encode-chars url "[\"()$ ]"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL input
@@ -971,6 +966,7 @@ click but point is not changed."
"Invoke the MS-Windows system's default Web browser.
The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
(cond ((eq system-type 'ms-dos)
(if dos-windows-version
(shell-command (concat "start " (shell-quote-argument url)))
@@ -1000,6 +996,7 @@ The optional NEW-WINDOW argument is not used."
"Invoke the macOS system's default Web browser.
The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
+ (setq url (browse-url-encode-url url))
(start-process (concat "open " url) nil "open" url))
(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 70dbfdb947..a35ac37a20 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -442,7 +442,9 @@ Emacs dired can't find files."
(make-directory par parents))))
(tramp-flush-directory-properties v localname)
(unless (or (tramp-adb-send-command-and-check
- v (format "mkdir %s" (tramp-shell-quote-argument localname)))
+ v (format "mkdir -m %#o %s"
+ (default-file-modes)
+ (tramp-shell-quote-argument localname)))
(and parents (file-directory-p dir)))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index e4f54cf4c4..25deead813 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1574,10 +1574,13 @@ 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.
- (unless (or (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
- (and parents (file-directory-p dir)))
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
+ (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))))))
(defun tramp-gvfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a2bf0afbf5..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"))
@@ -2449,8 +2449,9 @@ The method used must be an out-of-band method."
(tramp-flush-directory-properties
v (if parents "/" (file-name-directory localname)))
(tramp-barf-unless-okay
- v (format "%s %s"
+ v (format "%s -m %#o %s"
(if parents "mkdir -p" "mkdir")
+ (default-file-modes)
(tramp-shell-quote-argument localname))
"Couldn't make directory %s" dir)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 5895f1d25b..051d145c2a 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -597,6 +597,7 @@ the result will be a local, non-Tramp, file name."
v (if parents "/" (file-name-directory localname)))
(unless (tramp-sudoedit-send-command
v (if parents '("mkdir" "-p") "mkdir")
+ "-m" (format "%#o" (default-file-modes))
(tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9ed9da9243..0182248dfa 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2821,6 +2821,15 @@ not in completion mode."
"Like `file-name-all-completions' for partial Tramp files."
(let ((fullname
(tramp-drop-volume-letter (expand-file-name filename directory)))
+ ;; When `tramp-syntax' is `simplified', we need a default method.
+ (tramp-default-method
+ (and (zerop (length tramp-postfix-method-format))
+ tramp-default-method))
+ (tramp-default-method-alist
+ (and (zerop (length tramp-postfix-method-format))
+ tramp-default-method-alist))
+ tramp-default-user tramp-default-user-alist
+ tramp-default-host tramp-default-host-alist
hop result result1)
;; Suppress hop from completion.
@@ -3006,7 +3015,7 @@ remote host and localname (filename on remote host)."
"Return all method completions for PARTIAL-METHOD."
(mapcar
(lambda (method)
- (and method (string-prefix-p partial-method method)
+ (and method (string-prefix-p (or partial-method "") method)
(tramp-completion-make-tramp-file-name method nil nil nil)))
(mapcar #'car tramp-methods)))
diff --git a/lisp/paren.el b/lisp/paren.el
index a45a08abd3..708605f794 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -101,9 +101,11 @@ its position."
(define-minor-mode show-paren-mode
"Toggle visualization of matching parens (Show Paren mode).
-Show Paren mode is a global minor mode. When enabled, any
-matching parenthesis is highlighted in `show-paren-style' after
-`show-paren-delay' seconds of Emacs idle time."
+When enabled, any matching parenthesis is highlighted in `show-paren-style'
+after `show-paren-delay' seconds of Emacs idle time.
+
+This is a global minor mode. To toggle the mode in a single buffer,
+use `show-paren-local-mode'."
:global t :group 'paren-showing
;; Enable or disable the mechanism.
;; First get rid of the old idle timer.
@@ -114,8 +116,28 @@ matching parenthesis is highlighted in `show-paren-style'
after
show-paren-delay t
#'show-paren-function))
(unless show-paren-mode
- (delete-overlay show-paren--overlay)
- (delete-overlay show-paren--overlay-1)))
+ (show-paren--delete-overlays)))
+
+(defun show-paren--delete-overlays ()
+ (delete-overlay show-paren--overlay)
+ (delete-overlay show-paren--overlay-1))
+
+;;;###autoload
+(define-minor-mode show-paren-local-mode
+ "Toggle `show-paren-mode' only in this buffer."
+ :variable (buffer-local-value 'show-paren-mode (current-buffer))
+ (cond
+ ((eq show-paren-mode (default-value 'show-paren-mode))
+ (unless show-paren-mode
+ (show-paren--delete-overlays))
+ (kill-local-variable 'show-paren-mode))
+ ((not (default-value 'show-paren-mode))
+ ;; Locally enabled, but globally disabled.
+ (show-paren-mode 1) ; Setup the timer.
+ (setq-default show-paren-mode nil) ; But keep it globally disabled.
+ )
+ (t ;; Locally disabled only.
+ (show-paren--delete-overlays))))
(defun show-paren--unescaped-p (pos)
"Determine whether the paren after POS is unescaped."
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index c0c9d5e659..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)
@@ -72,11 +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 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)
@@ -92,37 +111,92 @@ The second subexpression should match the bug reference
(usually a number)."
(bug-reference-set-overlay-properties)
+(defun bug-reference--overlays-in (start end)
+ "Return bug reference overlays in the region between START and END."
+ (let (overlays)
+ (dolist (o (overlays-in start end))
+ (when (eq (overlay-get o 'category) 'bug-reference)
+ (push o overlays)))
+ (nreverse overlays)))
+
(defun bug-reference-unfontify (start end)
"Remove bug reference overlays from the region between START and END."
- (dolist (o (overlays-in start end))
- (when (eq (overlay-get o 'category) 'bug-reference)
- (delete-overlay o))))
+ (mapc #'delete-overlay (bug-reference--overlays-in start end)))
(defvar bug-reference-prog-mode)
+(defvar bug-reference--nonconforming-regexps nil)
+
+(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
- (let ((beg-line (progn (goto-char start) (line-beginning-position)))
- (end-line (progn (goto-char end) (line-end-position))))
- ;; Remove old overlays.
- (bug-reference-unfontify beg-line end-line)
+ (let* ((beg-line (progn (goto-char start) (line-beginning-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 ((overlay (make-overlay (match-beginning 0) (match-end 0)
- nil t nil)))
- (overlay-put overlay 'category 'bug-reference)
- ;; Don't put a link if format is undefined
- (when bug-reference-url-format
+ (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)))
+ (overlay-put ov 'category 'bug-reference)
+ ov))))
+ ;; 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
(match-string-no-properties 2))
- (funcall bug-reference-url-format))))))))))
+ (funcall bug-reference-url-format)))))))
+ ;; Delete remaining but unused overlays.
+ (dolist (ov overlays)
+ (delete-overlay ov)))))
;; Taken from button.el.
(defun bug-reference-push-button (&optional pos _use-mouse-action)
@@ -135,14 +209,14 @@ The second subexpression should match the bug reference
(usually a number)."
(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)
@@ -153,142 +227,137 @@ The second subexpression should match the bug reference
(usually a number)."
(push (match-string i url) groups))
(funcall bug-url-fmt (nreverse groups))))))
-(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'.")
-
-(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'.")
-
-(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
;; `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.
- ;;
- ;; 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 1)
- ns-project)
- "/issues/"
- (match-string 2))))))
- ;;
- ;; 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 1)
- ns-project)
- "/issues/"
- (match-string 2))))))
- ;;
- ;; 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")
- "\\(?1:[.A-Za-z0-9_/-]+\\)?\\(?3:[#!]\\)\\(?2:[0-9]+\\)\\>"
- ,(lambda (groups)
- (let ((host (nth 1 groups))
- (ns-project (nth 2 groups)))
- (lambda ()
- (concat "https://"; host "/"
- (or (match-string 1)
- ns-project)
- "/-/"
- (if (string= (match-string 3) "#")
- "issues/"
- "merge_requests/")
- (match-string 2))))))
- ;;
- ;; 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 1)
- ns-project)
- "/"
- (match-string 2))))))))))
+
+ ;; 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.
@@ -564,10 +633,8 @@ guesswork is based on these variables:
bug-reference-url-format)
(with-demoted-errors
"Error during bug-reference auto-setup: %S"
- (catch 'setup
- (dolist (f bug-reference-auto-setup-functions)
- (when (funcall f)
- (throw 'setup t))))))))
+ (run-hook-with-args-until-success
+ 'bug-reference-auto-setup-functions)))))
;;;###autoload
(define-minor-mode bug-reference-mode
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index f518501c67..4f3ca924dd 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1203,153 +1203,198 @@ The expansion is entirely correct because it uses the
C preprocessor."
;; minimalistic Perl grammar, to be used instead of individual (and
;; not always consistent) literal regular expressions.
-(defconst cperl--basic-identifier-regexp
- (rx (sequence (or alpha "_") (* (or word "_"))))
- "A regular expression for the name of a \"basic\" Perl variable.
+;; This is necessary to compile this file under Emacs 26.1
+;; (there's no rx-define which would help)
+(eval-and-compile
+
+ (defconst cperl--basic-identifier-rx
+ '(sequence (or alpha "_") (* (or word "_")))
+ "A regular expression for the name of a \"basic\" Perl variable.
Neither namespace separators nor sigils are included. As is,
this regular expression applies to labels,subroutine calls where
the ampersand sigil is not required, and names of subroutine
attributes.")
-(defconst cperl--label-regexp
- (rx-to-string
- `(sequence
- symbol-start
- (regexp ,cperl--basic-identifier-regexp)
- (0+ space)
- ":"))
- "A regular expression for a Perl label.
+ (defconst cperl--label-rx
+ `(sequence symbol-start
+ ,cperl--basic-identifier-rx
+ (0+ space)
+ ":")
+ "A regular expression for a Perl label.
By convention, labels are uppercase alphabetics, but this isn't
enforced.")
-(defconst cperl--normal-identifier-regexp
- (rx-to-string
- `(or
- (sequence
- (1+ (sequence
- (opt (regexp ,cperl--basic-identifier-regexp))
- "::"))
- (opt (regexp ,cperl--basic-identifier-regexp)))
- (regexp ,cperl--basic-identifier-regexp)))
- "A regular expression for a Perl variable name with optional namespace.
+ (defconst cperl--false-label-rx
+ '(sequence (or (in "sym") "tr") (0+ space) ":")
+ "A regular expression which is similar to a label, but might as
+well be a quote-like operator with a colon as delimiter.")
+
+ (defconst cperl--normal-identifier-rx
+ `(or (sequence (1+ (sequence
+ (opt ,cperl--basic-identifier-rx)
+ "::"))
+ (opt ,cperl--basic-identifier-rx))
+ ,cperl--basic-identifier-rx)
+ "A regular expression for a Perl variable name with optional namespace.
Examples are `foo`, `Some::Module::VERSION`, and `::` (yes, that
is a legal variable name).")
-(defconst cperl--special-identifier-regexp
- (rx-to-string
- `(or
- (1+ digit) ; $0, $1, $2, ...
- (sequence "^" (any "A-Z" "]^_?\\")) ; $^V
- (sequence "{" (0+ space) ; ${^MATCH}
- "^" (any "A-Z" "]^_?\\")
- (0+ (any "A-Z" "_" digit))
- (0+ space) "}")
- (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~"))) ; $., $|, $", ... but not $^ or
${
- "The list of Perl \"punctuation\" variables, as listed in perlvar.")
-
-(defconst cperl--ws-regexp
- (rx-to-string
- '(or space "\n"))
- "Regular expression for a single whitespace in Perl.")
-
-(defconst cperl--eol-comment-regexp
- (rx-to-string
- '(sequence "#" (0+ (not (in "\n"))) "\n"))
- "Regular expression for a single end-of-line comment in Perl")
-
-(defconst cperl--ws-or-comment-regexp
- (rx-to-string
- `(1+
- (or
- (regexp ,cperl--ws-regexp)
- (regexp ,cperl--eol-comment-regexp))))
- "Regular expression for a sequence of whitespace and comments in Perl.")
-
-(defconst cperl--ows-regexp
- (rx-to-string
- `(opt (regexp ,cperl--ws-or-comment-regexp)))
- "Regular expression for optional whitespaces or comments in Perl")
-
-(defconst cperl--version-regexp
- (rx-to-string
- `(or
- (sequence (opt "v")
- (>= 2 (sequence (1+ digit) "."))
- (1+ digit)
- (opt (sequence "_" (1+ word))))
- (sequence (1+ digit)
- (opt (sequence "." (1+ digit)))
- (opt (sequence "_" (1+ word))))))
- "A sequence for recommended version number schemes in Perl.")
-
-(defconst cperl--package-regexp
- (rx-to-string
- `(sequence
- "package" ; FIXME: the "class" and "role" keywords need to be
- ; recognized soon...ish.
- (regexp ,cperl--ws-or-comment-regexp)
- (group (regexp ,cperl--normal-identifier-regexp))
- (opt
- (sequence
- (regexp ,cperl--ws-or-comment-regexp)
- (group (regexp ,cperl--version-regexp))))))
- "A regular expression for package NAME VERSION in Perl.
-Contains two groups for the package name and version.")
-
-(defconst cperl--package-for-imenu-regexp
- (rx-to-string
- `(sequence
- (regexp ,cperl--package-regexp)
- (regexp ,cperl--ows-regexp)
- (group (or ";" "{"))))
- "A regular expression to collect package names for `imenu`.
+ (defconst cperl--special-identifier-rx
+ '(or
+ (1+ digit) ; $0, $1, $2, ...
+ (sequence "^" (any "A-Z" "]^_?\\")) ; $^V
+ (sequence "{" (0+ space) ; ${^MATCH}
+ "^" (any "A-Z" "]^_?\\")
+ (0+ (any "A-Z" "_" digit))
+ (0+ space) "}")
+ (in "!\"$%&'()+,-./:;<=>?@\\]^_`|~")) ; $., $|, $", ... but not $^ or
${
+ "The list of Perl \"punctuation\" variables, as listed in perlvar.")
+
+ (defconst cperl--ws-rx
+ '(sequence (or space "\n"))
+ "Regular expression for a single whitespace in Perl.")
+
+ (defconst cperl--eol-comment-rx
+ '(sequence "#" (0+ (not (in "\n"))) "\n")
+ "Regular expression for a single end-of-line comment in Perl")
+
+ (defconst cperl--ws-or-comment-rx
+ `(or ,cperl--ws-rx
+ ,cperl--eol-comment-rx)
+ "A regular expression for either whitespace or comment")
+
+ (defconst cperl--ws*-rx
+ `(0+ ,cperl--ws-or-comment-rx)
+ "Regular expression for optional whitespaces or comments in Perl")
+
+ (defconst cperl--ws+-rx
+ `(1+ ,cperl--ws-or-comment-rx)
+ "Regular expression for a sequence of whitespace and comments in Perl.")
+
+ ;; This is left as a string regexp. There are many version schemes in
+ ;; the wild, so people might want to fiddle with this variable.
+ (defconst cperl--version-regexp
+ (rx-to-string
+ `(or
+ (sequence (optional "v")
+ (>= 2 (sequence (1+ digit) "."))
+ (1+ digit)
+ (optional (sequence "_" (1+ word))))
+ (sequence (1+ digit)
+ (optional (sequence "." (1+ digit)))
+ (optional (sequence "_" (1+ word))))))
+ "A sequence for recommended version number schemes in Perl.")
+
+ (defconst cperl--package-rx
+ `(sequence (group "package")
+ ,cperl--ws+-rx
+ (group ,cperl--normal-identifier-rx)
+ (optional (sequence ,cperl--ws+-rx
+ (group (regexp ,cperl--version-regexp)))))
+ "A regular expression for package NAME VERSION in Perl.
+Contains three groups for the keyword \"package\", for the
+package name and for the version.")
+
+ (defconst cperl--package-for-imenu-rx
+ `(sequence symbol-start
+ (group-n 1 "package")
+ ,cperl--ws*-rx
+ (group-n 2 ,cperl--normal-identifier-rx)
+ (optional (sequence ,cperl--ws+-rx
+ (regexp ,cperl--version-regexp)))
+ ,cperl--ws*-rx
+ (group-n 3 (or ";" "{")))
+ "A regular expression to collect package names for `imenu`.
Catches \"package NAME;\", \"package NAME VERSION;\", \"package
NAME BLOCK\" and \"package NAME VERSION BLOCK.\" Contains three
-groups: Two from `cperl--package-regexp` for the package name and
-version, and a third to detect \"package BLOCK\" syntax.")
-
-(defconst cperl--sub-name-regexp
- (rx-to-string
- `(sequence
- (optional (sequence (group (or "my" "state" "our"))
- (regexp ,cperl--ws-or-comment-regexp)))
- "sub" ; FIXME: the "method" and maybe "fun" keywords need to be
- ; recognized soon...ish.
- (regexp ,cperl--ws-or-comment-regexp)
- (group (regexp ,cperl--normal-identifier-regexp))))
- "A regular expression to detect a subroutine start.
-Contains two groups: One for to distinguish lexical from
-\"normal\" subroutines and one for the subroutine name.")
-
-(defconst cperl--pod-heading-regexp
- (rx-to-string
- `(sequence
- line-start "=head"
- (group (in "1-4"))
- (1+ (in " \t"))
- (group (1+ (not (in "\n"))))
- line-end)) ; that line-end seems to be redundant?
+groups: One for the keyword \"package\", one for the package
+name, and one for the discovery of a following BLOCK.")
+
+ (defconst cperl--sub-name-for-imenu-rx
+ `(sequence symbol-start
+ (optional (sequence (group-n 3 (or "my" "state" "our"))
+ ,cperl--ws+-rx))
+ (group-n 1 "sub")
+ ,cperl--ws+-rx
+ (group-n 2 ,cperl--normal-identifier-rx))
+ "A regular expression to detect a subroutine start.
+Contains three groups: One one to distinguish lexical from
+\"normal\" subroutines, for the keyword \"sub\", and one for the
+subroutine name.")
+
+(defconst cperl--block-declaration-rx
+ `(sequence
+ (or "package" "sub") ; "class" and "method" coming soon
+ (1+ ,cperl--ws-or-comment-rx)
+ ,cperl--normal-identifier-rx)
+ "A regular expression to find a declaration for a named block.
+Used for indentation. These declarations introduce a block which
+does not need a semicolon to terminate the statement.")
+
+(defconst cperl--pod-heading-rx
+ `(sequence line-start
+ (group-n 1 "=head")
+ (group-n 3 (in "1-4"))
+ (1+ (in " \t"))
+ (group-n 2 (1+ (not (in "\n")))))
"A regular expression to detect a POD heading.
Contains two groups: One for the heading level, and one for the
heading text.")
-(defconst cperl--imenu-entries-regexp
- (rx-to-string
- `(or
- (regexp ,cperl--package-for-imenu-regexp) ; 1..3
- (regexp ,cperl--sub-name-regexp) ; 4..5
- (regexp ,cperl--pod-heading-regexp))) ; 6..7
+(defconst cperl--imenu-entries-rx
+ `(or ,cperl--package-for-imenu-rx
+ ,cperl--sub-name-for-imenu-rx
+ ,cperl--pod-heading-rx)
"A regular expression to collect stuff that goes into the `imenu` index.
Covers packages, subroutines, and POD headings.")
+;; end of eval-and-compiled stuff
+)
+
+
+(defun cperl-block-declaration-p ()
+ "Test whether the following ?\\{ opens a declaration block.
+Returns the column where the declarating keyword is found, or nil
+if this isn't a declaration block. Declaration blocks are named
+subroutines, packages and the like. They start with a keyword
+and a name, to be followed by various descriptive items which are
+just skipped over for our purpose. Declaration blocks end a
+statement, so there's no semicolon."
+ ;; A scan error means that none of the declarators has been found
+ (condition-case nil
+ (let ((is-block-declaration nil)
+ (continue-searching t))
+ (while (and continue-searching (not (bobp)))
+ (forward-sexp -1)
+ (cond
+ ((looking-at (rx (eval cperl--block-declaration-rx)))
+ (setq is-block-declaration (current-column)
+ continue-searching nil))
+ ;; Another brace means this is no block declaration
+ ((looking-at "{")
+ (setq continue-searching nil))
+ (t
+ (cperl-backward-to-noncomment (point-min))
+ ;; A semicolon or an opening brace prevent this block from
+ ;; being a block declaration
+ (when (or (eq (preceding-char) ?\;)
+ (eq (preceding-char) ?{))
+ (setq continue-searching nil)))))
+ is-block-declaration)
+ (error nil)))
+
;; These two must be unwound, otherwise take exponential time
-(defconst cperl-maybe-white-and-comment-rex "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
+(defconst cperl-maybe-white-and-comment-rex
+ (rx (group (eval cperl--ws*-rx)))
+ ;; was: "[ \t\n]*\\(#[^\n]*\n[ \t\n]*\\)*"
"Regular expression to match optional whitespace with interspersed comments.
Should contain exactly one group.")
;; This one is tricky to unwind; still very inefficient...
-(defconst cperl-white-and-comment-rex "\\([ \t\n]\\|#[^\n]*\n\\)+"
+(defconst cperl-white-and-comment-rex
+ (rx (group (eval cperl--ws+-rx)))
+ ;; was: "\\([ \t\n]\\|#[^\n]*\n\\)+"
"Regular expression to match whitespace with interspersed comments.
Should contain exactly one group.")
@@ -1405,28 +1450,9 @@ the last)."
when (eq char (aref keyword (1- (length keyword))))
return t))
-;; Details of groups in this are used in `cperl-imenu--create-perl-index'
-;; and `cperl-outline-level'.
-;; Was: 2=sub|package; now 2=package-group, 5=package-name 8=sub-name (+3)
-(defvar cperl-imenu--function-name-regexp-perl
- (concat
- "^\\(" ; 1 = all
- "\\([ \t]*package" ; 2 = package-group
- "\\(" ; 3 = package-name-group
- cperl-white-and-comment-rex ; 4 = pre-package-name
- "\\([a-zA-Z_0-9:']+\\)\\)?\\)" ; 5 = package-name
- "\\|"
- "[ \t]*"
- cperl-sub-regexp
- (cperl-after-sub-regexp 'named nil) ; 8=name 11=proto 14=attr-start
- cperl-maybe-white-and-comment-rex ; 15=pre-block
- "\\|"
- "=head\\([1-4]\\)[ \t]+" ; 16=level
- "\\([^\n]+\\)$" ; 17=text
- "\\)"))
-
(defvar cperl-outline-regexp
- (concat cperl-imenu--function-name-regexp-perl "\\|" "\\`"))
+ (rx (sequence line-start (0+ blank) (eval cperl--imenu-entries-rx)))
+ "The regular expression used for outline-minor-mode")
(defvar cperl-mode-syntax-table nil
"Syntax table in use in CPerl mode buffers.")
@@ -2516,8 +2542,9 @@ Return the amount the indentation changed by."
(t
(skip-chars-forward " \t")
(if (listp indent) (setq indent (car indent)))
- (cond ((and (looking-at "[A-Za-z_][A-Za-z_0-9]*:[^:]")
- (not (looking-at "[smy]:\\|tr:")))
+ (cond ((and (looking-at (rx (sequence (eval cperl--label-rx)
+ (not (in ":")))))
+ (not (looking-at (rx (eval cperl--false-label-rx)))))
(and (> indent 0)
(setq indent (max cperl-min-label-indent
(+ indent cperl-label-offset)))))
@@ -2709,6 +2736,8 @@ Will not look before LIM."
(and (eq (preceding-char) ?\})
(cperl-after-block-and-statement-beg
(point-min))) ; Was start - too close
+ (and char-after (char-equal char-after ?{)
+ (save-excursion (cperl-block-declaration-p)))
(memq char-after (append ")]}" nil))
(and (eq (preceding-char) ?\:) ; label
(progn
@@ -2752,12 +2781,10 @@ Will not look before LIM."
;; Back up over label lines, since they don't
;; affect whether our line is a continuation.
;; (Had \, too)
- (while;;(or (eq (preceding-char) ?\,)
- (and (eq (preceding-char) ?:)
- (or;;(eq (char-after (- (point) 2)) ?\') ; ????
- (memq (char-syntax (char-after (- (point) 2)))
- '(?w ?_))))
- ;;)
+ (while (and (eq (preceding-char) ?:)
+ (re-search-backward
+ (rx (sequence (eval cperl--label-rx) point))
+ nil t))
;; This is always FALSE?
(if (eq (preceding-char) ?\,)
;; Will go to beginning of line, essentially.
@@ -2769,6 +2796,7 @@ Will not look before LIM."
(if (not (or (eq (1- (point)) containing-sexp)
(and cperl-indent-parens-as-block
(not is-block))
+ (save-excursion (cperl-block-declaration-p))
(memq (preceding-char)
(append (if is-block " ;{" " ,;{")
'(nil)))
(and (eq (preceding-char) ?\})
@@ -2797,10 +2825,17 @@ Will not look before LIM."
(forward-char 1)
(let ((colon-line-end 0))
(while
- (progn (skip-chars-forward " \t\n")
- ;; s: foo : bar :x is NOT label
- (and (looking-at
"#\\|\\([a-zA-Z0-9_$]+\\):[^:]\\|=[a-zA-Z]")
- (not (looking-at "[sym]:\\|tr:"))))
+ (progn
+ (skip-chars-forward " \t\n")
+ ;; s: foo : bar :x is NOT label
+ (and (looking-at
+ (rx
+ (or "#"
+ (sequence (eval cperl--label-rx)
+ (not (in ":")))
+ (sequence "=" (in "a-zA-Z")))))
+ (not (looking-at
+ (rx (eval
cperl--false-label-rx))))))
;; Skip over comments and labels following
openbrace.
(cond ((= (following-char) ?\#)
(forward-line 1))
@@ -3059,7 +3094,10 @@ and closing parentheses and brackets."
;; If line starts with label, calculate label indentation
(if (save-excursion
(beginning-of-line)
- (looking-at "[ \t]*[a-zA-Z_][a-zA-Z_0-9]*:[^:]"))
+ (looking-at (rx
+ (sequence (0+ space)
+ (eval cperl--label-rx)
+ (not (in ":"))))))
(if (> (current-indentation) cperl-min-label-indent)
(- (current-indentation) cperl-label-offset)
;; Do not move `parse-data', this should
@@ -4768,15 +4806,19 @@ recursive calls in starting lines of here-documents."
(if (< p (point)) (goto-char p))
(setq stop t))))))
-;; Used only in `cperl-calculate-indent'...
+;; Used only in `cperl-sniff-for-indent'...
(defun cperl-block-p ()
- "Point is before ?\\{. Checks whether it starts a block."
+ "Point is before ?\\{. Return true if it starts a block."
;; No save-excursion! This is more a distinguisher of a block/hash ref...
(cperl-backward-to-noncomment (point-min))
(or (memq (preceding-char) (append ";){}$@&%\C-@" nil)) ; Or label! \C-@ at
bobp
; Label may be mixed up with `$blah :'
(save-excursion (cperl-after-label))
+ ;; text with the 'attrib-group property is also covered by the
+ ;; next clause. We keep it because it is faster (for
+ ;; subroutines with attributes).
(get-text-property (cperl-1- (point)) 'attrib-group)
+ (save-excursion (cperl-block-declaration-p))
(and (memq (char-syntax (preceding-char)) '(?w ?_))
(progn
(backward-sexp)
@@ -4814,6 +4856,7 @@ statement would start; thus the block in ${func()} does
not count."
(save-excursion (cperl-after-label))
;; sub :attr {}
(get-text-property (cperl-1- (point)) 'attrib-group)
+ (save-excursion (cperl-block-declaration-p))
(if (memq (char-syntax (preceding-char)) '(?w ?_)) ; else {}
(save-excursion
(forward-sexp -1)
@@ -4929,7 +4972,8 @@ CHARS is a string that contains good characters to have
before us (however,
(skip-chars-forward " \t"))
(defun cperl-after-block-and-statement-beg (lim)
- ;; We assume that we are after ?\}
+ "Return true if the preceding ?} ends the statement."
+ ;; We assume that we are after ?\}
(and
(cperl-after-block-p lim)
(save-excursion
@@ -5405,6 +5449,10 @@ indentation and initial hashes. Behaves usually outside
of comment."
;; Previous space could have gone:
(or (memq (preceding-char) '(?\s ?\t)) (insert " "))))))
+(defvar cperl-imenu-package-keywords '("package" "class" "role"))
+(defvar cperl-imenu-sub-keywords '("sub" "method" "function" "fun"))
+(defvar cperl-imenu-pod-keywords '("=head"))
+
(defun cperl-imenu--create-perl-index ()
"Implement `imenu-create-index-function` for CPerl mode.
This function relies on syntaxification to exclude lines which
@@ -5423,20 +5471,21 @@ comment, or POD."
(current-package "(main)")
(current-package-end (point-max))) ; end of package scope
;; collect index entries
- (while (re-search-forward cperl--imenu-entries-regexp nil t)
+ (while (re-search-forward (rx (eval cperl--imenu-entries-rx)) nil t)
;; First, check whether we have left the scope of previously
;; recorded packages, and if so, eliminate them from the stack.
(while (< current-package-end (point))
(setq current-package (pop package-stack))
(setq current-package-end (pop package-stack)))
(let ((state (syntax-ppss))
+ (entry-type (match-string 1))
name marker) ; for the "current" entry
(cond
((nth 3 state) nil) ; matched in a string, so skip
- ((match-string 1) ; found a package name!
+ ((member entry-type cperl-imenu-package-keywords) ; package or class
(unless (nth 4 state) ; skip if in a comment
- (setq name (match-string-no-properties 1)
- marker (copy-marker (match-end 1)))
+ (setq name (match-string-no-properties 2)
+ marker (copy-marker (match-end 2)))
(if (string= (match-string 3) ";")
(setq current-package name) ; package NAME;
;; No semicolon, therefore we have: package NAME BLOCK.
@@ -5449,32 +5498,33 @@ comment, or POD."
(setq current-package-end (save-excursion
(goto-char (match-beginning 3))
(forward-sexp)
- (point)))
+ (point))))
(push (cons name marker) index-package-alist)
- (push (cons (concat "package " name) marker)
index-unsorted-alist))))
- ((match-string 5) ; found a sub name!
+ (push (cons (concat entry-type " " name) marker)
index-unsorted-alist)))
+ ((or (member entry-type cperl-imenu-sub-keywords) ; sub or method
+ (string-equal entry-type "")) ; named blocks
(unless (nth 4 state) ; skip if in a comment
- (setq name (match-string-no-properties 5)
- marker (copy-marker (match-end 5)))
+ (setq name (match-string-no-properties 2)
+ marker (copy-marker (match-end 2)))
;; Qualify the sub name with the package if it doesn't
;; already have one, and if it isn't lexically scoped.
;; "my" and "state" subs are lexically scoped, but "our"
;; are just lexical aliases to package subs.
(if (and (null (string-match "::" name))
- (or (null (match-string 4))
- (string-equal (match-string 4) "our")))
+ (or (null (match-string 3))
+ (string-equal (match-string 3) "our")))
(setq name (concat current-package "::" name)))
(let ((index (cons name marker)))
(push index index-alist)
(push index index-sub-alist)
(push index index-unsorted-alist))))
- ((match-string 6) ; found a POD heading!
- (when (get-text-property (match-beginning 6) 'in-pod)
+ ((member entry-type cperl-imenu-pod-keywords) ; POD heading
+ (when (get-text-property (match-beginning 2) 'in-pod)
(setq name (concat (make-string
- (* 3 (- (char-after (match-beginning 6)) ?1))
+ (* 3 (- (char-after (match-beginning 3)) ?1))
?\ )
- (match-string-no-properties 7))
- marker (copy-marker (match-beginning 7)))
+ (match-string-no-properties 2))
+ marker (copy-marker (match-beginning 2)))
(push (cons name marker) index-pod-alist)
(push (cons (concat "=" name) marker) index-unsorted-alist)))
(t (error "Unidentified match: %s" (match-string 0))))))
@@ -5727,10 +5777,25 @@ function."
2 font-lock-string-face t)))
'("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
font-lock-string-face t)
- '("^[ \t]*\\([a-zA-Z0-9_]+[ \t]*:\\)[
\t]*\\($\\|{\\|\\<\\(until\\|while\\|for\\(each\\)?\\|do\\)\\>\\)" 1
- font-lock-constant-face) ; labels
- '("\\<\\(continue\\|next\\|last\\|redo\\|break\\|goto\\)\\>[
\t]+\\([a-zA-Z0-9_:]+\\)" ; labels as targets
- 2 font-lock-constant-face)
+ ;; labels
+ `(,(rx
+ (sequence
+ (0+ space)
+ (group (eval cperl--label-rx))
+ (0+ space)
+ (or line-end "#" "{"
+ (sequence word-start
+ (or "until" "while" "for" "foreach" "do")
+ word-end))))
+ 1 font-lock-constant-face)
+ ;; labels as targets (no trailing colon!)
+ `(,(rx
+ (sequence
+ symbol-start
+ (or "continue" "next" "last" "redo" "break" "goto")
+ (1+ space)
+ (group (eval cperl--basic-identifier-rx))))
+ 1 font-lock-constant-face)
;; Uncomment to get perl-mode-like vars
;;; '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
;;; '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index a1f806ae8c..cddf3ba0b9 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -158,11 +158,12 @@ Otherwise, `find-tag-default' is used."
:version "21.1")
(defcustom tags-apropos-additional-actions nil
- "Specify additional actions for `tags-apropos'.
+ "Specify additional actions for `tags-apropos' and `xref-find-apropos'.
If non-nil, value should be a list of triples (TITLE FUNCTION
-TO-SEARCH). For each triple, `tags-apropos' processes TO-SEARCH and
-lists tags from it. TO-SEARCH should be an alist, obarray, or symbol.
+TO-SEARCH). For each triple, `tags-apropos' and `xref-find-apropos'
+process TO-SEARCH and list tags from it. TO-SEARCH should be an alist,
+obarray, or symbol.
If it is a symbol, the symbol's value is used.
TITLE, a string, is a title used to label the additional list of tags.
FUNCTION is a function to call when a symbol is selected in the
@@ -2096,7 +2097,10 @@ file name, add `tag-partial-file-name-match-p' to the
list value.")
definitions))
(cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
- (etags--xref-find-definitions (xref-apropos-regexp pattern) t))
+ (let ((regexp (xref-apropos-regexp pattern)))
+ (nconc
+ (etags--xref-find-definitions regexp t)
+ (etags--xref-apropos-additional regexp))))
(defun etags--xref-find-definitions (pattern &optional regexp?)
;; This emulates the behavior of `find-tag-in-order' but instead of
@@ -2131,6 +2135,32 @@ file name, add `tag-partial-file-name-match-p' to the
list value.")
(puthash mark-key t marks))))))))))
(nreverse xrefs)))
+(defun etags--xref-apropos-additional (regexp)
+ (cl-mapcan
+ (lambda (oba)
+ (pcase-let* ((`(,group ,goto-fun ,symbs) oba)
+ (res nil)
+ (add-xref (lambda (sym)
+ (let ((sn (symbol-name sym)))
+ (when (string-match-p regexp sn)
+ (push
+ (xref-make
+ sn
+ (xref-make-etags-apropos-location
+ sym goto-fun group))
+ res))))))
+ (when (symbolp symbs)
+ (if (boundp symbs)
+ (setq symbs (symbol-value symbs))
+ (warn "symbol `%s' has no value" symbs)
+ (setq symbs nil))
+ (if (vectorp symbs)
+ (mapatoms add-xref symbs)
+ (dolist (sy symbs)
+ (funcall add-xref (car sy))))
+ (nreverse res))))
+ tags-apropos-additional-actions))
+
(defclass xref-etags-location (xref-location)
((tag-info :type list :initarg :tag-info)
(file :type string :initarg :file
@@ -2155,6 +2185,25 @@ file name, add `tag-partial-file-name-match-p' to the
list value.")
(with-slots (tag-info) l
(nth 1 tag-info)))
+(defclass xref-etags-apropos-location (xref-location)
+ ((symbol :type symbol :initarg :symbol)
+ (goto-fun :type function :initarg :goto-fun)
+ (group :type string :initarg :group
+ :reader xref-location-group))
+ :documentation "Location of an additional apropos etags symbol.")
+
+(defun xref-make-etags-apropos-location (symbol goto-fun group)
+ (make-instance 'xref-etags-apropos-location
+ :symbol symbol
+ :goto-fun goto-fun
+ :group group))
+
+(cl-defmethod xref-location-marker ((l xref-etags-apropos-location))
+ (save-window-excursion
+ (with-slots (goto-fun symbol) l
+ (funcall goto-fun symbol)
+ (point-marker))))
+
(provide 'etags)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 30ae82e689..e3bffa6393 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1373,17 +1373,22 @@ Each element is of the form (COMMAND LABEL &optional
KEY) where
COMMAND is the command to run when KEY is pressed. LABEL is used
to distinguish the menu entries in the dispatch menu. If KEY is
absent, COMMAND must be bound in `project-prefix-map', and the
-key is looked up in that map."
+key is looked up in that map.
+
+The value can also be a symbol, the name of the command to be
+invoked immediately without any dispatch menu."
:version "28.1"
:group 'project
:package-version '(project . "0.6.0")
- :type '(repeat
- (list
- (symbol :tag "Command")
- (string :tag "Label")
- (choice :tag "Key to press"
- (const :tag "Infer from the keymap" nil)
- (character :tag "Explicit key")))))
+ :type '(choice
+ (repeat :tag "Commands menu"
+ (list
+ (symbol :tag "Command")
+ (string :tag "Label")
+ (choice :tag "Key to press"
+ (const :tag "Infer from the keymap" nil)
+ (character :tag "Explicit key"))))
+ (symbol :tag "Single command")))
(defcustom project-switch-use-entire-map nil
"Make `project-switch-project' use entire `project-prefix-map'.
@@ -1413,15 +1418,7 @@ are legal even if they aren't listed in the dispatch
menu."
project-switch-commands
" "))
-;;;###autoload
-(defun project-switch-project (dir)
- "\"Switch\" to another project by running an Emacs command.
-The available commands are presented as a dispatch menu
-made from `project-switch-commands'.
-
-When called in a program, it will use the project corresponding
-to directory DIR."
- (interactive (list (project-prompt-project-dir)))
+(defun project--switch-project-command ()
(let* ((commands-menu
(mapcar
(lambda (row)
@@ -1452,6 +1449,20 @@ to directory DIR."
(when (memq global-command
'(keyboard-quit keyboard-escape-quit))
(call-interactively global-command)))))
+ command))
+
+;;;###autoload
+(defun project-switch-project (dir)
+ "\"Switch\" to another project by running an Emacs command.
+The available commands are presented as a dispatch menu
+made from `project-switch-commands'.
+
+When called in a program, it will use the project corresponding
+to directory DIR."
+ (interactive (list (project-prompt-project-dir)))
+ (let ((command (if (symbolp project-switch-commands)
+ project-switch-commands
+ (project--switch-project-command))))
(let ((default-directory dir)
(project-current-inhibit-prompt t))
(call-interactively command))))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d8ec032402..d9fc5c5009 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -2571,10 +2571,12 @@ the `buffer-name'."
(format
(concat
"import os.path;import sys;"
- "sys.path.append(os.path.dirname(os.path.dirname('''%s''')));"
- "__package__ = '''%s''';"
+ "sys.path.append(os.path.dirname(os.path.dirname(%s)));"
+ "__package__ = %s;"
"import %s")
- directory package package)
+ (python-shell--encode-string directory)
+ (python-shell--encode-string package)
+ package)
(python-shell-get-process)))
(defun python-shell-accept-process-output (process &optional timeout regexp)
@@ -2811,6 +2813,50 @@ eventually provide a shell."
:type 'hook
:group 'python)
+(defconst python-shell-eval-setup-code
+ "\
+def __PYTHON_EL_eval(source, filename):
+ import ast, sys
+ if sys.version_info[0] == 2:
+ from __builtin__ import compile, eval, globals
+ else:
+ from builtins import compile, eval, globals
+ sys.stdout.write('\\n')
+ try:
+ p, e = ast.parse(source, filename), None
+ except SyntaxError:
+ t, v, tb = sys.exc_info()
+ sys.excepthook(t, v, tb.tb_next)
+ return
+ if p.body and isinstance(p.body[-1], ast.Expr):
+ e = p.body.pop()
+ try:
+ g = globals()
+ exec(compile(p, filename, 'exec'), g, g)
+ if e:
+ return eval(compile(ast.Expression(e.value), filename, 'eval'), g,
g)
+ except Exception:
+ t, v, tb = sys.exc_info()
+ sys.excepthook(t, v, tb.tb_next)"
+ "Code used to evaluate statements in inferior Python processes.")
+
+(defconst python-shell-eval-file-setup-code
+ "\
+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.
+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."
(when (not python-shell--first-prompt-received)
@@ -2826,6 +2872,15 @@ eventually provide a shell."
(setq python-shell--first-prompt-received-output-buffer nil)
(setq-local python-shell--first-prompt-received t)
(setq python-shell--first-prompt-received-output-buffer nil)
+ (cl-letf (((symbol-function 'python-shell-send-string)
+ (lambda (string process)
+ (comint-send-string
+ process
+ (format "exec(%s)\n" (python-shell--encode-string
string))))))
+ ;; Bootstrap: the normal definition of `python-shell-send-string'
+ ;; depends on the Python code sent here.
+ (python-shell-send-string-no-output python-shell-eval-setup-code)
+ (python-shell-send-string-no-output
python-shell-eval-file-setup-code))
(with-current-buffer (current-buffer)
(let ((inhibit-quit nil))
(run-hooks 'python-shell-first-prompt-hook))))))
@@ -3077,37 +3132,12 @@ 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))
-(defconst python-shell-eval-setup-code
- "\
-def __PYTHON_EL_eval(source, filename):
- import ast, sys
- if sys.version_info[0] == 2:
- from __builtin__ import compile, eval, globals
- else:
- from builtins import compile, eval, globals
- sys.stdout.write('\\n')
- try:
- p, e = ast.parse(source, filename), None
- except SyntaxError:
- t, v, tb = sys.exc_info()
- sys.excepthook(t, v, tb.tb_next)
- return
- if p.body and isinstance(p.body[-1], ast.Expr):
- e = p.body.pop()
- try:
- g = globals()
- exec(compile(p, filename, 'exec'), g, g)
- if e:
- return eval(compile(ast.Expression(e.value), filename, 'eval'), g,
g)
- except Exception:
- t, v, tb = sys.exc_info()
- sys.excepthook(t, v, tb.tb_next)"
- "Code used to evaluate statements in inferior Python processes.")
-
(defalias 'python-shell--encode-string
(let ((fun (if (and (fboundp 'json-serialize)
(>= emacs-major-version 28))
@@ -3128,12 +3158,14 @@ t when called interactively."
(interactive
(list (read-string "Python command: ") nil t))
(let ((process (or process (python-shell-get-process-or-error msg)))
- (code (format "exec(%s);__PYTHON_EL_eval(%s, %s)\n"
- (python-shell--encode-string
python-shell-eval-setup-code)
+ (code (format "__PYTHON_EL_eval(%s, %s)\n"
(python-shell--encode-string string)
(python-shell--encode-string (or (buffer-file-name)
"<string>")))))
- (if (<= (string-bytes code) 4096)
+ (if (or (null (process-tty-name process))
+ (<= (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)))
@@ -3180,8 +3212,7 @@ Return the output."
(inhibit-quit t))
(or
(with-local-quit
- (comint-send-string
- process (format "exec(%s)\n" (python-shell--encode-string string)))
+ (python-shell-send-string string process)
(while python-shell-output-filter-in-progress
;; `python-shell-output-filter' takes care of setting
;; `python-shell-output-filter-in-progress' to NIL after it
@@ -3378,26 +3409,18 @@ t when called interactively."
nil ;; noop
msg))))
-
-(defconst python-shell-eval-file-setup-code
- "\
-def __PYTHON_EL_eval_file(filename, tempname, encoding, delete):
- import codecs, os
- 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.")
-
(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
@@ -3407,24 +3430,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
- "exec(%s);exec(%s);__PYTHON_EL_eval_file(%s, %s, %s, %s)\n"
- (python-shell--encode-string python-shell-eval-setup-code)
- (python-shell--encode-string python-shell-eval-file-setup-code)
+ "__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)
@@ -3527,23 +3551,14 @@ def __PYTHON_EL_get_completions(text):
"25.1"
"Completion string code must work for (i)pdb.")
-(defcustom python-shell-completion-string-code
- "';'.join(__PYTHON_EL_get_completions('''%s'''))"
- "Python code used to get a string of completions separated by semicolons.
-The string passed to the function is the current python name or
-the full statement in the case of imports."
- :type 'string
- :group 'python)
-
(defcustom python-shell-completion-native-disabled-interpreters
;; PyPy's readline cannot handle some escape sequences yet. Native
- ;; completion was found to be non-functional for IPython (see
- ;; Bug#25067). Native completion doesn't work on w32 (Bug#28580).
+ ;; completion doesn't work on w32 (Bug#28580).
(if (eq system-type 'windows-nt) '("")
- '("pypy" "ipython"))
+ '("pypy"))
"List of disabled interpreters.
When a match is found, native completion is disabled."
- :version "25.1"
+ :version "28.1"
:type '(repeat string))
(defcustom python-shell-completion-native-enable t
@@ -3579,13 +3594,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
@@ -3695,14 +3709,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.
@@ -3762,13 +3772,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")
@@ -3820,23 +3827,24 @@ 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
(python-shell-send-string-no-output
(format
- (concat python-shell-completion-setup-code
- "\nprint (" python-shell-completion-string-code ")")
- input) process))))
+ "%s\nprint(';'.join(__PYTHON_EL_get_completions(%s)))"
+ python-shell-completion-setup-code
+ (python-shell--encode-string input))
+ process))))
(when (> (length completions) 2)
(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
@@ -3890,12 +3898,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
@@ -4555,28 +4572,16 @@ def __FFAP_get_module_path(objstr):
:type 'string
:group 'python)
-(defcustom python-ffap-string-code
- "__FFAP_get_module_path('''%s''')"
- "Python code used to get a string with the path of a module."
- :type 'string
- :group 'python)
-
(defun python-ffap-module-path (module)
"Function for `ffap-alist' to return path for MODULE."
- (let ((process (or
- (and (derived-mode-p 'inferior-python-mode)
- (get-buffer-process (current-buffer)))
- (python-shell-get-process))))
- (if (not process)
- nil
- (let ((module-file
- (python-shell-send-string-no-output
- (concat
- python-ffap-setup-code
- "\nprint (" (format python-ffap-string-code module) ")")
- process)))
- (unless (zerop (length module-file))
- (python-util-strip-string module-file))))))
+ (when-let ((process (python-shell-get-process))
+ (module-file
+ (python-shell-send-string-no-output
+ (format "%s\nprint(__FFAP_get_module_path(%s))"
+ python-ffap-setup-code
+ (python-shell--encode-string module)))))
+ (unless (string-empty-p module-file)
+ (python-util-strip-string module-file))))
(defvar ffap-alist)
@@ -4667,12 +4672,6 @@ See `python-check-command' for the default."
:type 'string
:group 'python)
-(defcustom python-eldoc-string-code
- "__PYDOC_get_help('''%s''')"
- "Python code used to get a string with the documentation of an object."
- :type 'string
- :group 'python)
-
(defun python-eldoc--get-symbol-at-point ()
"Get the current symbol for eldoc.
Returns the current symbol handling point within arguments."
@@ -4702,11 +4701,12 @@ returns will be used. If not FORCE-PROCESS is passed
what
;; enabled. Bug#18794.
(python-util-strip-string
(python-shell-send-string-no-output
- (concat
+ (format
+ "%s\nprint(__PYDOC_get_help(%s))"
python-eldoc-setup-code
- "\nprint(" (format python-eldoc-string-code input) ")")
+ (python-shell--encode-string input))
process)))))
- (unless (zerop (length docstring))
+ (unless (string-empty-p docstring)
docstring)))))
(defvar-local python-eldoc-get-doc t
@@ -4757,7 +4757,9 @@ Interactively, prompt for symbol."
(interactive
(let ((symbol (python-eldoc--get-symbol-at-point))
(enable-recursive-minibuffers t))
- (list (read-string (format-prompt "Describe symbol" symbol)
+ (list (read-string (if symbol
+ (format "Describe symbol (default %s): " symbol)
+ "Describe symbol: ")
nil nil symbol))))
(message (python-eldoc--get-doc-at-point symbol)))
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index c09f007a5e..6a03856eaf 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -640,7 +640,15 @@ It is used when `ruby-encoding-magic-comment-style' is set
to `custom'."
('(:before . "do") (ruby-smie--indent-to-stmt))
('(:before . ".")
(if (smie-rule-sibling-p)
- (and ruby-align-chained-calls 0)
+ (when ruby-align-chained-calls
+ (while
+ (let ((pos (point))
+ (parent (smie-backward-sexp ".")))
+ (if (not (equal (nth 2 parent) "."))
+ (progn (goto-char pos) nil)
+ (goto-char (nth 1 parent))
+ (not (smie-rule-bolp)))))
+ (cons 'column (current-column)))
(smie-backward-sexp ".")
(cons 'column (+ (current-column)
ruby-indent-level))))
@@ -828,6 +836,7 @@ The style of the comment is controlled by
`ruby-encoding-magic-comment-style'."
;; `ruby-calculate-indent' in user init files still call it.
(defun ruby-current-indentation ()
"Return the indentation level of current line."
+ (declare (obsolete current-indentation "28.1"))
(save-excursion
(beginning-of-line)
(back-to-indentation)
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index d022baaf04..9a0de5f449 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -420,7 +420,9 @@ elements is negated: these commands will NOT prompt."
"If t, `xref-find-definitions' always jumps to the first result.
`show' means to show the first result's location, but keep the
focus on the Xref buffer's window.
-`move' means to only move point to the first result."
+`move' means to only move point to the first result.
+This variable also affects the variants of `xref-find-definitions',
+such as `xref-find-definitions-other-window'."
:type '(choice (const :tag "Jump" t)
(const :tag "Show" show)
(const :tag "Move point only" move)
@@ -429,13 +431,16 @@ focus on the Xref buffer's window.
:package-version '(xref . "1.2.0"))
(defcustom xref-auto-jump-to-first-xref nil
- "If t, xref commands always jump to the first result.
+ "If t, `xref-find-references' always jumps to the first result.
`show' means to show the first result's location, but keep the
focus on the Xref buffer's window.
`move' means to only move point to the first result.
+This variable also affects commands similar to `xref-find-references',
+such as `xref-find-references-at-mouse', `xref-find-apropos',
+and `project-find-regexp'.
-Please be careful changing this value if you are using Emacs 27
-or earlier: it can break dired-do-find-regexp-and-replace."
+Please be careful when changing the value if you are using Emacs 27
+or earlier: it can break `dired-do-find-regexp-and-replace'."
:type '(choice (const :tag "Jump" t)
(const :tag "Show" show)
(const :tag "Move point only" move)
@@ -1440,7 +1445,9 @@ This command is intended to be bound to a mouse event."
;;;###autoload
(defun xref-find-apropos (pattern)
"Find all meaningful symbols that match PATTERN.
-The argument has the same meaning as in `apropos'."
+The argument has the same meaning as in `apropos'.
+See `tags-apropos-additional-actions' for how to augment the
+output of this command when the backend is etags."
(interactive (list (read-string
"Search for pattern (word list or regexp): "
nil 'xref--read-pattern-history
diff --git a/lisp/simple.el b/lisp/simple.el
index 800a927903..14e5abc87d 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -6622,7 +6622,6 @@ Does not set point. Does nothing if mark ring is empty."
(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
(set-marker (mark-marker) (car mark-ring))
(set-marker (car mark-ring) nil)
- (unless (mark t) (ding))
(pop mark-ring))
(deactivate-mark))
@@ -8730,7 +8729,7 @@ See also `read-mail-command' concerning reading mail."
(function-item :tag "Message with full Gnus features"
:format "%t\n"
gnus-user-agent)
- (function :tag "Other"))
+ (symbol :tag "Other"))
:version "23.2" ; sendmail->message
:group 'mail)
diff --git a/lisp/startup.el b/lisp/startup.el
index 58030ca06a..505d7b83f4 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1788,9 +1788,19 @@ a face or button specification."
(window-width (window-width)))
(when img
(when (> window-width image-width)
- ;; Center the image in the window.
- (insert (propertize " " 'display
- `(space :align-to (+ center (-0.5 . ,img)))))
+ ;; Center the image above text.
+ ;; NB. The logo used to be centered in the window, which made
+ ;; it align poorly with the non-centered text on large
+ ;; displays. Arguably it would be better to center both
+ ;; text and image, but this will do for now. -- SK
+ (let ((text-width 80)
+ ;; The below value chosen to avoid splash screen being
+ ;; visually unbalanced. This needs to be eye-balled.
+ (adjust-left 3))
+ (insert (propertize " " 'display
+ `(space :align-to (+ ,(- (/ text-width 2)
+ adjust-left)
+ (-0.5 . ,img))))))
;; Change the color of the XPM version of the splash image
;; so that it is visible with a dark frame background.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 7f6afd7d53..faa155c53f 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -27,10 +27,7 @@
;; bindings for the global tab bar.
;; The normal global binding for [tab-bar] (below) uses the value of
-;; `tab-bar-map' as the actual keymap to define the tab bar. Modes
-;; may either bind items under the [tab-bar] prefix key of the local
-;; map to add to the global bar or may set `tab-bar-map'
-;; buffer-locally to override it.
+;; `tab-bar-map' as the actual keymap to define the tab bar.
;;; Code:
@@ -92,10 +89,13 @@
(defcustom tab-bar-select-tab-modifiers '()
- "List of modifier keys for selecting a tab by its index digit.
+ "List of modifier keys for selecting tab-bar tabs by index numbers.
Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
-`alt'. To help you to select a tab by its number, you can customize
-`tab-bar-tab-hints' that will show tab numbers alongside the tab name."
+`alt'. Presiing one of the modifiers in the list and a digit selects
+the tab whose index equals the digit. Negative numbers count from
+the end of the tab bar. The digit 9 selects the last (rightmost) tab.
+For easier selection of tabs by their numbers, consider customizing
+`tab-bar-tab-hints', which will show tab numbers alongside the tab name."
:type '(set :tag "Tab selection modifier keys"
(const control)
(const meta)
@@ -161,7 +161,7 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
(add-text-properties 0 (length tab-bar-new-button)
`(display (image :type xpm
:file "tabs/new.xpm"
- :margin (2 . 0)
+ :margin ,tab-bar-button-margin
:ascent center))
tab-bar-new-button))
@@ -171,7 +171,7 @@ Possible modifier keys are `control', `meta', `shift',
`hyper', `super' and
(add-text-properties 0 (length tab-bar-close-button)
`(display (image :type xpm
:file "tabs/close.xpm"
- :margin (2 . 0)
+ :margin ,tab-bar-button-margin
:ascent center))
tab-bar-close-button)))
@@ -224,31 +224,71 @@ a list of frames to update."
(tab-bar--define-keys)
(tab-bar--undefine-keys)))
-(defun tab-bar-handle-mouse (event)
- "Text-mode emulation of switching tabs on the tab bar.
-This command is used when you click the mouse in the tab bar
-on a console which has no window system but does have a mouse."
+(defun tab-bar--key-to-number (key)
+ (let ((key-name (format "%S" key)))
+ (when (string-prefix-p "tab-" key-name)
+ (string-to-number (string-replace "tab-" "" key-name)))))
+
+(defun tab-bar--event-to-item (posn)
+ (if (posn-window posn)
+ (let ((caption (car (posn-string posn))))
+ (when caption
+ (get-text-property 0 'menu-item caption)))
+ ;; Text-mode emulation of switching tabs on the tab bar.
+ ;; This code is used when you click the mouse in the tab bar
+ ;; on a console which has no window system but does have a mouse.
+ (let* ((x-position (car (posn-x-y posn)))
+ (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps)))
[tab-bar]))
+ (column 0))
+ (when x-position
+ (catch 'done
+ (map-keymap
+ (lambda (key binding)
+ (when (eq (car-safe binding) 'menu-item)
+ (when (> (+ column (length (nth 1 binding))) x-position)
+ (throw 'done (list
+ key (nth 2 binding)
+ (get-text-property
+ (- x-position column) 'close-tab (nth 1
binding)))))
+ (setq column (+ column (length (nth 1 binding))))))
+ keymap))))))
+
+(defun tab-bar-mouse-select-tab (event)
(interactive "e")
- (let* ((x-position (car (posn-x-y (event-start event))))
- (keymap (lookup-key (cons 'keymap (nreverse (current-active-maps)))
[tab-bar]))
- (column 0))
- (when x-position
- (unless (catch 'done
- (map-keymap
- (lambda (key binding)
- (when (eq (car-safe binding) 'menu-item)
- (when (> (+ column (length (nth 1 binding))) x-position)
- (if (get-text-property (- x-position column) 'close-tab
(nth 1 binding))
- (let* ((close-key (vector (intern (format "C-%s"
key))))
- (close-def (lookup-key keymap close-key)))
- (when close-def
- (call-interactively close-def)))
- (call-interactively (nth 2 binding)))
- (throw 'done t))
- (setq column (+ column (length (nth 1 binding))))))
- keymap))
- ;; Clicking anywhere outside existing tabs will add a new tab
- (tab-bar-new-tab)))))
+ (let ((item (tab-bar--event-to-item (event-start event))))
+ (if (nth 2 item)
+ (tab-bar-close-tab (tab-bar--key-to-number (nth 0 item)))
+ (if (functionp (nth 1 item))
+ (call-interactively (nth 1 item))
+ (tab-bar-select-tab (tab-bar--key-to-number (nth 0 item)))))))
+
+(defun tab-bar-mouse-close-tab (event)
+ (interactive "e")
+ (let ((item (tab-bar--event-to-item (event-start event))))
+ (tab-bar-close-tab (tab-bar--key-to-number (nth 0 item)))))
+
+(defun tab-bar-mouse-context-menu (event)
+ (interactive "e")
+ (let* ((item (tab-bar--event-to-item (event-start event)))
+ (tab-number (tab-bar--key-to-number (nth 0 item)))
+ (menu (make-sparse-keymap "Context Menu")))
+
+ (define-key-after menu [close]
+ `(menu-item "Close" (lambda () (interactive)
+ (tab-bar-close-tab ,tab-number))
+ :help "Close the tab"))
+
+ (popup-menu menu event)))
+
+(defun tab-bar-mouse-move-tab (event)
+ (interactive "e")
+ (let ((from (tab-bar--key-to-number
+ (nth 0 (tab-bar--event-to-item
+ (event-start event)))))
+ (to (tab-bar--key-to-number
+ (nth 0 (tab-bar--event-to-item
+ (event-end event))))))
+ (tab-bar-move-tab-to to from)))
(defun toggle-tab-bar-mode-from-frame (&optional arg)
"Toggle tab bar on or off, based on the status of the current frame.
@@ -275,32 +315,53 @@ new frame when the global `tab-bar-mode' is enabled, by
using
(set-frame-parameter frame 'tab-bar-lines-keep-state
(not (frame-parameter frame
'tab-bar-lines-keep-state))))
-(defvar tab-bar-map (make-sparse-keymap)
- "Keymap for the tab bar.
-Define this locally to override the global tab bar.")
+(defvar tab-bar-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [down-mouse-1] 'tab-bar-mouse-select-tab)
+ (define-key map [drag-mouse-1] 'tab-bar-mouse-move-tab)
+ (define-key map [mouse-1] 'ignore)
+ (define-key map [down-mouse-2] 'tab-bar-mouse-close-tab)
+ (define-key map [mouse-2] 'ignore)
+ (define-key map [down-mouse-3] 'tab-bar-mouse-context-menu)
+
+ (define-key map [mouse-4] 'tab-previous)
+ (define-key map [mouse-5] 'tab-next)
+ (define-key map [wheel-up] 'tab-previous)
+ (define-key map [wheel-down] 'tab-next)
+ (define-key map [wheel-left] 'tab-previous)
+ (define-key map [wheel-right] 'tab-next)
+
+ (define-key map [S-mouse-4] 'tab-bar-move-tab-backward)
+ (define-key map [S-mouse-5] 'tab-bar-move-tab)
+ (define-key map [S-wheel-up] 'tab-bar-move-tab-backward)
+ (define-key map [S-wheel-down] 'tab-bar-move-tab)
+ (define-key map [S-wheel-left] 'tab-bar-move-tab-backward)
+ (define-key map [S-wheel-right] 'tab-bar-move-tab)
+
+ map)
+ "Keymap for the commands used on the tab bar.")
(global-set-key [tab-bar]
`(menu-item ,(purecopy "tab bar") ignore
:filter tab-bar-make-keymap))
-(defconst tab-bar-keymap-cache (make-hash-table :weakness t :test 'equal))
-
(defun tab-bar-make-keymap (&optional _ignore)
"Generate an actual keymap from `tab-bar-map'.
-Its main job is to show tabs in the tab bar."
- (if (= 1 (length tab-bar-map))
- (tab-bar-make-keymap-1)
- (let ((key (cons (frame-terminal) tab-bar-map)))
- (or (gethash key tab-bar-keymap-cache)
- (puthash key tab-bar-map tab-bar-keymap-cache)))))
+Its main job is to show tabs in the tab bar
+and to bind mouse events to the commands."
+ (tab-bar-make-keymap-1))
(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 the value is `1', then hide the tab bar when it has only one tab,
-and show it again once more tabs are created.
+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 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.
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.
@@ -610,19 +671,12 @@ You can hide these buttons by customizing
`tab-bar-format' and removing
`((,(intern (format "tab-%i" i))
menu-item
,(funcall tab-bar-tab-name-format-function tab i)
- ,(or
- (alist-get 'binding tab)
- `(lambda ()
- (interactive)
- (tab-bar-select-tab ,i)))
+ ,(alist-get 'binding tab)
:help "Click to visit tab"))))
- `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format
"C-tab-%i" i)))
- menu-item ""
- ,(or
- (alist-get 'close-binding tab)
- `(lambda ()
- (interactive)
- (tab-bar-close-tab ,i)))))))
+ (when (alist-get 'close-binding tab)
+ `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format
"C-tab-%i" i)))
+ menu-item ""
+ ,(alist-get 'close-binding tab))))))
(defun tab-bar-format-tabs ()
(let ((i 0))
@@ -762,9 +816,7 @@ on the tab bar instead."
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
- (append
- '(keymap (mouse-1 . tab-bar-handle-mouse))
- (tab-bar-format-list tab-bar-format)))
+ (append tab-bar-map (tab-bar-format-list tab-bar-format)))
;; Some window-configuration parameters don't need to be persistent.
@@ -868,11 +920,13 @@ ARG counts from 1. Negative ARG counts tabs from the end
of the tab bar."
(let ((key (event-basic-type last-command-event)))
(setq arg (if (and (characterp key) (>= key ?1) (<= key ?9))
(- key ?0)
- 1))))
+ 0))))
(let* ((tabs (funcall tab-bar-tabs-function))
(from-index (tab-bar--current-tab-index tabs))
- (to-index (if (< arg 0) (+ (length tabs) (1+ arg)) arg))
+ (to-index (cond ((< arg 0) (+ (length tabs) (1+ arg)))
+ ((zerop arg) (1+ from-index))
+ (t arg)))
(to-index (1- (max 1 (min to-index (length tabs))))))
(unless (eq from-index to-index)
@@ -1016,6 +1070,12 @@ where argument addressing is absolute."
(to-index (mod (+ from-index arg) (length tabs))))
(tab-bar-move-tab-to (1+ to-index) (1+ from-index))))
+(defun tab-bar-move-tab-backward (&optional arg)
+ "Move the current tab ARG positions to the left.
+Like `tab-bar-move-tab', but moves in the opposite direction."
+ (interactive "p")
+ (tab-bar-move-tab (- (or arg 1))))
+
(defun tab-bar-move-tab-to-frame (arg &optional from-frame from-index to-frame
to-index)
"Move tab from FROM-INDEX position to new position at TO-INDEX.
FROM-INDEX defaults to the current tab index.
@@ -1597,7 +1657,7 @@ and can restore them."
(add-text-properties 0 (length tab-bar-back-button)
`(display (image :type xpm
:file "tabs/left-arrow.xpm"
- :margin (2 . 0)
+ :margin ,tab-bar-button-margin
:ascent center))
tab-bar-back-button))
(when (and tab-bar-mode (not (get-text-property 0 'display
tab-bar-forward-button)))
@@ -1605,7 +1665,7 @@ and can restore them."
(add-text-properties 0 (length tab-bar-forward-button)
`(display (image :type xpm
:file "tabs/right-arrow.xpm"
- :margin (2 . 0)
+ :margin ,tab-bar-button-margin
:ascent center))
tab-bar-forward-button))
@@ -2080,11 +2140,8 @@ Used in `repeat-mode'.")
(defvar tab-bar-move-repeat-map
(let ((map (make-sparse-keymap)))
- (define-key map "m" 'tab-move)
- (define-key map "M" (lambda ()
- (interactive)
- (setq repeat-map 'tab-bar-move-repeat-map)
- (tab-move -1)))
+ (define-key map "m" 'tab-bar-move-tab)
+ (define-key map "M" 'tab-bar-move-tab-backward)
map)
"Keymap to repeat tab move key sequences `C-x t m m M'.
Used in `repeat-mode'.")
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index de5f000089..95187d5d11 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -394,6 +394,9 @@ Return the pasted text as a string."
(define-key map "\eOx" [kp-8])
(define-key map "\eOy" [kp-9])
+ ;; Some keypads have an equal key (for instance, most Apple keypads).
+ (define-key map "\eOX" [kp-equal])
+
(define-key map "\eO2j" [S-kp-multiply])
(define-key map "\eO2k" [S-kp-add])
(define-key map "\eO2l" [S-kp-separator])
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 037fbcbc48..4b309c338a 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -245,15 +245,17 @@ included in the completions."
(defun vc-git--literal-pathspec (file)
"Prepend :(literal) path magic to FILE."
;; Good example of file name that needs this: "test[56].xx".
- (let ((lname (file-local-name file)))
- ;; Expand abbreviated file names.
- (when (file-name-absolute-p lname)
- (setq lname (expand-file-name lname)))
- (and file (concat ":(literal)" lname))))
+ (when file
+ (let ((lname (file-local-name file)))
+ ;; Expand abbreviated file names.
+ (when (file-name-absolute-p lname)
+ (setq lname (expand-file-name lname)))
+ (concat ":(literal)" lname))))
(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."
@@ -1791,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)."
diff --git a/src/comp.c b/src/comp.c
index 7e21331e66..0012860096 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -515,6 +515,7 @@ typedef struct {
typedef struct {
EMACS_INT speed;
EMACS_INT debug;
+ Lisp_Object compiler_options;
Lisp_Object driver_options;
gcc_jit_context *ctxt;
gcc_jit_type *void_type;
@@ -4383,6 +4384,22 @@ DEFUN ("comp-native-driver-options-effective-p",
}
#pragma GCC diagnostic pop
+#pragma GCC diagnostic ignored "-Waddress"
+DEFUN ("comp-native-compiler-options-effective-p",
+ Fcomp_native_compiler_options_effective_p,
+ Scomp_native_compiler_options_effective_p,
+ 0, 0, 0,
+ doc: /* Return t if `comp-native-compiler-options' is effective. */)
+ (void)
+{
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option)
+ if (gcc_jit_context_add_command_line_option)
+ return Qt;
+#endif
+ return Qnil;
+}
+#pragma GCC diagnostic pop
+
static void
add_driver_options (void)
{
@@ -4422,6 +4439,43 @@ add_driver_options (void)
#endif
}
+static void
+add_compiler_options (void)
+{
+ Lisp_Object options = Fsymbol_value (Qnative_comp_compiler_options);
+
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option)
+ load_gccjit_if_necessary (true);
+ if (!NILP (Fcomp_native_compiler_options_effective_p ()))
+ FOR_EACH_TAIL (options)
+ gcc_jit_context_add_command_line_option (comp.ctxt,
+ /* FIXME: Need to encode
+ this, but how? either
+ ENCODE_FILE or
+ ENCODE_SYSTEM. */
+ SSDATA (XCAR (options)));
+#endif
+ if (CONSP (options))
+ xsignal1 (Qnative_compiler_error,
+ build_string ("Customizing native compiler options"
+ " via `comp-native-compiler-options' is"
+ " only available on libgccjit version 9"
+ " and above."));
+
+ /* Captured `comp-native-compiler-options' because file-local. */
+#if defined (LIBGCCJIT_HAVE_gcc_jit_context_add_command_line_option)
+ options = comp.compiler_options;
+ if (!NILP (Fcomp_native_compiler_options_effective_p ()))
+ FOR_EACH_TAIL (options)
+ gcc_jit_context_add_command_line_option (comp.ctxt,
+ /* FIXME: Need to encode
+ this, but how? either
+ ENCODE_FILE or
+ ENCODE_SYSTEM. */
+ SSDATA (XCAR (options)));
+#endif
+}
+
DEFUN ("comp--compile-ctxt-to-file", Fcomp__compile_ctxt_to_file,
Scomp__compile_ctxt_to_file,
1, 1, 0,
@@ -4467,6 +4521,7 @@ DEFUN ("comp--compile-ctxt-to-file",
Fcomp__compile_ctxt_to_file,
comp.debug = XFIXNUM (CALL1I (comp-ctxt-debug, Vcomp_ctxt));
eassert (comp.debug < INT_MAX);
comp.driver_options = CALL1I (comp-ctxt-driver-options, Vcomp_ctxt);
+ comp.compiler_options = CALL1I (comp-ctxt-compiler-options, Vcomp_ctxt);
if (comp.debug)
gcc_jit_context_set_bool_option (comp.ctxt,
@@ -4541,6 +4596,7 @@ DEFUN ("comp--compile-ctxt-to-file",
Fcomp__compile_ctxt_to_file,
"-fdisable-tree-isolate-paths");
#endif
+ add_compiler_options ();
add_driver_options ();
if (comp.debug > 1)
@@ -5248,6 +5304,7 @@ compiled one. */);
DEFSYM (Qnative_comp_speed, "native-comp-speed");
DEFSYM (Qnative_comp_debug, "native-comp-debug");
DEFSYM (Qnative_comp_driver_options, "native-comp-driver-options");
+ DEFSYM (Qnative_comp_compiler_options, "native-comp-compiler-options");
DEFSYM (Qcomp_libgccjit_reproducer, "comp-libgccjit-reproducer");
/* Limple instruction set. */
@@ -5357,6 +5414,7 @@ compiled one. */);
defsubr (&Scomp_el_to_eln_rel_filename);
defsubr (&Scomp_el_to_eln_filename);
defsubr (&Scomp_native_driver_options_effective_p);
+ defsubr (&Scomp_native_compiler_options_effective_p);
defsubr (&Scomp__install_trampoline);
defsubr (&Scomp__init_ctxt);
defsubr (&Scomp__release_ctxt);
diff --git a/src/dispextern.h b/src/dispextern.h
index 33fcaa4c07..f4c7575b35 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3415,8 +3415,8 @@ extern void get_glyph_string_clip_rect (struct
glyph_string *,
NativeRectangle *nr);
extern Lisp_Object find_hot_spot (Lisp_Object, int, int);
-extern void handle_tab_bar_click (struct frame *,
- int, int, bool, int);
+extern Lisp_Object handle_tab_bar_click (struct frame *,
+ int, int, bool, int);
extern void handle_tool_bar_click (struct frame *,
int, int, bool, int);
diff --git a/src/keyboard.c b/src/keyboard.c
index f6139b30e7..63bf29a948 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -951,6 +951,10 @@ cmd_error (Lisp_Object data)
Vexecuting_kbd_macro = Qnil;
executing_kbd_macro = Qnil;
}
+ else if (!NILP (KVAR (current_kboard, defining_kbd_macro)))
+ /* An `M-x' command that signals a `minibuffer-quit' condition
+ that's part of a kbd macro. */
+ finalize_kbd_macro_chars ();
specbind (Qstandard_output, Qt);
specbind (Qstandard_input, Qt);
@@ -5088,13 +5092,42 @@ 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))
+#ifndef HAVE_EXT_TOOL_BAR
+ || (WINDOWP (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,
+ 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) */
@@ -5107,15 +5140,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
@@ -5239,7 +5272,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;
@@ -5291,17 +5324,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)))
{
@@ -5650,6 +5683,11 @@ 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))
+ position = nconc2 (position, Fcons (XCDR (event->arg), Qnil));
}
#ifndef USE_TOOLKIT_SCROLL_BARS
else
diff --git a/src/menu.c b/src/menu.c
index d43360ec4e..1aafa78c3c 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -1127,9 +1127,12 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
/* Decode the first argument: find the window and the coordinates. */
if (EQ (position, Qt)
- || (CONSP (position) && (EQ (XCAR (position), Qmenu_bar)
- || EQ (XCAR (position), Qtab_bar)
- || EQ (XCAR (position), Qtool_bar))))
+ || (CONSP (position)
+ && (EQ (XCAR (position), Qmenu_bar)
+ || EQ (XCAR (position), Qtab_bar)
+ || (CONSP (XCDR (position))
+ && EQ (XCAR (XCDR (position)), Qtab_bar))
+ || EQ (XCAR (position), Qtool_bar))))
{
get_current_pos_p = 1;
}
diff --git a/src/pdumper.c b/src/pdumper.c
index 7730ea3d06..2291fced5d 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -4537,15 +4537,28 @@ dump_map_file_w32 (void *base, int fd, off_t offset,
size_t size,
uint32_t offset_low = (uint32_t) (full_offset & 0xffffffff);
int error;
+ DWORD protect;
DWORD map_access;
file = (HANDLE) _get_osfhandle (fd);
if (file == INVALID_HANDLE_VALUE)
goto out;
+ switch (protection)
+ {
+ case DUMP_MEMORY_ACCESS_READWRITE:
+ protect = PAGE_WRITECOPY; /* for Windows 9X */
+ break;
+ default:
+ case DUMP_MEMORY_ACCESS_NONE:
+ case DUMP_MEMORY_ACCESS_READ:
+ protect = PAGE_READONLY;
+ break;
+ }
+
section = CreateFileMapping (file,
/*lpAttributes=*/NULL,
- PAGE_READONLY,
+ protect,
/*dwMaximumSizeHigh=*/0,
/*dwMaximumSizeLow=*/0,
/*lpName=*/NULL);
diff --git a/src/term.c b/src/term.c
index 6651b96792..7d9fe8cee3 100644
--- a/src/term.c
+++ b/src/term.c
@@ -2575,21 +2575,8 @@ handle_one_term_event (struct tty_display_info *tty,
Gpm_Event *event)
{
f->mouse_moved = 0;
term_mouse_click (&ie, event, f);
- /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
- if (tty_handle_tab_bar_click (f, event->x, event->y,
- (ie.modifiers & down_modifier) != 0, &ie))
- {
- /* eassert (ie.kind == MOUSE_CLICK_EVENT
- * || ie.kind == TAB_BAR_EVENT); */
- /* tty_handle_tab_bar_click stores 2 events in the event
- queue, so we are done here. */
- /* FIXME: Actually, `tty_handle_tab_bar_click` returns true
- without storing any events, when
- (ie.modifiers & down_modifier) != 0 */
- count += 2;
- return count;
- }
- /* eassert (ie.kind == MOUSE_CLICK_EVENT); */
+ ie.arg = tty_handle_tab_bar_click (f, event->x, event->y,
+ (ie.modifiers & down_modifier) != 0,
&ie);
kbd_buffer_store_event (&ie);
count++;
}
diff --git a/src/termchar.h b/src/termchar.h
index f50c1bfb6e..7ab9337fbe 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -234,7 +234,7 @@ extern struct tty_display_info *tty_list;
#define CURTTY() FRAME_TTY (SELECTED_FRAME())
struct input_event;
-extern bool tty_handle_tab_bar_click (struct frame *, int, int, bool,
- struct input_event *);
+extern Lisp_Object tty_handle_tab_bar_click (struct frame *, int, int, bool,
+ struct input_event *);
#endif /* EMACS_TERMCHAR_H */
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 1255072b7f..9a69b32bcb 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -586,9 +586,8 @@ do_mouse_event (MOUSE_EVENT_RECORD *event,
int x = event->dwMousePosition.X;
int y = event->dwMousePosition.Y;
struct frame *f = get_frame ();
- if (tty_handle_tab_bar_click (f, x, y, (button_state & mask) != 0,
- emacs_ev))
- return 0; /* tty_handle_tab_bar_click adds the event to queue */
+ emacs_ev->arg = tty_handle_tab_bar_click (f, x, y, (button_state & mask)
!= 0,
+ emacs_ev);
emacs_ev->modifiers |= ((button_state & mask)
? down_modifier : up_modifier);
@@ -597,7 +596,6 @@ do_mouse_event (MOUSE_EVENT_RECORD *event,
XSETFASTINT (emacs_ev->x, x);
XSETFASTINT (emacs_ev->y, y);
XSETFRAME (emacs_ev->frame_or_window, f);
- emacs_ev->arg = Qnil;
return 1;
}
diff --git a/src/w32term.c b/src/w32term.c
index ad4d1a3282..70e5501db1 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -168,8 +168,8 @@ int w32_keyboard_codepage;
int w32_message_fd = -1;
#endif /* CYGWIN */
-static void w32_handle_tab_bar_click (struct frame *,
- struct input_event *);
+static Lisp_Object w32_handle_tab_bar_click (struct frame *,
+ struct input_event *);
static void w32_handle_tool_bar_click (struct frame *,
struct input_event *);
static void w32_define_cursor (Window, Emacs_Cursor);
@@ -2031,11 +2031,14 @@ w32_draw_image_relief (struct glyph_string *s)
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
{
- thick = (tab_bar_button_relief < 0
- ? DEFAULT_TAB_BAR_BUTTON_RELIEF
- : (tool_bar_button_relief < 0
- ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
- : min (tool_bar_button_relief, 1000000)));
+ if (s->face->id == TAB_BAR_FACE_ID)
+ thick = (tab_bar_button_relief < 0
+ ? DEFAULT_TAB_BAR_BUTTON_RELIEF
+ : min (tab_bar_button_relief, 1000000));
+ else
+ thick = (tool_bar_button_relief < 0
+ ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
+ : min (tool_bar_button_relief, 1000000));
raised_p = s->hl == DRAW_IMAGE_RAISED;
}
else
@@ -2054,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)
@@ -3684,17 +3687,17 @@ w32_mouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
frame-relative coordinates X/Y. EVENT_TYPE is either ButtonPress
or ButtonRelease. */
-static void
+static Lisp_Object
w32_handle_tab_bar_click (struct frame *f, struct input_event *button_event)
{
int x = XFIXNAT (button_event->x);
int y = XFIXNAT (button_event->y);
if (button_event->modifiers & down_modifier)
- handle_tab_bar_click (f, x, y, 1, 0);
+ return handle_tab_bar_click (f, x, y, 1, 0);
else
- handle_tab_bar_click (f, x, y, 0,
- button_event->modifiers & ~up_modifier);
+ return handle_tab_bar_click (f, x, y, 0,
+ button_event->modifiers & ~up_modifier);
}
@@ -5186,6 +5189,7 @@ w32_read_socket (struct terminal *terminal,
{
/* If we decide we want to generate an event to be seen
by the rest of Emacs, we put it here. */
+ Lisp_Object tab_bar_arg = Qnil;
bool tab_bar_p = 0;
bool tool_bar_p = 0;
int button = 0;
@@ -5208,12 +5212,12 @@ w32_read_socket (struct terminal *terminal,
if (EQ (window, f->tab_bar_window))
{
- w32_handle_tab_bar_click (f, &inev);
+ tab_bar_arg = w32_handle_tab_bar_click (f, &inev);
tab_bar_p = 1;
}
}
- if (tab_bar_p
+ if ((tab_bar_p && NILP (tab_bar_arg))
|| (dpyinfo->w32_focus_frame
&& f != dpyinfo->w32_focus_frame
/* This does not help when the click happens in
@@ -5221,6 +5225,9 @@ 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;
+
/* Is this in the tool-bar? */
if (WINDOWP (f->tool_bar_window)
&& WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)))
diff --git a/src/xdisp.c b/src/xdisp.c
index b2fcc165a9..45c7090fc0 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -13759,7 +13759,7 @@ get_tab_bar_item (struct frame *f, int x, int y, struct
glyph **glyph,
false for button release. MODIFIERS is event modifiers for button
release. */
-void
+Lisp_Object
handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
int modifiers)
{
@@ -13773,16 +13773,13 @@ handle_tab_bar_click (struct frame *f, int x, int y,
bool down_p,
frame_to_window_pixel_xy (w, &x, &y);
ts = get_tab_bar_item (f, x, y, &glyph, &hpos, &vpos, &prop_idx, &close_p);
- if (ts == -1
- /* If the button is released on a tab other than the one where
- it was pressed, don't generate the tab-bar button click event. */
- || (ts != 0 && !down_p))
- return;
+ if (ts == -1)
+ return Qnil;
/* If item is disabled, do nothing. */
enabled_p = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_ENABLED_P);
if (NILP (enabled_p))
- return;
+ return Qnil;
if (down_p)
{
@@ -13793,24 +13790,24 @@ handle_tab_bar_click (struct frame *f, int x, int y,
bool down_p,
}
else
{
- Lisp_Object key, frame;
- struct input_event event;
- EVENT_INIT (event);
-
/* Show item in released state. */
if (!NILP (Vmouse_highlight))
show_mouse_face (hlinfo, DRAW_IMAGE_RAISED);
-
- key = AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY);
-
- XSETFRAME (frame, f);
- event.kind = TAB_BAR_EVENT;
- event.frame_or_window = frame;
- event.arg = key;
- event.modifiers = close_p ? ctrl_modifier | modifiers : modifiers;
- kbd_buffer_store_event (&event);
f->last_tab_bar_item = -1;
}
+
+ Lisp_Object caption =
+ Fcopy_sequence (AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_CAPTION));
+
+ AUTO_LIST2 (props, Qmenu_item,
+ list3 (AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_KEY),
+ AREF (f->tab_bar_items, prop_idx + TAB_BAR_ITEM_BINDING),
+ close_p ? Qt : Qnil));
+
+ Fadd_text_properties (make_fixnum (0), make_fixnum (SCHARS (caption)),
+ props, caption);
+
+ return Fcons (Qtab_bar, Fcons (caption, make_fixnum (0)));
}
@@ -13908,7 +13905,7 @@ note_tab_bar_highlight (struct frame *f, int x, int y)
/* Find the tab-bar item at X coordinate and return its information. */
static Lisp_Object
-tty_get_tab_bar_item (struct frame *f, int x, int *idx, ptrdiff_t *end)
+tty_get_tab_bar_item (struct frame *f, int x, int *prop_idx, bool *close_p)
{
ptrdiff_t clen = 0;
@@ -13921,8 +13918,11 @@ tty_get_tab_bar_item (struct frame *f, int x, int
*idx, ptrdiff_t *end)
clen += SCHARS (caption);
if (x < clen)
{
- *idx = i;
- *end = clen;
+ *prop_idx = i;
+ *close_p = !NILP (Fget_text_property (make_fixnum (SCHARS (caption)
+ - (clen - x)),
+ Qclose_tab,
+ caption));
return caption;
}
}
@@ -13934,61 +13934,45 @@ tty_get_tab_bar_item (struct frame *f, int x, int
*idx, ptrdiff_t *end)
structure, store it in keyboard queue, and return true; otherwise
return false. MODIFIERS are event modifiers for generating the tab
release event. */
-bool
+Lisp_Object
tty_handle_tab_bar_click (struct frame *f, int x, int y, bool down_p,
struct input_event *event)
{
/* Did they click on the tab bar? */
if (y < FRAME_MENU_BAR_LINES (f)
|| y >= FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f))
- return false;
+ return Qnil;
/* Find the tab-bar item where the X,Y coordinates belong. */
int prop_idx;
- ptrdiff_t clen;
- Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &clen);
+ bool close_p;
+ Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &close_p);
if (NILP (caption))
- return false;
+ return Qnil;
if (NILP (AREF (f->tab_bar_items,
prop_idx * TAB_BAR_ITEM_NSLOTS + TAB_BAR_ITEM_ENABLED_P)))
- return false;
+ return Qnil;
if (down_p)
f->last_tab_bar_item = prop_idx;
else
- {
- /* Force reset of up_modifier bit from the event modifiers. */
- if (event->modifiers & up_modifier)
- event->modifiers &= ~up_modifier;
-
- /* Generate a TAB_BAR_EVENT event. */
- Lisp_Object frame;
- Lisp_Object key = AREF (f->tab_bar_items,
- prop_idx * TAB_BAR_ITEM_NSLOTS
- + TAB_BAR_ITEM_KEY);
- /* Kludge alert: we assume the last two characters of a tab
- label are " x", and treat clicks on those 2 characters as a
- Close Tab command. */
- eassert (STRINGP (caption));
- int lastc = SSDATA (caption)[SCHARS (caption) - 1];
- bool close_p = false;
- if ((x == clen - 1 || (clen > 1 && x == clen - 2)) && lastc == 'x')
- close_p = true;
-
- event->code = 0;
- XSETFRAME (frame, f);
- event->kind = TAB_BAR_EVENT;
- event->frame_or_window = frame;
- event->arg = key;
- if (close_p)
- event->modifiers |= ctrl_modifier;
- kbd_buffer_store_event (event);
- f->last_tab_bar_item = -1;
- }
+ f->last_tab_bar_item = -1;
- return true;
+ caption = Fcopy_sequence (caption);
+
+ AUTO_LIST2 (props, Qmenu_item,
+ list3 (AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS
+ + TAB_BAR_ITEM_KEY),
+ AREF (f->tab_bar_items, prop_idx * TAB_BAR_ITEM_NSLOTS
+ + TAB_BAR_ITEM_BINDING),
+ close_p ? Qt : Qnil));
+
+ Fadd_text_properties (make_fixnum (0), make_fixnum (SCHARS (caption)),
+ props, caption);
+
+ return Fcons (Qtab_bar, Fcons (caption, make_fixnum (0)));
}
@@ -33569,7 +33553,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
&& y < FRAME_MENU_BAR_LINES (f) + FRAME_TAB_BAR_LINES (f)))
{
int prop_idx;
- ptrdiff_t ignore;
+ bool ignore;
Lisp_Object caption = tty_get_tab_bar_item (f, x, &prop_idx, &ignore);
if (!NILP (caption))
diff --git a/src/xterm.c b/src/xterm.c
index 1887c3255d..2c56c73068 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -3209,11 +3209,14 @@ x_draw_image_relief (struct glyph_string *s)
if (s->hl == DRAW_IMAGE_SUNKEN
|| s->hl == DRAW_IMAGE_RAISED)
{
- thick = (tab_bar_button_relief < 0
- ? DEFAULT_TAB_BAR_BUTTON_RELIEF
- : (tool_bar_button_relief < 0
- ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
- : min (tool_bar_button_relief, 1000000)));
+ if (s->face->id == TAB_BAR_FACE_ID)
+ thick = (tab_bar_button_relief < 0
+ ? DEFAULT_TAB_BAR_BUTTON_RELIEF
+ : min (tab_bar_button_relief, 1000000));
+ else
+ thick = (tool_bar_button_relief < 0
+ ? DEFAULT_TOOL_BAR_BUTTON_RELIEF
+ : min (tool_bar_button_relief, 1000000));
raised_p = s->hl == DRAW_IMAGE_RAISED;
}
else
@@ -3232,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)
@@ -9166,6 +9169,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
/* If we decide we want to generate an event to be seen
by the rest of Emacs, we put it here. */
+ Lisp_Object tab_bar_arg = Qnil;
bool tab_bar_p = false;
bool tool_bar_p = false;
@@ -9214,8 +9218,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
window = window_from_coordinates (f, x, y, 0, true, true);
tab_bar_p = EQ (window, f->tab_bar_window);
- if (tab_bar_p && event->xbutton.button < 4)
- handle_tab_bar_click
+ if (tab_bar_p)
+ tab_bar_arg = handle_tab_bar_click
(f, x, y, event->xbutton.type == ButtonPress,
x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
}
@@ -9239,7 +9243,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif /* !USE_GTK */
- if (!tab_bar_p && !tool_bar_p)
+ if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p)
#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
if (! popup_activated ())
#endif
@@ -9257,6 +9261,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
else
x_construct_mouse_click (&inev.ie, &event->xbutton, f);
+
+ if (!NILP (tab_bar_arg))
+ inev.ie.arg = tab_bar_arg;
}
if (FRAME_X_EMBEDDED_P (f))
xembed_send_message (f, event->xbutton.time,
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 80003c264a..2832dd0246 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -536,6 +536,65 @@
(let ((_a 1)
(_b 2))
'z)
+
+ ;; Check empty-list optimisations.
+ (mapcar (lambda (x) (member x nil)) '("a" 2 nil))
+ (mapcar (lambda (x) (memql x nil)) '(a 2 nil))
+ (mapcar (lambda (x) (memq x nil)) '(a nil))
+ (let ((n 0))
+ (list (mapcar (lambda (x) (member (setq n (1+ n)) nil)) '(a "nil"))
+ n))
+ (mapcar (lambda (x) (assoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (assq x nil)) '(a nil))
+ (mapcar (lambda (x) (rassoc x nil)) '("a" nil))
+ (mapcar (lambda (x) (rassq x nil)) '(a nil))
+ (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.")
diff --git a/test/lisp/net/browse-url-tests.el
b/test/lisp/net/browse-url-tests.el
index 898bef8513..4264e03d91 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -68,11 +68,11 @@
(ert-deftest browse-url-tests-encode-url ()
(should (equal (browse-url-encode-url "") ""))
- (should (equal (browse-url-encode-url "a b c") "a b c"))
+ (should (equal (browse-url-encode-url "a b c") "a%20b%20c"))
(should (equal (browse-url-encode-url "\"a\" \"b\"")
- "\"a%22\"b\""))
- (should (equal (browse-url-encode-url "(a) (b)") "(a%29(b)"))
- (should (equal (browse-url-encode-url "a$ b$") "a%24b$")))
+ "%22a%22%20%22b%22"))
+ (should (equal (browse-url-encode-url "(a) (b)") "%28a%29%20%28b%29"))
+ (should (equal (browse-url-encode-url "a$ b$") "a%24%20b%24")))
(ert-deftest browse-url-tests-url-at-point ()
(with-temp-buffer
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 27b37d4f19..af4f45d691 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2772,21 +2772,31 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(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)))
+ (tmp-name2 (expand-file-name "foo/bar" tmp-name1))
+ (unusual-file-mode-1 #o740)
+ (unusual-file-mode-2 #o710))
(unwind-protect
(progn
- (make-directory tmp-name1)
+ (with-file-modes unusual-file-mode-1
+ (make-directory tmp-name1))
(should-error
(make-directory tmp-name1)
:type 'file-already-exists)
(should (file-directory-p tmp-name1))
(should (file-accessible-directory-p 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)
- (make-directory tmp-name2 'parents)
+ (with-file-modes unusual-file-mode-2
+ (make-directory tmp-name2 'parents))
(should (file-directory-p tmp-name2))
(should (file-accessible-directory-p 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))
@@ -3590,14 +3600,7 @@ They might differ only in time attributes or directory
size."
"Check `file-modes'.
This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(skip-unless (tramp--test-enabled))
- (skip-unless
- (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
- ;; Not all tramp-gvfs.el methods support changing the file mode.
- (and
- (tramp--test-gvfs-p)
- (string-match-p
- "ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
-
+ (skip-unless (tramp--test-supports-file-modes-p))
(dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted)))
@@ -4281,12 +4284,8 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
;; for completion. We must refill the cache.
(tramp-set-connection-property tramp-test-vec "property" nil)
- (let ;; This is needed for the `simplified' syntax.
- ((method-marker
- (if (zerop (length tramp-method-regexp))
- "" tramp-default-method-marker))
- ;; This is needed for the `separate' syntax.
- (prefix-format (substring tramp-prefix-format 1))
+ (let ;; This is needed for the `separate' syntax.
+ ((prefix-format (substring tramp-prefix-format 1))
;; This is needed for the IPv6 host name syntax.
(ipv6-prefix
(and (string-match-p tramp-ipv6-regexp host)
@@ -4302,22 +4301,6 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(concat prefix-format method tramp-postfix-method-format)
(file-name-all-completions
(concat prefix-format (substring method 0 1)) "/"))))
- ;; Complete host name for default method. With gvfs
- ;; based methods, host name will be determined as
- ;; host.local, so we omit the test.
- (let ((tramp-default-method (or method tramp-default-method)))
- (unless (or (zerop (length host))
- (tramp--test-gvfs-p tramp-default-method))
- (should
- (member
- (concat
- prefix-format method-marker tramp-postfix-method-format
- ipv6-prefix host ipv6-postfix tramp-postfix-host-format)
- (file-name-all-completions
- (concat
- prefix-format method-marker tramp-postfix-method-format
- ipv6-prefix (substring host 0 1))
- "/")))))
;; Complete host name.
(unless (or (zerop (length method))
(zerop (length tramp-method-regexp))
@@ -6192,6 +6175,17 @@ This requires restrictions of file name syntax."
This requires restrictions of file name syntax."
(tramp-smb-file-name-p tramp-test-temporary-file-directory))
+(defun tramp--test-supports-file-modes-p ()
+ "Return whether the method under test supports file modes."
+ ;; "smb" does not unless the SMB server supports "posix" extensions.
+ ;; "adb" does not unless the Android device is rooted.
+ (or (tramp--test-sh-p) (tramp--test-sshfs-p) (tramp--test-sudoedit-p)
+ ;; Not all tramp-gvfs.el methods support changing the file mode.
+ (and
+ (tramp--test-gvfs-p)
+ (string-match-p
+ "ftp" (file-remote-p tramp-test-temporary-file-directory 'method)))))
+
(defun tramp--test-check-files (&rest files)
"Run a simple but comprehensive test over every file in FILES."
;; `filename-non-special' has been fixed in Emacs 27.1, see Bug#29579.
@@ -6755,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))
@@ -6795,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.
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 5f3ba4d016..54012c3918 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -295,23 +295,23 @@ the whole string."
(and (string-match regexp string)
(string= (match-string 0 string) string))))))
-(ert-deftest cperl-test-ws-regexp ()
+(ert-deftest cperl-test-ws-rx ()
"Tests capture of very simple regular expressions (yawn)."
(let ((valid
'(" " "\t" "\n"))
(invalid
'("a" " " "")))
- (cperl-test--validate-regexp cperl--ws-regexp
+ (cperl-test--validate-regexp (rx (eval cperl--ws-rx))
valid invalid)))
-(ert-deftest cperl-test-ws-or-comment-regexp ()
+(ert-deftest cperl-test-ws+-rx ()
"Tests sequences of whitespace and comment lines."
(let ((valid
`(" " "\t#\n" "\n# \n"
,(concat "# comment\n" "# comment\n" "\n" "#comment\n")))
(invalid
'("=head1 NAME\n" )))
- (cperl-test--validate-regexp cperl--ws-or-comment-regexp
+ (cperl-test--validate-regexp (rx (eval cperl--ws+-rx))
valid invalid)))
(ert-deftest cperl-test-version-regexp ()
@@ -343,7 +343,7 @@ Also includes valid cases with whitespace in strange
places."
"packageFoo" ; not a package declaration
"package Foo1.1" ; invalid package name
"class O3D::Sphere"))) ; class not yet supported
- (cperl-test--validate-regexp cperl--package-regexp
+ (cperl-test--validate-regexp (rx (eval cperl--package-rx))
valid invalid)))
;;; Function test: Building an index for imenu
diff --git a/test/lisp/progmodes/elisp-mode-tests.el
b/test/lisp/progmodes/elisp-mode-tests.el
index f47d54e59c..2745aff670 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -604,6 +604,12 @@ to (xref-elisp-test-descr-to-target xref)."
'xref-location-marker nil '(xref-etags-location))
'cl-defmethod
(expand-file-name "../../../lisp/progmodes/etags.el"
emacs-test-dir)))
+ (xref-make "(cl-defmethod xref-location-marker ((l
xref-etags-apropos-location)))"
+ (xref-make-elisp-location
+ (cl--generic-load-hist-format
+ 'xref-location-marker nil '(xref-etags-apropos-location))
+ 'cl-defmethod
+ (expand-file-name "../../../lisp/progmodes/etags.el"
emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-eval
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 8bdfdc310f..2168b38484 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -357,7 +357,7 @@ VALUES-PLIST is a list with alternating index and value
elements."
(let ((ruby-align-chained-calls t))
(ruby-should-indent-buffer
"one.two.three
- | .four
+ | .four
|
|my_array.select { |str| str.size > 5 }
| .map { |str| str.downcase }"
@@ -908,6 +908,33 @@ VALUES-PLIST is a list with alternating index and value
elements."
(should (equal (buffer-string) orig))))
(kill-buffer buf))))
+(ert-deftest ruby--test-chained-indentation ()
+ (with-temp-buffer
+ (ruby-mode)
+ (setq-local ruby-align-chained-calls t)
+ (insert "some_variable.where
+.not(x: nil)
+.where(y: 2)
+")
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "some_variable.where
+ .not(x: nil)
+ .where(y: 2)
+")))
+
+ (with-temp-buffer
+ (ruby-mode)
+ (setq-local ruby-align-chained-calls t)
+ (insert "some_variable.where.not(x: nil)
+.where(y: 2)
+")
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string)
+ "some_variable.where.not(x: nil)
+ .where(y: 2)
+"))))
+
(provide 'ruby-mode-tests)
;;; ruby-mode-tests.el ends here
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 4169a96670..aa401a2391 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -616,9 +616,17 @@ This checks also `vc-backend' and
`vc-responsible-backend'."
(setq tempdir (make-temp-file "vc-test--version-diff" t)
process-environment (cons (format "BZR_HOME=%s" tempdir)
process-environment)))
+ ;; git tries various approaches to guess a user name and email,
+ ;; which can fail depending on how the system is configured.
+ ;; Eg if the user account has no GECOS, git commit can fail with
+ ;; status 128 "fatal: empty ident name".
(when (memq backend '(Bzr Git))
(setq process-environment (cons "EMAIL=john@doe.ee"
process-environment)))
+ (if (eq backend 'Git)
+ (setq process-environment (append '("GIT_AUTHOR_NAME=A"
+ "GIT_COMMITTER_NAME=C")
+ process-environment)))
(unwind-protect
(progn
;; Cleanup.
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index a4d858113e..646c7bb270 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -324,7 +324,9 @@ local reference."
(mod-test-sum a b)
-Return A + B"
+Return A + B
+
+"
module-file-suffix))))))
(ert-deftest module/load-history ()
- scratch/etags-regen updated (c409977cc2 -> d4875e1235), Dmitry Gutov, 2022/07/11
- scratch/etags-regen d680a23e57 1/6: Merge branch 'master' into scratch/etags-regen,
Dmitry Gutov <=
- scratch/etags-regen 535c262606 2/6: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2022/07/11
- scratch/etags-regen ad50128a36 3/6: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2022/07/11
- scratch/etags-regen ebcba77d4c 4/6: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2022/07/11
- scratch/etags-regen 9c00d6c3f6 5/6: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2022/07/11
- scratch/etags-regen d4875e1235 6/6: Merge branch 'master' into scratch/etags-regen, Dmitry Gutov, 2022/07/11