mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into feature/android

Browse source
This commit is contained in:
Po Lu 2023-04-16 08:16:07 +08:00
commit fe9e48a16a
49 changed files with 115919 additions and 766 deletions
Download patch file Download diff file Expand all files Collapse all files

2
CONTRIBUTE
View file

@ -321,7 +321,7 @@ them right the first time, so here are guidelines for formatting them:
** Committing your changes. ** Committing your changes.
When you commit changes, Git invokes several scripts that test the When you commit changes, Git invokes several scripts that test the
commit for validity, and may abort the commit of some of the tests commit for validity, and may abort the commit if some of the tests
fail. These scripts live in the '.git/hooks/' subdirectory of the fail. These scripts live in the '.git/hooks/' subdirectory of the
top-level directory of the repository, and they perform the following top-level directory of the repository, and they perform the following
tests: tests:

114348
ChangeLog.4 Normal file
View file

File diff suppressed because it is too large Load diff

32
admin/make-tarball.txt
View file

@ -68,16 +68,25 @@ General steps (for each step, check for possible errors):
PREFERRED_BRANCH = emacs-NN PREFERRED_BRANCH = emacs-NN
where NN is the version on the release branch from which you are where NN is the version on the release branch from which you are
producing the tarball. If NN is incorrect, update Makefile.in and producing the tarball. If NN is incorrect (which it usually is
re-run 'configure' to update Makefile. when starting a pretest of a new major release), update
Makefile.in and re-run 'configure' to update Makefile.
If the versioned ChangeLog.N file is too large, start a new one For the first pretest of a new major release, consider starting a
by bumping N, and also update the line in top-level Makefile.in new top-level ChangeLog.N file if the last versioned ChangeLog.N
which says file is too large. A good point to start a new ChangeLog.N file
is when the last one gets larger than 1.5 MiB. If so, start a new
one by bumping N, and also update the line in top-level
Makefile.in which says
CHANGELOG_HISTORY_INDEX_MAX = N CHANGELOG_HISTORY_INDEX_MAX = N
by incrementing the value of N by 1; then regenerate Makefile. by incrementing the value of N by 1; then regenerate Makefile.
After bumping N, you need to actually create and commit
ChangeLog.N with the updated N, otherwise "M-x authors" below will
fail. The easiest way of creating the new ChangeLog.N is to
rename the file ChangeLog (without the .N suffix) left over from
the last major release (it is usually unversioned) and commit it.
Now: Now:
@ -99,11 +108,12 @@ General steps (for each step, check for possible errors):
the relevant entry. If a file was deleted or renamed, consider the relevant entry. If a file was deleted or renamed, consider
adding an appropriate entry to variables authors-ignored-files, adding an appropriate entry to variables authors-ignored-files,
authors-valid-file-names, or authors-renamed-files-alist in authors-valid-file-names, or authors-renamed-files-alist in
authors.el. authors.el. If some authors are "ignored", consider adding
entries to the author-aliases variable.
If necessary, repeat 'C-u M-x authors' after making those changes. If necessary, repeat 'C-u M-x authors' after making those changes.
Save the "*Authors*" buffer as etc/AUTHORS. Save the "*Authors*" buffer as etc/AUTHORS.
Check the diff looks reasonable. Maybe add entries to Check the diff looks reasonable. Maybe add more entries to
authors-ambiguous-files or authors-aliases, and repeat. authors-ambiguous-files or authors-aliases, and repeat.
Commit any fixes to authors.el. Commit any fixes to authors.el.
@ -169,7 +179,13 @@ General steps (for each step, check for possible errors):
messages from TeX, but those seem to be harmless, as the result messages from TeX, but those seem to be harmless, as the result
looks just fine.) looks just fine.)
5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el. 5. Copy lisp/loaddefs.el to lisp/ldefs-boot.el. After copying, edit
ldefs-boot.el to add
;; no-byte-compile: t
to its file-local variables section, otherwise make-dist will
complain.
Commit ChangeLog.N, etc/AUTHORS, lisp/ldefs-boot.el, and the files Commit ChangeLog.N, etc/AUTHORS, lisp/ldefs-boot.el, and the files
changed by M-x set-version. Note that the set-version changes changed by M-x set-version. Note that the set-version changes

3
configure.ac
View file

@ -2249,7 +2249,8 @@ case "$opsys" in
## Motif needs -lgen. ## Motif needs -lgen.
unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;;
haiku) LIBS_SYSTEM="-lnetwork" ;; # Haiku needs -lbsd for cfsetspeed.
haiku) LIBS_SYSTEM="-lnetwork -lbsd" ;;
esac esac
AC_SUBST([LIBS_SYSTEM]) AC_SUBST([LIBS_SYSTEM])

93
doc/emacs/files.texi
View file

@ -2289,10 +2289,15 @@ behavior by using the options @code{image-auto-resize} and
@code{image-auto-resize-on-window-resize}. @code{image-auto-resize-on-window-resize}.
@findex image-transform-fit-to-window @findex image-transform-fit-to-window
@kindex s w (Image mode)
@findex image-transform-set-percent @findex image-transform-set-percent
@kindex s p (Image mode)
@findex image-transform-set-scale @findex image-transform-set-scale
@kindex s s (Image mode)
@findex image-transform-reset-to-initial @findex image-transform-reset-to-initial
@kindex s 0 (Image mode)
@findex image-transform-reset-to-original @findex image-transform-reset-to-original
@kindex s o (Image mode)
To resize the image manually you can use the command To resize the image manually you can use the command
@code{image-transform-fit-to-window} bound to @kbd{s w} that fits the @code{image-transform-fit-to-window} bound to @kbd{s w} that fits the
image to both the window height and width. To scale the image to a image to both the window height and width. To scale the image to a
@ -2353,6 +2358,94 @@ frames at once. You can go to a specific frame with @kbd{F}
(@code{image-reverse-speed}) reverses it. The command @kbd{a 0} (@code{image-reverse-speed}) reverses it. The command @kbd{a 0}
(@code{image-reset-speed}) resets the speed to the original value. (@code{image-reset-speed}) resets the speed to the original value.
In addition to the above key bindings, which are specific to Image
mode, images shown in any Emacs buffer have special key bindings when
point is at or inside the image:
@table @kbd
@cindex resize images
@cindex image resize
@findex image-increase-size
@kindex i + (Image mode)
@item i +
Increase the image size (@code{image-increase-size}) by 20%. Prefix
numeric argument controls the increment; the value of @var{n} means to
multiply the size by the factor of @w{@code{1 + @var{n} / 10}}, so
@w{@kbd{C-u 5 i +}} means to increase the size by 50%.
@findex image-decrease-size
@kindex i - (Image mode)
@item i -
Decrease the image size (@code{image-increase-size}) by 20%. Prefix
numeric argument controls the decrement; the value of @var{n} means to
multiply the size by the factor of @w{@code{1 - @var{n} / 10}}, so
@w{@kbd{C-u 3 i -}} means to decrease the size by 30%.
@cindex rotating images
@cindex image rotation
@findex image-rotate
@kindex i r (Image mode)
@item i r
Rotate the image by 90 degrees clockwise (@code{image-rotate}).
With the prefix argument, rotate by 90 degrees counter-clockwise instead.
Note that this command is not available for sliced images.
@findex image-flip-horizontally
@kindex i h (Image mode)
@item i h
Flip the image horizontally (@code{image-flip-horizontally}). This
presents the image as if reflected in a vertical mirror.
Note that this command is not available for sliced images.
@findex image-flip-vertically
@kindex i v (Image mode)
@item i v
Flip the image vertically (@code{image-flip-vertically}). This
presents the image as if reflected in a horizontal mirror.
Note that this command is not available for sliced images.
@findex image-save
@kindex i o (Image mode)
@item i o
Save the image to a file (@code{image-save}). This command prompts
you for the name of the file to save the image.
@cindex cropping images
@vindex image-crop-crop-command
@findex image-crop
@kindex i c (Image mode)
@item i c
Crop the image (@code{image-crop}). This command is available only if
your system has an external program installed that can be used for
cropping and cutting of images; the user option
@code{image-crop-crop-command} determines what program to use, and
defaults to the ImageMagick's @command{convert} program. The command
displays the image with a rectangular frame superimposed on it, and
lets you use the mouse to move and resize the frame. Type @kbd{m} to
cause mouse movements to move the frame instead of resizing it; type
@kbd{s} to move a square frame instead. When you are satisfied with
the position and size of the cropping frame, type @kbd{@key{RET}} to
actually crop the part under the frame; or type @kbd{q} to exit
without cropping. You can then save the cropped image using @w{@kbd{i
o}} or @w{@kbd{M-x image-save}}.
@findex image-cut
@kindex i x (Image mode)
@vindex image-cut-color
@vindex image-crop-cut-command
@item i x
Cut a rectangle from the image (@code{image-cut}). This works the
same as @code{image-crop} (and also requires an external program,
defined by the variable @code{image-crop-cut-command}, to perform the
image cut), but instead of cropping the image, it removes the part
inside the frame and fills that part with the color specified by
@code{image-cut-color}. With prefix argument, the command prompts for
the color to use.
@end table
The size and rotation commands are ``repeating'', which means that you
can continue adjusting the image without using the @kbd{i} prefix.
@cindex ImageMagick support @cindex ImageMagick support
@vindex imagemagick-enabled-types @vindex imagemagick-enabled-types
@vindex imagemagick-types-inhibit @vindex imagemagick-types-inhibit

77
doc/emacs/package.texi
View file

@ -578,3 +578,80 @@ from the package directory (@pxref{Package Files}) to your checkout
and initializes the code. Note that you might have to use and initializes the code. Note that you might have to use
@code{package-vc-refresh} to repeat the initialization and update the @code{package-vc-refresh} to repeat the initialization and update the
autoloads. autoloads.
@subsection Specifying Package Sources
@cindex package specification
@cindex specification, for source packages
To install a package from source, Emacs must know where to get the
package's source code (such as a code repository) and basic
information about the structure of the code (such as the main file in
a multi-file package). A @dfn{package specification} describes these
properties.
When supported by a package archive (@pxref{Package
Archives,,,elisp, The Emacs Lisp Reference Manual}), Emacs can
automatically download a package's specification from said archive.
If the first argument passed to @code{package-vc-install} is a symbol
naming a package, then Emacs will use the specification provided by
the archive for that package.
@example
@group
;; Emacs will download BBDB's specification from GNU ELPA:
(package-vc-install 'bbdb)
@end group
@end example
The first argument to @code{package-vc-install} may also be a
package specification. This allows you to install source packages
from locations other than the known archives listed in the user option
@code{package-archives}. A package specification is a list of the
form @code{(@var{name} . @var{spec})}, in which @var{spec} should be a
property list using any of the keys in the table below.
For definitions of basic terms for working with code repositories and
version control systems, see @ref{VCS Concepts,,,emacs, The GNU Emacs
Manual}.
@table @code
@item :url
A string providing the URL that specifies the repository from which to
fetch the package's source code.
@item :branch
A string providing the revision of the code to install. Do not
confuse this with a package's version number.
@item :lisp-dir
A string providing the repository-relative name of the directory to
use for loading the Lisp sources, which defaults to the root directory
of the repository.
@item :main-file
A string providing the main file of the project, from which to gather
package metadata. If not given, the default is the package name with
".el" appended to it.
@item :doc
A string providing the repository-relative name of the documentation
file from which to build an Info file. This can be a Texinfo file or
an Org file.
@item :vc-backend
A symbol naming the VC backend to use for downloading a copy of the
package's repository (@pxref{Version Control Systems,,,emacs, The GNU
Emacs Manual}). If omitted, Emacs will attempt to make a guess based
on the provided URL, or, failing that, the process will fall back onto
the value of @code{package-vc-default-backend}.
@end table
@example
@group
;; Specifying information manually:
(package-vc-install
'(bbdb :url "https://git.savannah.nongnu.org/git/bbdb.git"
:lisp-dir "lisp"
:doc "doc/bbdb.texi"))
@end group
@end example

24
doc/lispref/buffers.texi
View file

@ -959,9 +959,9 @@ infinite recursion.
@defun buffer-match-p condition buffer-or-name &optional arg @defun buffer-match-p condition buffer-or-name &optional arg
This function checks if a buffer designated by @code{buffer-or-name} This function checks if a buffer designated by @code{buffer-or-name}
satisfies a @code{condition}. Optional third argument @var{arg} is satisfies the specified @code{condition}. Optional third argument
passed to the predicate function in @var{condition}. A condition can @var{arg} is passed to the predicate function in @var{condition}. A
be one of the following: valid @var{condition} can be one of the following:
@itemize @bullet{} @itemize @bullet{}
@item @item
A string, interpreted as a regular expression. The buffer A string, interpreted as a regular expression. The buffer
@ -990,21 +990,23 @@ Satisfied if @emph{all} the conditions in @var{conds} satisfy
Satisfied if the buffer's major mode derives from @var{expr}. Satisfied if the buffer's major mode derives from @var{expr}.
@item major-mode @item major-mode
Satisfied if the buffer's major mode is equal to @var{expr}. Prefer Satisfied if the buffer's major mode is equal to @var{expr}. Prefer
using @code{derived-mode} instead when both can work. using @code{derived-mode} instead, when both can work.
@end table @end table
@item t @item t
Satisfied by any buffer. A convenient alternative to @code{""} (empty Satisfied by any buffer. A convenient alternative to @code{""} (empty
string), @code{(and)} (empty conjunction) or @code{always}. string) or @code{(and)} (empty conjunction).
@end itemize @end itemize
@end defun @end defun
@defun match-buffers condition &optional buffer-list arg @defun match-buffers condition &optional buffer-list arg
This function returns a list of all buffers that satisfy a This function returns a list of all buffers that satisfy the
@code{condition}, as defined for @code{buffer-match-p}. By default @code{condition}. If no buffers match, the function returns
all buffers are considered, but this can be restricted via the second @code{nil}. The argument @var{condition} is as defined in
optional @code{buffer-list} argument. Optional third argument @code{buffer-match-p} above. By default, all the buffers are
@var{arg} will be used by @var{condition} in the same way as considered, but this can be restricted via the optional argument
@code{buffer-match-p} does. @code{buffer-list}, which should be a list of buffers to consider.
Optional third argument @var{arg} will be passed to @var{condition} in
the same way as @code{buffer-match-p} does.
@end defun @end defun
@node Creating Buffers @node Creating Buffers

30
doc/lispref/display.texi
View file

@ -6877,7 +6877,7 @@ This function puts image @var{image} in front of @var{pos} in the
current buffer. The argument @var{pos} should be an integer or a current buffer. The argument @var{pos} should be an integer or a
marker. It specifies the buffer position where the image should appear. marker. It specifies the buffer position where the image should appear.
The argument @var{string} specifies the text that should hold the image The argument @var{string} specifies the text that should hold the image
as an alternative to the default. as an alternative to the default @samp{x}.
The argument @var{image} must be an image descriptor, perhaps returned The argument @var{image} must be an image descriptor, perhaps returned
by @code{create-image} or stored by @code{defimage}. by @code{create-image} or stored by @code{defimage}.
@ -6890,7 +6890,7 @@ buffer's text.
Internally, this function creates an overlay, and gives it a Internally, this function creates an overlay, and gives it a
@code{before-string} property containing text that has a @code{display} @code{before-string} property containing text that has a @code{display}
property whose value is the image. (Whew!) property whose value is the image. (Whew! that was a mouthful@dots{})
@end defun @end defun
@defun remove-images start end &optional buffer @defun remove-images start end &optional buffer
@ -6937,41 +6937,47 @@ This function returns @code{t} if point is on an image, and @code{nil}
otherwise. otherwise.
@end defun @end defun
@cindex operations on images
Images inserted with the insertion functions above also get a local Images inserted with the insertion functions above also get a local
keymap installed in the text properties (or overlays) that span the keymap installed in the text properties (or overlays) that span the
displayed image. This keymap defines the following commands: displayed image. This keymap defines the following commands:
@table @kbd @table @kbd
@findex image-increase-size
@item i + @item i +
Increase the image size (@code{image-increase-size}). A prefix value Increase the image size (@code{image-increase-size})
of @samp{4} means to increase the size by 40%. The default is 20%.
@findex image-decrease-size
@item i - @item i -
Decrease the image size (@code{image-increase-size}). A prefix value Decrease the image size (@code{image-decrease-size}).
of @samp{4} means to decrease the size by 40%. The default is 20%.
@findex image-rotate
@item i r @item i r
Rotate the image by 90 degrees clockwise (@code{image-rotate}). Rotate the image (@code{image-rotate}).
A prefix means to rotate by 90 degrees counter-clockwise instead.
@findex image-flip-horizontally
@item i h @item i h
Flip the image horizontally (@code{image-flip-horizontally}). Flip the image horizontally (@code{image-flip-horizontally}).
@findex image-flip-vertically
@item i v @item i v
Flip the image vertically (@code{image-flip-vertically}). Flip the image vertically (@code{image-flip-vertically}).
@findex image-save
@item i o @item i o
Save the image to a file (@code{image-save}). Save the image to a file (@code{image-save}).
@findex image-crop
@item i c @item i c
Crop the image interactively (@code{image-crop}). Interactively crop the image (@code{image-crop}).
@findex image-cut
@item i x @item i x
Cut a rectangle from the image interactively (@code{image-cut}). Interactively cut a rectangle from the image (@code{image-cut}).
@end table @end table
The size and rotation commands are ``repeating'', which means that you @xref{Image Mode,,, emacs, The GNU Emacs Manual}, for more details
can continue adjusting the image without using the @kbd{i} prefix. about these image-specific key bindings.
@node Multi-Frame Images @node Multi-Frame Images
@subsection Multi-Frame Images @subsection Multi-Frame Images

88
doc/lispref/frames.texi
View file

@ -4675,7 +4675,7 @@ has the same meaning as the @var{action} argument to
Emacs implements receiving text and URLs individually for each Emacs implements receiving text and URLs individually for each
window system, and does not by default support receiving other kinds window system, and does not by default support receiving other kinds
of data as drops. To support receiving other kinds of data, use the of data as drops. To support receiving other kinds of data, use the
X-specific interface described below: X-specific interface described below.
@vindex x-dnd-test-function @vindex x-dnd-test-function
@vindex x-dnd-known-types @vindex x-dnd-known-types
@ -4704,29 +4704,71 @@ depending on the specific drag-and-drop protocol being used. For
example, the data type used for plain text may be either example, the data type used for plain text may be either
@code{"STRING"} or @code{"text/plain"}. @code{"STRING"} or @code{"text/plain"}.
@cindex XDS
@cindex direct save protocol
@vindex x-dnd-direct-save-function @vindex x-dnd-direct-save-function
@c FIXME: This description is overly-complicated and confusing. In When Emacs runs on X window system, it supports the X Direct Save
@c particular, the two calls to the function basically sound (@acronym{XDS}) protocol, which allows users to save a file by
@c identical, so it is unclear how should the function distinguish dragging and dropping it onto an Emacs window, such as a Dired window.
@c between the first and the second one. The description of who asks To comply with the unique requirements of @acronym{XDS}, these
@c whom to do what is also very hard to understand. Needs rewording, drag-and-drop requests are processed specially: instead of being
@c and needs shorter sentences. Perhaps examples could help. handled according to @code{x-dnd-types-alist}, they are handled by the
However, @code{x-dnd-types-alist} does not handle a special kind of @dfn{direct-save function} that is the value of the variable
drop sent by a program that wants Emacs to tell it where to save a @code{x-dnd-direct-save-function}. The value should be a function of
file in a specific location determined by the user. These drops are two arguments, @var{need-name} and @var{filename}. The @acronym{XDS}
instead handled by a function that is the value of the variable protocol uses a two-step procedure for dragging files:
@code{x-dnd-direct-save-function}. This function should accept two arguments.
If the first argument is non-@code{nil}, then the second argument is a @enumerate 1
file name to save (with leading directories) that the other @item
program recommends, and the The application from which the file is dragged asks Emacs to provide
function should return the full file name under which it should be the full file name under which to save the file. For this purpose,
saved. After the function completes, Emacs will ask the other program the direct-save function is called with its first argument
to save the file under the name that was returned, and if the file was @var{need-name} non-@code{nil}, and the second argument @var{filename}
successfully saved, call the function again with the first argument set to the basename of the file to be saved. It should return the
set to a non-@code{nil} value and the second argument set to the file fully-expanded absolute file name under which to save the file. For
name that was returned. The function should then perform whatever example, if a file is dragged to a Dired window, the natural directory
action is appropriate (i.e., opening the file or refreshing a for the file is the directory of the file shown at location of the
directory listing.) drop. If saving the file is not possible for some reason, the
function should return @code{nil}, which will cancel the drag-and-drop
operation.
@item
The application from which the file is dragged saves the file under
the name returned by the first call to the direct-save function. If
it succeeds in saving the file, the direct-save function is called
again, this time with the first argument @var{need-name} set to
@code{nil} and the second argument @var{filename} set to the full
absolute name of the saved file. The function is then expected to do
whatever is needed given the fact that file was saved. For example,
Dired should update the directory on display by showing the new file
there.
@end enumerate
The default value of @code{x-dnd-direct-save-function} is
@code{x-dnd-save-direct}.
@defun x-dnd-save-direct need-name filename
When called with the @var{need-name} argument non-@code{nil}, this
function prompts the user for the absolute file name under which it
should be saved. If the specified file already exists, it
additionally asks the user whether to overwrite it, and returns the
absolute file name only if the user confirms the overwriting.
When called with the @var{need-name} argument @code{nil}, it reverts
the Dired listing if the current buffer is in Dired mode or one of its
descendants, and otherwise visits the file by calling @code{find-file}
(@pxref{Visiting Functions}).
@end defun
@defun x-dnd-save-direct-immediately need-name filename
This function works like @code{x-dnd-save-direct}, but when called
with its @var{need-name} argument non-@code{nil}, it doesn't prompt
the user for the full name of the file to be saved; instead, it
returns its argument @var{filename} expanded against the current
buffer's default directory (@pxref{File Name Expansion}). (It still
asks for confirmation if a file by that name already exists in the
default directory.)
@end defun
@cindex initiating drag-and-drop @cindex initiating drag-and-drop
On capable window systems, Emacs also supports dragging contents On capable window systems, Emacs also supports dragging contents

2
doc/lispref/windows.texi
View file

@ -3216,7 +3216,7 @@ any window it creates as dedicated to its buffer (@pxref{Dedicated
Windows}). It does that by calling @code{set-window-dedicated-p} with Windows}). It does that by calling @code{set-window-dedicated-p} with
the chosen window as first argument and the entry's value as second. the chosen window as first argument and the entry's value as second.
Side windows are by default dedicated with the value @code{side} Side windows are by default dedicated with the value @code{side}
((@pxref{Side Window Options and Functions}). (@pxref{Side Window Options and Functions}).
@vindex preserve-size@r{, a buffer display action alist entry} @vindex preserve-size@r{, a buffer display action alist entry}
@item preserve-size @item preserve-size

2
doc/misc/calc.texi
View file

@ -5394,7 +5394,7 @@ a variable containing a vector of rules.
1: [merge, secsqr] 1: [a/x + b/x := (a + b)/x, ... ] 1: [merge, secsqr] 1: [a/x + b/x := (a + b)/x, ... ]
. . . .
' [merge,sinsqr] @key{RET} = ' [merge,secsqr] @key{RET} =
@end group @end group
@end smallexample @end smallexample

20
doc/misc/efaq.texi
View file

@ -3133,13 +3133,23 @@ example, you can put the following in your init file:
To avoid the slightly distracting visual effect of Emacs starting with To avoid the slightly distracting visual effect of Emacs starting with
its default frame size and then growing to fullscreen, you can add an its default frame size and then growing to fullscreen, you can add an
@samp{Emacs.Geometry} entry to the Windows registry settings. @samp{Emacs.Geometry} entry to the Windows Registry settings. @xref{X
@xref{X Resources,,, emacs, The GNU Emacs Manual}. Resources,,, emacs, The GNU Emacs Manual}. To compute the correct
values for width and height you use in the Registry settings, first
To compute the correct values for width and height, first maximize the maximize the Emacs frame and then evaluate @code{(frame-height)} and
Emacs frame and then evaluate @code{(frame-height)} and
@code{(frame-width)} with @kbd{M-:}. @code{(frame-width)} with @kbd{M-:}.
Alternatively, you can avoid the visual effect of Emacs changing its
frame size entirely in your init file (i.e., without using the
Registry), like this:
@lisp
(setq frame-resize-pixelwise t)
(set-frame-position nil 0 0)
(set-frame-size nil (display-pixel-width) (display-pixel-height) t)
@end lisp
@node Emacs in a Linux console @node Emacs in a Linux console
@section How can I alleviate the limitations of the Linux console? @section How can I alleviate the limitations of the Linux console?
@cindex Console, Linux console, TTY, fbterm @cindex Console, Linux console, TTY, fbterm

23
doc/misc/gnus.texi
View file

@ -10528,9 +10528,9 @@ article (@code{gnus-summary-refer-references}).
@kindex A T @r{(Summary)} @kindex A T @r{(Summary)}
Display the full thread where the current article appears Display the full thread where the current article appears
(@code{gnus-summary-refer-thread}). By default this command looks for (@code{gnus-summary-refer-thread}). By default this command looks for
articles only in the current group. Some backends (currently only articles only in the current group. If the group belongs to a backend
@code{nnimap}) know how to find articles in the thread directly. In that has an associated search engine, articles are found by searching.
other cases each header in the current group must be fetched and In other cases each header in the current group must be fetched and
examined, so it usually takes a while. If you do it often, you may examined, so it usually takes a while. If you do it often, you may
consider setting @code{gnus-fetch-old-headers} to @code{invisible} consider setting @code{gnus-fetch-old-headers} to @code{invisible}
(@pxref{Filling In Threads}). This won't have any visible effects (@pxref{Filling In Threads}). This won't have any visible effects
@ -10538,19 +10538,22 @@ normally, but it'll make this command work a whole lot faster. Of
course, it'll make group entry somewhat slow. course, it'll make group entry somewhat slow.
@vindex gnus-refer-thread-use-search @vindex gnus-refer-thread-use-search
If @code{gnus-refer-thread-use-search} is non-@code{nil} then those backends If @code{gnus-refer-thread-use-search} is @code{nil} (the default)
that know how to find threads directly will search not just in the then thread-referral only looks for articles in the current group. If
current group but all groups on the same server. this variable is @code{t} the server to which the current group
belongs is searched (provided that searching is available for the
server's backend). If this variable is a list of servers, each server
in the list is searched.
@vindex gnus-refer-thread-limit @vindex gnus-refer-thread-limit
The @code{gnus-refer-thread-limit} variable says how many old (i.e., The @code{gnus-refer-thread-limit} variable says how many old (i.e.,
articles before the first displayed in the current group) headers to articles before the first displayed in the current group) headers to
fetch when doing this command. The default is 200. If @code{t}, all fetch when referring a thread. The default is 500. If @code{t}, all
the available headers will be fetched. This variable can be overridden the available headers will be fetched. This variable can be
by giving the @kbd{A T} command a numerical prefix. overridden by giving the @kbd{A T} command a numerical prefix.
@vindex gnus-refer-thread-limit-to-thread @vindex gnus-refer-thread-limit-to-thread
In most cases @code{gnus-refer-thread} adds any articles it finds to @code{gnus-summary-refer-thread} tries to add any articles it finds to
the current summary buffer. (When @code{gnus-refer-thread-use-search} the current summary buffer. (When @code{gnus-refer-thread-use-search}
is true and the initial referral starts from a summary buffer for a is true and the initial referral starts from a summary buffer for a
non-virtual group this may not be possible. In this case a new non-virtual group this may not be possible. In this case a new

37
etc/NEWS.29
View file

@ -222,9 +222,9 @@ In previous Emacs versions, images have had the '+', '-' and 'r' keys
bound when point is over an image. In Emacs 29.1, additional commands bound when point is over an image. In Emacs 29.1, additional commands
were added, and this made it more likely that users would trigger the were added, and this made it more likely that users would trigger the
image commands by mistake. To avoid this, all image commands have image commands by mistake. To avoid this, all image commands have
moved to the 'i' keymap, so '+' is now 'i +', '-' is now 'i -', and moved to the 'i' prefix keymap, so '+' is now 'i +', '-' is now 'i -',
'r' is now 'i r'. In addition, these commands are now repeating, so and 'r' is now 'i r'. In addition, these commands are now repeating,
you can rotate an image twice by saying 'i r r', for instance. so, for example, you can rotate an image twice by typing 'i r r'.
+++ +++
** Emacs now picks the correct coding-system for X input methods. ** Emacs now picks the correct coding-system for X input methods.
@ -1577,6 +1577,11 @@ This input method is based on the russian-computer input method, and
is intended for typing in the Chuvash language written in the Cyrillic is intended for typing in the Chuvash language written in the Cyrillic
script. script.
---
*** New input method 'cyrillic-mongolian'.
This input method is for typing in the Mongolian language using the
Cyrillic script.
* Changes in Specialized Modes and Packages in Emacs 29.1 * Changes in Specialized Modes and Packages in Emacs 29.1
@ -2623,11 +2628,6 @@ This controls whether or not to show a message when opening certain
image formats saying how to edit it as text. The default is to show image formats saying how to edit it as text. The default is to show
this message for SVG and XPM. this message for SVG and XPM.
+++
*** New commands: 'image-flip-horizontally' and 'image-flip-vertically'.
These commands horizontally and vertically flip the image under point,
and are bound to 'i h' and 'i v', respectively.
+++ +++
*** New command 'image-transform-set-percent'. *** New command 'image-transform-set-percent'.
It allows setting the image size to a percentage of its original size, It allows setting the image size to a percentage of its original size,
@ -2643,6 +2643,19 @@ The old name was confusing, and is now an obsolete function alias.
** Images ** Images
+++
** New commands 'image-crop' and 'image-cut'.
These commands allow interactively cropping/cutting the image at
point. The commands are bound to keys 'i c' and 'i x' (respectively)
in the local keymap over images. They rely on external programs, by
default "convert" from ImageMagick, to do the actual cropping/eliding
of the image file.
+++
*** New commands: 'image-flip-horizontally' and 'image-flip-vertically'.
These commands horizontally and vertically flip the image under point,
and are bound to 'i h' and 'i v', respectively.
+++ +++
*** Users can now add special image conversion functions. *** Users can now add special image conversion functions.
This is done via 'image-converter-add-handler'. This is done via 'image-converter-add-handler'.
@ -3238,14 +3251,6 @@ macro, which allows you to isolate package configuration in your init
file in a way that is declarative, tidy, and performance-oriented. file in a way that is declarative, tidy, and performance-oriented.
See the new Info manual "(use-package) Top" for more. See the new Info manual "(use-package) Top" for more.
+++
** New commands 'image-crop' and 'image-cut'.
These commands allow interactively cropping/cutting the image at
point. The commands are bound to keys 'i c' and 'i x' (respectively)
in the local keymap over images. They rely on external programs, by
default "convert" from ImageMagick, to do the actual cropping/eliding
of the image file.
--- ---
** New package 'wallpaper'. ** New package 'wallpaper'.
This package provides the command 'wallpaper-set', which sets the This package provides the command 'wallpaper-set', which sets the

10
lisp/Makefile.in
View file

@ -74,7 +74,7 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \
# Set load-prefer-newer for the benefit of the non-bootstrappers. # Set load-prefer-newer for the benefit of the non-bootstrappers.
BYTE_COMPILE_FLAGS = \ BYTE_COMPILE_FLAGS = \
--eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \ --eval "(setq load-prefer-newer t byte-compile-warnings 'all)" \
$(BYTE_COMPILE_EXTRA_FLAGS) --eval "(setq org--built-in-p t)" $(BYTE_COMPILE_EXTRA_FLAGS)
# ... but we must prefer .elc files for those in the early bootstrap. # ... but we must prefer .elc files for those in the early bootstrap.
compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS) compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS)
@ -543,12 +543,4 @@ $(lisp)/progmodes/cc-styles.elc: $(lisp)/progmodes/cc-vars.elc \
$(lisp)/progmodes/js.elc: $(lisp)/progmodes/cc-defs.elc \ $(lisp)/progmodes/js.elc: $(lisp)/progmodes/cc-defs.elc \
$(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-mode.elc $(lisp)/progmodes/cc-engine.elc $(lisp)/progmodes/cc-mode.elc
# When org-version.el gets updated with a new version, all the Org
# files need to be recompiled, or else the build will fail due to
# version mismatch, prompting the naive users to bootstrap. So we
# make all the Org *.elc files dependent of org-version.el, to trigger
# their recompilation automatically.
$(lisp)/org/org.elc $(filter-out $(lisp)/org/org-version.elc,$(filter-out $(lisp)/org/org.elc,$(wildcard $(lisp)/org/*.elc))): \
$(lisp)/org/org-version.el
# Makefile ends here. # Makefile ends here.

30
lisp/emacs-lisp/package-vc.el
View file

@ -147,32 +147,9 @@ is a symbol designating the package and SPEC is one of:
- nil, if any package version can be installed; - nil, if any package version can be installed;
- a version string, if that specific revision is to be installed; - a version string, if that specific revision is to be installed;
- a property list, describing a package specification. Valid - a property list, describing a package specification. For more
key/value pairs are details, please consult the subsection \"Specifying Package
Sources\" in the Info node `(emacs)Fetching Package Sources'.
`:url' (string)
The URL of the repository used to fetch the package source.
`:branch' (string)
If given, the name of the branch to checkout after cloning the directory.
`:lisp-dir' (string)
The repository-relative name of the directory to use for loading the Lisp
sources. If not given, the value defaults to the root directory
of the repository.
`:main-file' (string)
The main file of the project, relevant to gather package metadata.
If not given, the assumed default is the package name with \".el\"
appended to it.
`:vc-backend' (symbol)
A symbol of the VC backend to use for cloning the package. The
value ought to be a member of `vc-handled-backends'. If omitted,
`vc-clone' will fall back onto the archive default or on
`package-vc-default-backend'.
All other keys are ignored.
This user option will be automatically updated to store package This user option will be automatically updated to store package
specifications for packages that are not specified in any specifications for packages that are not specified in any
@ -186,6 +163,7 @@ archive."
(:branch string) (:branch string)
(:lisp-dir string) (:lisp-dir string)
(:main-file string) (:main-file string)
(:doc string)
(:vc-backend symbol))))) (:vc-backend symbol)))))
:version "29.1") :version "29.1")

4
lisp/find-file.el
View file

@ -167,7 +167,7 @@ To override this, give an argument to `ff-find-other-file'."
:type 'boolean) :type 'boolean)
(defcustom ff-quiet-mode nil (defcustom ff-quiet-mode nil
"If non-nil, trace which directories are being searched." "If non-nil, do not trace which directories are being searched."
:type 'boolean) :type 'boolean)
;;;###autoload ;;;###autoload
@ -351,7 +351,7 @@ Variables of interest include:
If non-nil, always attempt to create the other file if it was not found. If non-nil, always attempt to create the other file if it was not found.
- `ff-quiet-mode' - `ff-quiet-mode'
If non-nil, traces which directories are being searched. If non-nil, does not trace which directories are being searched.
- `ff-special-constructs' - `ff-special-constructs'
A list of regular expressions specifying how to recognize special A list of regular expressions specifying how to recognize special

82
lisp/gnus/gnus-search.el
View file

@ -1066,7 +1066,9 @@ Responsible for handling and, or, and parenthetical expressions.")
_srv query-spec groups) _srv query-spec groups)
(let ((artlist [])) (let ((artlist []))
(dolist (group groups) (dolist (group groups)
(let* ((gnus-newsgroup-selection (nnselect-get-artlist group)) (let* ((gnus-newsgroup-selection
(or
(nnselect-get-artlist group) (nnselect-generate-artlist group)))
(group-spec (group-spec
(nnselect-categorize (nnselect-categorize
(mapcar 'car (mapcar 'car
@ -2174,37 +2176,53 @@ remaining string, then adds all that to the top-level spec."
(declare-function gnus-registry-get-id-key "gnus-registry" (id key)) (declare-function gnus-registry-get-id-key "gnus-registry" (id key))
(defun gnus-search-thread (header) (defun gnus-search-thread (header &optional group server)
"Make an nnselect group based on the thread containing the article "Find articles in the thread containing HEADER from GROUP on SERVER.
header. The current server will be searched. If the registry is If gnus-refer-thread-use-search is nil only the current group is
installed, the server that the registry reports the current checked for articles; if t all groups on the server containing
article came from is also searched." the article's group will be searched; if a list then all servers
(let* ((ids (cons (mail-header-id header) in this list will be searched. If possible the newly found
(split-string articles are added to the summary buffer; otherwise the full
(or (mail-header-references header) thread is displayed in a new ephemeral nnselect buffer."
"")))) (let* ((group (or group gnus-newsgroup-name))
(query (server (or server (gnus-group-server group)))
(list (cons 'query (mapconcat (lambda (i) (query
(format "id:%s" i)) (list
ids " or ")) (cons 'query
(cons 'thread t))) (mapconcat (lambda (i) (format "id:%s" i))
(server (cons (mail-header-id header)
(list (list (gnus-method-to-server (split-string
(gnus-find-method-for-group gnus-newsgroup-name))))) (or (mail-header-references header) "")))
(registry-group (and " or "))
(bound-and-true-p gnus-registry-enabled) (cons 'thread t)))
(car (gnus-registry-get-id-key (gnus-search-use-parsed-queries t))
(mail-header-id header) 'group)))) (if (not gnus-refer-thread-use-search)
(registry-server ;; Search only the current group and send the headers back to
(and registry-group ;; the caller to add to the summary buffer.
(gnus-method-to-server (gnus-fetch-headers
(gnus-find-method-for-group registry-group))))) (sort
(when registry-server (mapcar (lambda (x) (elt x 1))
(cl-pushnew (list registry-server) server :test #'equal)) (gnus-search-run-query
(gnus-group-make-search-group nil (list (list (cons 'search-query-spec query)
(cons 'search-query-spec query) (cons 'search-group-spec
(cons 'search-group-spec server))) (list (list server group))))))
(gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header))))) #'<) nil t)
;; Otherwise create an ephemeral search group. If we return to
;; the current summary buffer after exiting the thread we would
;; end up overwriting any changes we made, so we exit the
;; current summary buffer first.
(gnus-summary-exit)
(gnus-group-read-ephemeral-search-group
nil
(list (cons 'search-query-spec query)
(cons 'search-group-spec
(if (listp gnus-refer-thread-use-search)
gnus-refer-thread-use-search
(list (list server))))))
(if (gnus-id-to-article (mail-header-id header))
(gnus-summary-goto-subject
(gnus-id-to-article (mail-header-id header)))
(message "Thread search failed")))))
(defun gnus-search-get-active (srv) (defun gnus-search-get-active (srv)
(let ((method (gnus-server-to-method srv)) (let ((method (gnus-server-to-method srv))

117
lisp/gnus/gnus-sum.el
View file

@ -80,6 +80,8 @@
(autoload 'nnselect-article-rsv "nnselect" nil nil) (autoload 'nnselect-article-rsv "nnselect" nil nil)
(autoload 'nnselect-article-group "nnselect" nil nil) (autoload 'nnselect-article-group "nnselect" nil nil)
(autoload 'gnus-nnselect-group-p "nnselect" nil nil) (autoload 'gnus-nnselect-group-p "nnselect" nil nil)
(autoload 'gnus-search-thread "gnus-search" nil nil)
(autoload 'gnus-search-server-to-engine "gnus-search" nil nil)
(defcustom gnus-kill-summary-on-exit t (defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it. "If non-nil, kill the summary buffer when you exit from it.
@ -141,12 +143,17 @@ If t, fetch all the available old headers."
'gnus-refer-thread-use-search "28.1") 'gnus-refer-thread-use-search "28.1")
(defcustom gnus-refer-thread-use-search nil (defcustom gnus-refer-thread-use-search nil
"Search an entire server when referring threads. "Specify where to find articles when referring threads.
A nil value will only search for thread-related articles in the A nil value restricts searches for thread-related articles to the
current group." current group; a value of t searches all groups on the server; a
list of servers and groups (where each element is a list whose
car is the server and whose cdr is a list of groups on this
server or nil to search the entire server) searches these
server/groups. This may usefully be set as a group parameter."
:version "28.1" :version "28.1"
:group 'gnus-thread :group 'gnus-thread
:type 'boolean) :type '(restricted-sexp :match-alternatives
(listp 't 'nil)))
(defcustom gnus-refer-thread-limit-to-thread nil (defcustom gnus-refer-thread-limit-to-thread nil
"If non-nil referring a thread will limit the summary buffer to "If non-nil referring a thread will limit the summary buffer to
@ -9009,64 +9016,72 @@ Return the number of articles fetched."
(defun gnus-summary-refer-thread (&optional limit) (defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread. "Fetch all articles in the current thread.
For backends that know how to search for threads (currently only A non-numeric prefix arg will search the entire server; without a
`nnimap') a non-numeric prefix arg will search the entire server; prefix arg only the current group is searched. If the variable
without a prefix arg only the current group is searched. If the `gnus-refer-thread-use-search' is t the prefix arg has the
variable `gnus-refer-thread-use-search' is non-nil the prefix arg reverse meaning. If searching is not enabled for the current
has the reverse meaning. If no backend-specific `request-thread' group, fetch LIMIT (the numerical prefix) old headers. If LIMIT
function is available fetch LIMIT (the numerical prefix) old is non-numeric or nil fetch the number specified by the
headers. If LIMIT is non-numeric or nil fetch the number `gnus-refer-thread-limit' variable."
specified by the `gnus-refer-thread-limit' variable."
(interactive "P" gnus-summary-mode) (interactive "P" gnus-summary-mode)
(let* ((header (gnus-summary-article-header)) (let* ((group gnus-newsgroup-name)
(id (mail-header-id header)) (header (gnus-summary-article-header))
(gnus-inhibit-demon t) (id (mail-header-id header))
(gnus-summary-ignore-duplicates t) (gnus-inhibit-demon t)
(gnus-read-all-available-headers t) (gnus-summary-ignore-duplicates t)
(gnus-refer-thread-use-search (gnus-read-all-available-headers t)
(if (and (not (null limit)) (listp limit)) (gnus-refer-thread-use-search
(not gnus-refer-thread-use-search) gnus-refer-thread-use-search)) (if (or (null limit) (numberp limit))
(new-headers gnus-refer-thread-use-search
(if (gnus-check-backend-function (if (booleanp gnus-refer-thread-use-search)
'request-thread gnus-newsgroup-name) (not gnus-refer-thread-use-search)
(gnus-request-thread header gnus-newsgroup-name) gnus-refer-thread-use-search)))
(let* ((limit (if (numberp limit) (prefix-numeric-value limit) article-ids new-unreads
gnus-refer-thread-limit)) (new-headers
(last (if (numberp limit) (cond
(min (+ (mail-header-number header) ;; If there is a backend-specific method, use it.
limit) ((gnus-check-backend-function
gnus-newsgroup-highest) 'request-thread group)
gnus-newsgroup-highest)) (gnus-request-thread header group))
(subject (gnus-simplify-subject ;; If a search engine is configured, use it.
(mail-header-subject header))) ((ignore-errors
(refs (split-string (or (mail-header-references header) (gnus-search-server-to-engine (gnus-group-server group)))
""))) (gnus-search-thread header))
(gnus-parse-headers-hook ;; Otherwise just retrieve some headers.
(t
(let* ((limit (if (numberp limit)
limit
gnus-refer-thread-limit))
(last (if (numberp limit)
(min (+ (mail-header-number header) limit)
gnus-newsgroup-highest)
gnus-newsgroup-highest))
(subject (gnus-simplify-subject
(mail-header-subject header)))
(refs (split-string
(or (mail-header-references header) "")))
(gnus-parse-headers-hook
(let ((refs (append refs (list id subject)))) (let ((refs (append refs (list id subject))))
(lambda () (lambda () (goto-char (point-min))
(goto-char (point-min)) (keep-lines (regexp-opt refs))))))
(keep-lines (regexp-opt refs)))))) (gnus-fetch-headers
(gnus-fetch-headers (list last) (if (numberp limit) (list last) (if (numberp limit) (* 2 limit) limit) t))))))
(* 2 limit) limit)
t))))
article-ids new-unreads)
(when (listp new-headers) (when (listp new-headers)
(dolist (header new-headers) (dolist (header new-headers)
(push (mail-header-number header) article-ids)) (push (mail-header-number header) article-ids))
(setq article-ids (nreverse article-ids)) (setq article-ids (nreverse article-ids))
(setq new-unreads (setq new-unreads
(gnus-sorted-intersection gnus-newsgroup-unselected article-ids)) (gnus-sorted-intersection gnus-newsgroup-unselected article-ids))
(setq gnus-newsgroup-unselected (setq gnus-newsgroup-unselected
(gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads)) (gnus-sorted-ndifference gnus-newsgroup-unselected new-unreads))
(setq gnus-newsgroup-unreads (setq gnus-newsgroup-unreads
(gnus-sorted-nunion gnus-newsgroup-unreads new-unreads)) (gnus-sorted-nunion gnus-newsgroup-unreads new-unreads))
(setq gnus-newsgroup-headers (setq gnus-newsgroup-headers
(gnus-delete-duplicate-headers (gnus-delete-duplicate-headers
(cl-merge (cl-merge 'list gnus-newsgroup-headers new-headers
'list gnus-newsgroup-headers new-headers 'gnus-article-sort-by-number)))
'gnus-article-sort-by-number)))
(setq gnus-newsgroup-articles (setq gnus-newsgroup-articles
(gnus-sorted-nunion gnus-newsgroup-articles article-ids)) (gnus-sorted-nunion gnus-newsgroup-articles article-ids))
(gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread))) (gnus-summary-limit-include-thread id gnus-refer-thread-limit-to-thread)))
(gnus-summary-show-thread)) (gnus-summary-show-thread))

2
lisp/gnus/mm-view.el
View file

@ -98,7 +98,7 @@ This is only used if `mm-inline-large-images' is set to
(truncate (* mm-inline-large-images-proportion (truncate (* mm-inline-large-images-proportion
(- (nth 3 edges) (nth 1 edges))))))) (- (nth 3 edges) (nth 1 edges)))))))
image)) image))
" ") "x")
(insert "\n") (insert "\n")
(mm-handle-set-undisplayer (mm-handle-set-undisplayer
handle handle

14
lisp/gnus/nnimap.el
View file

@ -1908,19 +1908,7 @@ If LIMIT, first try to limit the search to the N last articles."
(autoload 'nnselect-search-thread "nnselect") (autoload 'nnselect-search-thread "nnselect")
(deffoo nnimap-request-thread (header &optional group server) (make-obsolete 'nnimap-request-thread 'gnus-search-thread "29.1")
(if gnus-refer-thread-use-search
(nnselect-search-thread header)
(when (nnimap-change-group group server)
(let* ((cmd (nnimap-make-thread-query header))
(result (with-current-buffer (nnimap-buffer)
(nnimap-command "UID SEARCH %s" cmd))))
(when result
(gnus-fetch-headers
(and (car result)
(delete 0 (mapcar #'string-to-number
(cdr (assoc "SEARCH" (cdr result))))))
nil t))))))
(defun nnimap-change-group (group &optional server no-reconnect read-only) (defun nnimap-change-group (group &optional server no-reconnect read-only)
"Change group to GROUP if non-nil. "Change group to GROUP if non-nil.

483
lisp/gnus/nnselect.el
View file

@ -86,14 +86,14 @@
(let (selection) (let (selection)
(pcase-dolist (`(,artgroup . ,arts) (pcase-dolist (`(,artgroup . ,arts)
(nnselect-categorize artlist #'nnselect-artitem-group)) (nnselect-categorize artlist #'nnselect-artitem-group))
(let (list) (let (list)
(pcase-dolist (`(,rsv . ,articles) (pcase-dolist (`(,rsv . ,articles)
(nnselect-categorize (nnselect-categorize
arts #'nnselect-artitem-rsv #'nnselect-artitem-number)) arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
(push (cons rsv (gnus-compress-sequence (sort articles #'<))) (push (cons rsv (gnus-compress-sequence (sort articles #'<)))
list)) list))
(push (cons artgroup list) selection))) (push (cons artgroup (sort list 'car-less-than-car)) selection)))
selection))) (sort selection (lambda (x y) (string< (car x) (car y)))))))
(defun nnselect-uncompress-artlist (artlist) (defun nnselect-uncompress-artlist (artlist)
"Uncompress ARTLIST." "Uncompress ARTLIST."
@ -101,17 +101,20 @@
artlist artlist
(let (selection) (let (selection)
(pcase-dolist (`(,artgroup . ,list) artlist) (pcase-dolist (`(,artgroup . ,list) artlist)
(pcase-dolist (`(,artrsv . ,artseq) list) (pcase-dolist (`(,artrsv . ,artseq) list)
(setq selection (setq selection
(vconcat (vconcat selection
(cl-map 'vector (cl-map 'vector
(lambda (art) (lambda (art)
(vector artgroup art artrsv)) (vector artgroup art artrsv))
(gnus-uncompress-sequence artseq)) selection)))) (gnus-uncompress-sequence artseq))))))
selection))) (sort selection
(lambda (x y)
(< (nnselect-artitem-rsv x) (nnselect-artitem-rsv y)))))))
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1") (make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
(make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1") (make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1")
(make-obsolete 'nnselect-search-thread 'gnus-search-thread "29.1")
;; Data type article list. ;; Data type article list.
@ -268,18 +271,79 @@ If this variable is nil, or if the provided function returns nil,
:version "28.1" :version "28.1"
:type '(repeat function)) :type '(repeat function))
(defun nnselect-generate-artlist (group &optional specs) (defmacro nnselect-get-artlist (group)
"Generate the artlist for GROUP using SPECS. "Get the stored list of articles for GROUP.
SPECS should be an alist including an `nnselect-function' and an If the group parameter `nnselect-get-artlist-override-function'
`nnselect-args'. The former applied to the latter should create is non-nil call this function with argument GROUP to get the
the artlist. If SPECS is nil retrieve the specs from the group artlist; if the group parameter `nnselect-always-regenerate' is
parameters." non-nil, return nil to regenerate the artlist; otherwise retrieve
the stored artlist from the group parameters."
`(when (gnus-nnselect-group-p ,group)
(let ((override (gnus-group-get-parameter
,group
'nnselect-get-artlist-override-function)))
(cond
(override (funcall override ,group))
((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
nil)
(t
(nnselect-uncompress-artlist
(gnus-group-get-parameter ,group 'nnselect-artlist t)))))))
(defmacro nnselect-store-artlist (group artlist)
"Store the ARTLIST for GROUP.
If the group parameter `nnselect-store-artlist-override-function'
is non-nil call this function on GROUP and ARTLIST; if the group
parameter `nnselect-always-regenerate' is non-nil don't store the
artlist; otherwise store the ARTLIST in the group parameters.
The active range is also stored."
`(let ((override (gnus-group-get-parameter
,group
'nnselect-store-artlist-override-function)))
(gnus-group-set-parameter ,group 'active
(cons 1 (nnselect-artlist-length ,artlist)))
(cond
(override (funcall override ,group ,artlist))
((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
(gnus-group-remove-parameter ,group 'nnselect-artlist))
(t
(gnus-group-set-parameter ,group 'nnselect-artlist
(nnselect-compress-artlist ,artlist))))))
(defun nnselect-generate-artlist (group &optional specs info)
"Generate and return the artlist for GROUP using SPECS.
The artlist is sorted by rsv, lexically over groups, and by
article number. SPECS should be an alist including an
`nnselect-function' and an `nnselect-args'. The former applied
to the latter should create the artlist. If SPECS is nil
retrieve the specs from the group parameters. If INFO update the
group info."
(let* ((specs (let* ((specs
(or specs (gnus-group-get-parameter group 'nnselect-specs t))) (or specs (gnus-group-get-parameter group 'nnselect-specs t)))
(function (alist-get 'nnselect-function specs)) (function (alist-get 'nnselect-function specs))
(args (alist-get 'nnselect-args specs))) (args (alist-get 'nnselect-args specs)))
(condition-case-unless-debug err (condition-case-unless-debug err
(funcall function args) (progn
(let ((gnus-newsgroup-selection
(sort
(funcall function args)
(lambda (x y)
(let ((xgroup (nnselect-artitem-group x))
(ygroup (nnselect-artitem-group y))
(xrsv (nnselect-artitem-rsv x))
(yrsv (nnselect-artitem-rsv y)))
(or (< xrsv yrsv)
(and (eql xrsv yrsv)
(or (string< xgroup ygroup)
(and (string= xgroup ygroup)
(< (nnselect-artitem-number x)
(nnselect-artitem-number y)))))))))))
(when info
(if gnus-newsgroup-selection
(nnselect-request-update-info group info)
(gnus-set-active group '(1 . 0))))
(nnselect-store-artlist group gnus-newsgroup-selection)
gnus-newsgroup-selection))
;; Don't swallow gnus-search errors; the user should be made ;; Don't swallow gnus-search errors; the user should be made
;; aware of them. ;; aware of them.
(gnus-search-error (gnus-search-error
@ -290,41 +354,6 @@ parameters."
"nnselect-generate-artlist: %s on %s gave error %s" function args err) "nnselect-generate-artlist: %s on %s gave error %s" function args err)
[])))) []))))
(defmacro nnselect-get-artlist (group)
"Get the list of articles for GROUP.
If the group parameter `nnselect-get-artlist-override-function' is
non-nil call this function with argument GROUP to get the
artlist; if the group parameter `nnselect-always-regenerate' is
non-nil, regenerate the artlist; otherwise retrieve the artlist
directly from the group parameters."
`(when (gnus-nnselect-group-p ,group)
(let ((override (gnus-group-get-parameter
,group
'nnselect-get-artlist-override-function)))
(cond
(override (funcall override ,group))
((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
(nnselect-generate-artlist ,group))
(t
(nnselect-uncompress-artlist
(gnus-group-get-parameter ,group 'nnselect-artlist t)))))))
(defmacro nnselect-store-artlist (group artlist)
"Store the ARTLIST for GROUP.
If the group parameter `nnselect-store-artlist-override-function'
is non-nil call this function on GROUP and ARTLIST; if the group
parameter `nnselect-always-regenerate' is non-nil don't store the
artlist; otherwise store the ARTLIST in the group parameters."
`(let ((override (gnus-group-get-parameter
,group
'nnselect-store-artlist-override-function)))
(cond
(override (funcall override ,group ,artlist))
((gnus-group-get-parameter ,group 'nnselect-always-regenerate) t)
(t
(gnus-group-set-parameter ,group 'nnselect-artlist
(nnselect-compress-artlist ,artlist))))))
;; Gnus backend interface functions. ;; Gnus backend interface functions.
(deffoo nnselect-open-server (server &optional definitions) (deffoo nnselect-open-server (server &optional definitions)
@ -345,85 +374,82 @@ artlist; otherwise store the ARTLIST in the group parameters."
(deffoo nnselect-request-group (group &optional _server _dont-check info) (deffoo nnselect-request-group (group &optional _server _dont-check info)
(let* ((group (nnselect-add-prefix group)) (let* ((group (nnselect-add-prefix group))
(nnselect-artlist (nnselect-get-artlist group)) (length (cdr (gnus-group-get-parameter group 'active t))))
length) (when (or (null length)
;; Check for cached select result or run the selection and cache (gnus-group-get-parameter group 'nnselect-always-regenerate))
;; the result. (setq length (nnselect-artlist-length
(unless nnselect-artlist (nnselect-generate-artlist group nil info))))
(nnselect-store-artlist group (if (and (zerop length) (gnus-ephemeral-group-p group))
(setq nnselect-artlist (nnselect-generate-artlist group))) (progn
(nnselect-request-update-info (nnheader-report 'nnselect "Selection produced empty results.")
group (or info (gnus-get-info group)))) (gnus-kill-ephemeral-group group)
(if (zerop (setq length (nnselect-artlist-length nnselect-artlist))) (setq gnus-ephemeral-servers
(progn (assq-delete-all 'nnselect gnus-ephemeral-servers))
(nnheader-report 'nnselect "Selection produced empty results.") (nnheader-insert ""))
(when (gnus-ephemeral-group-p group)
(gnus-kill-ephemeral-group group)
(setq gnus-ephemeral-servers
(assq-delete-all 'nnselect gnus-ephemeral-servers)))
(nnheader-insert ""))
(with-current-buffer nntp-server-buffer (with-current-buffer nntp-server-buffer
(nnheader-insert "211 %d %d %d %s\n" (nnheader-insert "211 %d %d %d %s\n"
length ; total # length ; total #
1 ; first # (if (zerop length) 0 1) ; first #
length ; last # length ; last #
group))) ; group name group))))) ; group name
nnselect-artlist))
(deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old) (deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old)
(let ((group (nnselect-add-prefix group))) (let ((group (nnselect-add-prefix group))
(gnus-inhibit-demon t))
(with-current-buffer (gnus-summary-buffer-name group) (with-current-buffer (gnus-summary-buffer-name group)
(setq gnus-newsgroup-selection (or gnus-newsgroup-selection (setq gnus-newsgroup-selection
(nnselect-get-artlist group))) (or gnus-newsgroup-selection
(let ((gnus-inhibit-demon t) (nnselect-get-artlist group)
(gartids (ids-by-group articles)) ;; maybe don't need to update the info?
headers) ;; (nnselect-generate-artlist group nil (gnus-get-info group))))
(with-current-buffer nntp-server-buffer (nnselect-generate-artlist group)))
(pcase-dolist (`(,artgroup . ,artids) gartids) (let ((gartids (ids-by-group articles))
(let ((artlist (sort (mapcar #'cdr artids) #'<)) headers)
(gnus-override-method (gnus-find-method-for-group artgroup)) (with-current-buffer nntp-server-buffer
(fetch-old (pcase-dolist (`(,artgroup . ,artids) gartids)
(or (let ((artlist (sort (mapcar #'cdr artids) #'<))
(car-safe (gnus-override-method (gnus-find-method-for-group artgroup))
(gnus-group-find-parameter artgroup (fetch-old
'gnus-fetch-old-headers t)) (or
fetch-old))) (car-safe
(gnus-group-find-parameter artgroup
'gnus-fetch-old-headers t))
fetch-old)))
(gnus-request-group artgroup) (gnus-request-group artgroup)
(erase-buffer) (erase-buffer)
(pcase (setq gnus-headers-retrieved-by (pcase (setq gnus-headers-retrieved-by
(or (or
(and (and
nnselect-retrieve-headers-override-function nnselect-retrieve-headers-override-function
(funcall (funcall
nnselect-retrieve-headers-override-function nnselect-retrieve-headers-override-function
artlist artgroup)) artlist artgroup))
(gnus-retrieve-headers (gnus-retrieve-headers
artlist artgroup fetch-old))) artlist artgroup fetch-old)))
('nov ('nov
(goto-char (point-min)) (goto-char (point-min))
(while (not (eobp)) (while (not (eobp))
(nnselect-add-novitem (nnselect-add-novitem
(nnheader-parse-nov)) (nnheader-parse-nov))
(forward-line 1))) (forward-line 1)))
('headers ('headers
(gnus-run-hooks 'gnus-parse-headers-hook) (gnus-run-hooks 'gnus-parse-headers-hook)
(let ((nnmail-extra-headers gnus-extra-headers)) (let ((nnmail-extra-headers gnus-extra-headers))
(goto-char (point-min)) (goto-char (point-min))
(while (not (eobp)) (while (not (eobp))
(nnselect-add-novitem (nnselect-add-novitem
(nnheader-parse-head)) (nnheader-parse-head))
(forward-line 1)))) (forward-line 1))))
((pred listp) ((pred listp)
(dolist (novitem gnus-headers-retrieved-by) (dolist (novitem gnus-headers-retrieved-by)
(nnselect-add-novitem novitem))) (nnselect-add-novitem novitem)))
(_ (error "Unknown header type %s while requesting articles \ (_ (error "Unknown header type %s while requesting articles \
of group %s" gnus-headers-retrieved-by artgroup))))) of group %s" gnus-headers-retrieved-by artgroup)))))
(setq headers (setq headers
(sort (sort
headers headers
(lambda (x y) (lambda (x y)
(< (mail-header-number x) (mail-header-number y)))))))))) (< (mail-header-number x) (mail-header-number y))))))))))
(deffoo nnselect-request-article (article &optional _group server to-buffer) (deffoo nnselect-request-article (article &optional _group server to-buffer)
@ -567,9 +593,9 @@ artlist; otherwise store the ARTLIST in the group parameters."
(artnumber (nnselect-article-number article)) (artnumber (nnselect-article-number article))
(gmark (gnus-request-update-mark artgroup artnumber mark))) (gmark (gnus-request-update-mark artgroup artnumber mark)))
(when (and artnumber (when (and artnumber
(memq mark gnus-auto-expirable-marks) (memq mark gnus-auto-expirable-marks)
(= mark gmark) (= mark gmark)
(gnus-group-auto-expirable-p artgroup)) (gnus-group-auto-expirable-p artgroup))
(setq gmark gnus-expirable-mark)) (setq gmark gnus-expirable-mark))
gmark)) gmark))
@ -656,57 +682,48 @@ artlist; otherwise store the ARTLIST in the group parameters."
(deffoo nnselect-request-thread (header &optional group server) (deffoo nnselect-request-thread (header &optional group server)
(with-current-buffer gnus-summary-buffer (with-current-buffer gnus-summary-buffer
(let ((group (nnselect-add-prefix group)) (let* ((group (nnselect-add-prefix group))
;; find the best group for the originating article. if its a ;; Find the best group for the originating article. If its
;; pseudo-article look for real articles in the same thread ;; a pseudo-article check for real articles in the same
;; and see where they come from. ;; thread to see where they come from.
(artgroup (nnselect-article-group (artgroup
(if (> (mail-header-number header) 0) (nnselect-article-group
(mail-header-number header) (cond
(if (> (gnus-summary-article-number) 0) ((> (mail-header-number header) 0)
(gnus-summary-article-number) (mail-header-number header))
(let ((thread ((> (gnus-summary-article-number) 0)
(gnus-id-to-thread (mail-header-id header)))) (gnus-summary-article-number))
(when thread (t (cl-some
(cl-some (lambda (x) (lambda (x) (when (and x (> x 0)) x))
(when (and x (> x 0)) x)) (gnus-articles-in-thread
(gnus-articles-in-thread thread))))))))) (gnus-id-to-thread (mail-header-id header))))))))
;; Check if search-based thread referral is permitted, and (server (or server (gnus-group-server artgroup))))
;; available. ;; Check if search-based thread referral is available.
(if (and gnus-refer-thread-use-search (if (ignore-errors (gnus-search-server-to-engine server))
(gnus-search-server-to-engine ;; We perform the query, massage the result, and return
(gnus-method-to-server ;; the new headers back to the caller to incorporate into
(gnus-find-method-for-group artgroup)))) ;; the current summary buffer.
;; If so we perform the query, massage the result, and return (let* ((gnus-search-use-parsed-queries t)
;; the new headers back to the caller to incorporate into the
;; current summary buffer.
(let* ((gnus-search-use-parsed-queries t)
(group-spec (group-spec
(list (delq nil (list (if (not gnus-refer-thread-use-search)
(or server (gnus-group-server artgroup)) (list (list server artgroup))
(unless gnus-refer-thread-use-search (if (listp gnus-refer-thread-use-search)
artgroup))))) gnus-refer-thread-use-search
(ids (cons (mail-header-id header) (list (list server)))))
(split-string (ids (cons (mail-header-id header)
(or (mail-header-references header) (split-string
"")))) (or (mail-header-references header)
(query-spec ""))))
(list (cons 'query (mapconcat (lambda (i) (query-spec
(format "id:%s" i)) (list (cons 'query
ids " or ")) (mapconcat (lambda (i) (format "id:%s" i))
(cons 'thread t))) ids " or ")) (cons 'thread t)))
(last (nnselect-artlist-length gnus-newsgroup-selection)) (last (nnselect-artlist-length gnus-newsgroup-selection))
(first (1+ last)) (first (1+ last))
(new-nnselect-artlist old-arts seq headers)
(gnus-search-run-query (mapc
(list (cons 'search-query-spec query-spec)
(cons 'search-group-spec group-spec))))
old-arts seq
headers)
(mapc
(lambda (article) (lambda (article)
(if (if (setq seq
(setq seq
(cl-position (cl-position
article article
gnus-newsgroup-selection gnus-newsgroup-selection
@ -714,48 +731,61 @@ artlist; otherwise store the ARTLIST in the group parameters."
(lambda (x y) (lambda (x y)
(and (equal (nnselect-artitem-group x) (and (equal (nnselect-artitem-group x)
(nnselect-artitem-group y)) (nnselect-artitem-group y))
(eql (nnselect-artitem-number x) (eql (nnselect-artitem-number x)
(nnselect-artitem-number y)))))) (nnselect-artitem-number y))))))
(push (1+ seq) old-arts) (push (1+ seq) old-arts)
(setq gnus-newsgroup-selection (setq gnus-newsgroup-selection
(vconcat gnus-newsgroup-selection (vector article))) (vconcat gnus-newsgroup-selection (vector article)))
(cl-incf last))) (cl-incf last)))
new-nnselect-artlist) (gnus-search-run-query
(setq headers (list (cons 'search-query-spec query-spec)
(gnus-fetch-headers (cons 'search-group-spec group-spec))))
(append (sort old-arts #'<) (setq headers
(number-sequence first last)) (gnus-fetch-headers
nil t)) (append (sort old-arts #'<) (number-sequence first last))
(nnselect-store-artlist group gnus-newsgroup-selection) nil t))
(when (>= last first) (nnselect-store-artlist group gnus-newsgroup-selection)
(let (new-marks) (when (>= last first)
(pcase-dolist (`(,artgroup . ,artids) (let (new-marks)
(ids-by-group (number-sequence first last))) (pcase-dolist (`(,artgroup . ,artids)
(pcase-dolist (`(,type . ,marked) (ids-by-group (number-sequence first last)))
(gnus-info-marks (gnus-get-info artgroup))) (pcase-dolist (`(,type . ,marked)
(setq marked (gnus-uncompress-sequence marked)) (gnus-info-marks (gnus-get-info artgroup)))
(when (setq new-marks (when
(delq nil (setq new-marks
(mapcar (delq nil
(if (eq (gnus-article-mark-to-type type)
'tuple)
(mapcar
(lambda (art)
(let ((mtup
(assq (cdr art) marked)))
(when mtup
(cons (car art) (cdr mtup)))))
artids)
(setq marked
(gnus-uncompress-sequence marked))
(mapcar
(lambda (art) (lambda (art)
(when (memq (cdr art) marked) (when (memq (cdr art) marked)
(car art))) (car art)))
artids))) artids))))
(nconc (nconc
(symbol-value (symbol-value
(intern (intern
(format "gnus-newsgroup-%s" (format "gnus-newsgroup-%s"
(car (rassq type gnus-article-mark-lists))))) (car
new-marks))))) (rassq type gnus-article-mark-lists)))))
(setq gnus-newsgroup-active new-marks)))))
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection))) (gnus-set-active
(gnus-set-active group
group (setq
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))) gnus-newsgroup-active
headers) (cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))))
;; If we can't or won't use search, just warp to the original headers)
;; group and punt back to gnus-summary-refer-thread. ;; If we can't use search, just warp to the original group and
(and (gnus-warp-to-article) (gnus-summary-refer-thread)))))) ;; punt back to gnus-summary-refer-thread.
(and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
(deffoo nnselect-close-group (group &optional _server) (deffoo nnselect-close-group (group &optional _server)
@ -774,23 +804,23 @@ artlist; otherwise store the ARTLIST in the group parameters."
(message "Creating nnselect group %s" group) (message "Creating nnselect group %s" group)
(let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect"))) (let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect")))
(specs (assq 'nnselect-specs args)) (specs (assq 'nnselect-specs args))
(artlist (alist-get 'nnselect-artlist args))
(otherargs (assq-delete-all 'nnselect-specs args)) (otherargs (assq-delete-all 'nnselect-specs args))
(function-spec (function-spec
(or (alist-get 'nnselect-function specs) (or (alist-get 'nnselect-function specs)
(intern (completing-read "Function: " obarray #'functionp)))) (intern (completing-read "Function: " obarray #'functionp))))
(args-spec (args-spec
(or (alist-get 'nnselect-args specs) (or (alist-get 'nnselect-args specs)
(read-from-minibuffer "Args: " nil nil t nil "nil"))) (read-from-minibuffer "Args: " nil nil t nil "nil")))
(nnselect-specs (list (cons 'nnselect-function function-spec) (nnselect-specs (list (cons 'nnselect-function function-spec)
(cons 'nnselect-args args-spec)))) (cons 'nnselect-args args-spec))))
(gnus-group-set-parameter group 'nnselect-specs nnselect-specs) (gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
(dolist (arg otherargs) (dolist (arg otherargs)
(gnus-group-set-parameter group (car arg) (cdr arg))) (gnus-group-set-parameter group (car arg) (cdr arg)))
(nnselect-store-artlist (if artlist
group (nnselect-store-artlist group artlist)
(or (alist-get 'nnselect-artlist args) (nnselect-generate-artlist group nnselect-specs
(nnselect-generate-artlist group nnselect-specs))) (gnus-get-info group))))
(nnselect-request-update-info group (gnus-get-info group)))
t) t)
@ -820,11 +850,12 @@ artlist; otherwise store the ARTLIST in the group parameters."
(deffoo nnselect-request-group-scan (group &optional _server _info) (deffoo nnselect-request-group-scan (group &optional _server _info)
(let* ((group (nnselect-add-prefix group)) (let ((group (nnselect-add-prefix group)))
(artlist (nnselect-generate-artlist group))) (unless (gnus-group-find-parameter group 'nnselect-always-regenerate)
(gnus-set-active group (cons 1 (nnselect-artlist-length (let ((artlist (nnselect-generate-artlist group)))
artlist))) (gnus-set-active group (cons 1 (nnselect-artlist-length
(nnselect-store-artlist group artlist))) artlist))))))
t)
;; Add any undefined required backend functions ;; Add any undefined required backend functions

27
lisp/image.el
View file

@ -51,7 +51,7 @@ static \\(unsigned \\)?char \\1_bits" . xbm)
("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff) ("\\`\\(?:MM\0\\*\\|II\\*\0\\)" . tiff)
("\\`[\t\n\r ]*%!PS" . postscript) ("\\`[\t\n\r ]*%!PS" . postscript)
("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg) ("\\`\xff\xd8" . jpeg) ; used to be (image-jpeg-p . jpeg)
("\\`RIFF....WEBPVP8" . webp) ("\\`RIFF[^z-a][^z-a][^z-a][^z-a]WEBPVP8" . webp)
(,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)") (,(let* ((incomment-re "\\(?:[^-]\\|-[^-]\\)")
(comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)"))) (comment-re (concat "\\(?:!--" incomment-re "*-->[ \t\r\n]*<\\)")))
(concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<" (concat "\\(?:<\\?xml[ \t\r\n]+[^>]*>\\)?[ \t\r\n]*<"
@ -172,22 +172,27 @@ or \"ffmpeg\") is installed."
(define-error 'unknown-image-type "Unknown image type") (define-error 'unknown-image-type "Unknown image type")
(defvar-keymap image-map (defvar-keymap image-slice-map
:doc "Map put into text properties on images." :doc "Map put into text properties on sliced images."
"i" (define-keymap "i" (define-keymap
"-" #'image-decrease-size "-" #'image-decrease-size
"+" #'image-increase-size "+" #'image-increase-size
"r" #'image-rotate
"o" #'image-save "o" #'image-save
"c" #'image-crop "c" #'image-crop
"x" #'image-cut "x" #'image-cut)
"h" #'image-flip-horizontally
"v" #'image-flip-vertically)
"C-<wheel-down>" #'image-mouse-decrease-size "C-<wheel-down>" #'image-mouse-decrease-size
"C-<mouse-5>" #'image-mouse-decrease-size "C-<mouse-5>" #'image-mouse-decrease-size
"C-<wheel-up>" #'image-mouse-increase-size "C-<wheel-up>" #'image-mouse-increase-size
"C-<mouse-4>" #'image-mouse-increase-size) "C-<mouse-4>" #'image-mouse-increase-size)
(defvar-keymap image-map
:doc "Map put into text properties on images."
:parent image-slice-map
"i" (define-keymap
"r" #'image-rotate
"h" #'image-flip-horizontally
"v" #'image-flip-vertically))
(defun image-load-path-for-library (library image &optional path no-error) (defun image-load-path-for-library (library image &optional path no-error)
"Return a suitable search path for images used by LIBRARY. "Return a suitable search path for images used by LIBRARY.
@ -665,7 +670,9 @@ is non-nil, this is inhibited."
image) image)
rear-nonsticky t rear-nonsticky t
inhibit-isearch ,inhibit-isearch inhibit-isearch ,inhibit-isearch
keymap ,image-map)))) keymap ,(if slice
image-slice-map
image-map)))))
;;;###autoload ;;;###autoload
@ -701,8 +708,8 @@ The image is automatically split into ROWS x COLS slices."
(insert string) (insert string)
(add-text-properties start (point) (add-text-properties start (point)
`(display ,(list (list 'slice x y dx dy) image) `(display ,(list (list 'slice x y dx dy) image)
rear-nonsticky (display) rear-nonsticky (display keymap)
keymap ,image-map)) keymap ,image-slice-map))
(setq x (+ x dx)))) (setq x (+ x dx))))
(setq x 0.0 (setq x 0.0
y (+ y dy)) y (+ y dy))

65
lisp/image/image-crop.el
View file

@ -35,6 +35,7 @@
(declare-function image-property "image.el" (image property)) (declare-function image-property "image.el" (image property))
(declare-function image-size "image.c" (spec &optional pixels frame)) (declare-function image-size "image.c" (spec &optional pixels frame))
(declare-function imagep "image.c" (spec)) (declare-function imagep "image.c" (spec))
(declare-function image--get-image "image.el" (&optional position))
(defgroup image-crop () (defgroup image-crop ()
"Image cropping." "Image cropping."
@ -113,18 +114,14 @@ and the cropped image data.")
(defun image-cut (&optional color) (defun image-cut (&optional color)
"Cut a rectangle from the image under point, filling it with COLOR. "Cut a rectangle from the image under point, filling it with COLOR.
COLOR defaults to the value of `image-cut-color'. COLOR defaults to the value of `image-cut-color'.
Interactively, with prefix argument, prompt for COLOR to use." Interactively, with prefix argument, prompt for COLOR to use.
(interactive (list (and current-prefix-arg (read-color "Use color: "))))
(image-crop (if (zerop (length color)) image-cut-color color)))
;;;###autoload This command presents the image with a rectangular area superimposed
(defun image-crop (&optional cut) on it, and allows moving and resizing the area to define which
"Crop the image under point. part of it to cut.
If CUT is non-nil, remove a rectangle from the image instead of
cropping the image. In that case CUT should be the name of a
color to fill the rectangle.
While cropping the image, the following key bindings are available: While moving/resizing the cutting area, the following key bindings
are available:
`q': Exit without changing anything. `q': Exit without changing anything.
`RET': Crop/cut the image. `RET': Crop/cut the image.
@ -132,15 +129,51 @@ While cropping the image, the following key bindings are available:
rectangle shape. rectangle shape.
`s': Same as `m', but make the rectangle into a square first. `s': Same as `m', but make the rectangle into a square first.
After cropping an image, you can save it by `M-x image-save' or After cutting the image, you can save it by `M-x image-save' or
\\<image-map>\\[image-save] when point is over the image." \\<image-map>\\[image-save] when point is over the image."
(interactive (list (and current-prefix-arg
(read-color "Color to use for filling: "))))
(image-crop (if (zerop (length color)) image-cut-color color)))
;;;###autoload
(defun image-crop (&optional cut)
"Crop the image under point.
This command presents the image with a rectangular area superimposed
on it, and allows moving and resizing the area to define which
part of it to crop.
While moving/resizing the cropping area, the following key bindings
are available:
`q': Exit without changing anything.
`RET': Crop/cut the image.
`m': Make mouse movements move the rectangle instead of altering the
rectangle shape.
`s': Same as `m', but make the rectangle into a square first.
After cropping the image, you can save it by `M-x image-save' or
\\<image-map>\\[image-save] when point is over the image.
When called from Lisp, if CUT is non-nil, remove a rectangle from
the image instead of cropping the image. In that case, CUT should
be the name of a color to fill the rectangle."
(interactive) (interactive)
(unless (image-type-available-p 'svg) (unless (image-type-available-p 'svg)
(error "SVG support is needed to crop images")) (error "SVG support is needed to crop and cut images"))
(unless (executable-find (car image-crop-crop-command)) (let* ((crop-cmd (car image-crop-crop-command))
(error "Couldn't find %s command to crop the image" (found (executable-find crop-cmd)))
(car image-crop-crop-command))) (unless found
(let ((image (get-text-property (point) 'display))) (error "Couldn't find `%s' command to crop/cut the image" crop-cmd))
(if (and (memq system-type '(windows-nt ms-dos))
;; MS-Windows has an incompatible convert.exe, used to
;; convert filesystems...
(string-equal crop-cmd "convert")
(= 0 (string-search "Invalid drive specification."
(shell-command-to-string
(format "%s %s" crop-cmd null-device)))))
(error "The program `%s' is not an image conversion program"
found)))
(let ((image (image--get-image)))
(unless (imagep image) (unless (imagep image)
(user-error "No image under point")) (user-error "No image under point"))
(when (overlays-at (point)) (when (overlays-at (point))

3
lisp/international/quail.el
View file

@ -1995,7 +1995,8 @@ Remaining args are for FUNC."
(defun quail-minibuffer-message (string) (defun quail-minibuffer-message (string)
(message nil) (message nil)
(let ((point-max (point-max)) (let ((point-max (point-max))
(inhibit-quit t)) (inhibit-quit t)
(deactivate-mark nil))
(save-excursion (save-excursion
(goto-char point-max) (goto-char point-max)
(insert string)) (insert string))

8
lisp/jsonrpc.el
View file

@ -574,15 +574,14 @@ With optional CLEANUP, kill any associated buffers."
(cl-return-from jsonrpc--process-filter)) (cl-return-from jsonrpc--process-filter))
(when (buffer-live-p (process-buffer proc)) (when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc) (with-current-buffer (process-buffer proc)
(let* ((inhibit-read-only t) (let* ((jsonrpc--in-process-filter t)
(jsonrpc--in-process-filter t)
(connection (process-get proc 'jsonrpc-connection)) (connection (process-get proc 'jsonrpc-connection))
(expected-bytes (jsonrpc--expected-bytes connection))) (expected-bytes (jsonrpc--expected-bytes connection)))
;; Insert the text, advancing the process marker. ;; Insert the text, advancing the process marker.
;; ;;
(save-excursion (save-excursion
(goto-char (process-mark proc)) (goto-char (process-mark proc))
(insert string) (let ((inhibit-read-only t)) (insert string))
(set-marker (process-mark proc) (point))) (set-marker (process-mark proc) (point)))
;; Loop (more than one message might have arrived) ;; Loop (more than one message might have arrived)
;; ;;
@ -631,7 +630,8 @@ With optional CLEANUP, kill any associated buffers."
(jsonrpc-connection-receive connection (jsonrpc-connection-receive connection
json-message))))) json-message)))))
(goto-char message-end) (goto-char message-end)
(delete-region (point-min) (point)) (let ((inhibit-read-only t))
(delete-region (point-min) (point)))
(setq expected-bytes nil)))) (setq expected-bytes nil))))
(t (t
;; Message is still incomplete ;; Message is still incomplete

119
lisp/leim/quail/cyrillic.el
View file

@ -1844,6 +1844,125 @@ Doubling the postfix separates the letter and postfix
("E**" ["У*"]) ("E**" ["У*"])
("e**" ["у*"])) ("e**" ["у*"]))
;; Mongolian layout: Mongolian alphabet has 2 letters: Ө Ү,
;; and the layout is quite different from other cyrillic layouts.
;; Written by Garid Zorigoo.
(quail-define-package
"cyrillic-mongolian" "Mongolian" "MN-" t
"Input method for cyrillic Mongolian"
nil t nil nil nil nil nil nil nil nil t)
;; № - " ₮ : . _ , % ? е щ
;; Ф Ц У Ж Э Н Г Ш Ү З К Ъ
;; Й Ы Б Ө А Х Р О Л Д П
;; Я Ч Ё С М И Т Ь В Ю
(quail-define-rules
;; (lowercase 1st row)
("q" ?ф)
("w" ?ц)
("e" ?у)
("r" ?ж)
("t" ?э)
("y" ?н)
("u" ?г)
("i" ?ш)
("o" ?ү)
("p" ?з)
("[" ?к)
("]" ?ъ)
;; (lowercase 2nd row)
("a" ?й)
("s" ?ы)
("d" ?б)
("f" ?ө)
("g" ?а)
("h" ?х)
("j" ?р)
("k" ?о)
("l" ?л)
(";" ?д)
("'" ?п)
;; (lowercase 3rd row)
("z" ?я)
("x" ?ч)
("c" ?ё)
("v" ?с)
("b" ?м)
("n" ?и)
("m" ?т)
("," ?ь)
("." ?в)
("/" ?ю)
;; (uppercase 1st row)
("Q" ?Ф)
("W" ?Ц)
("E" ?У)
("R" ?Ж)
("T" ?Э)
("Y" ?Н)
("U" ?Г)
("I" ?Ш)
("O" ?Ү)
("P" ?З)
("{" ?К)
("}" ?Ъ)
;; (uppercase 2nd row)
("A" ?Й)
("S" ?Ы)
("D" ?Б)
("F" ?Ө)
("G" ?А)
("H" ?Х)
("J" ?Р)
("K" ?О)
("L" ?Л)
(":" ?Д)
("\"" ?П)
;; (uppercase 3rd row)
("Z" ?Я)
("X" ?Ч)
("C" ?Ё)
("V" ?С)
("B" ?М)
("N" ?И)
("M" ?Т)
("<" ?Ь)
(">" ?В)
("?" ?Ю)
;; (number row without shift)
("1" ?№)
("2" ?-)
("3" ?\")
("4" ?₮)
("5" ?:)
("6" ?.)
("7" ?_)
("8" ?,)
("9" ?%)
("0" ??)
("-" ?е)
("=" ?щ)
;; (number row with shift)
("!" ?1)
("@" ?2)
("#" ?3)
("$" ?4)
("%" ?5)
("^" ?6)
("&" ?7)
("*" ?8)
("(" ?9)
(")" ?0)
("_" ?Е)
("+" ?Щ))
;; Local Variables: ;; Local Variables:
;; coding: utf-8 ;; coding: utf-8
;; End: ;; End:

3
lisp/mouse.el
View file

@ -533,7 +533,8 @@ Some context functions add menu items below the separator."
(i 0)) (i 0))
(dolist (item (reverse yank-menu)) (dolist (item (reverse yank-menu))
(when (consp item) (when (consp item)
(define-key submenu (vector (setq i (1+ i))) (define-key submenu
(vector (intern (format "kill-%d" (setq i (1+ i)))))
`(menu-item ,(cadr item) `(menu-item ,(cadr item)
,(lambda () (interactive) ,(lambda () (interactive)
(mouse-yank-from-menu click (car item))))))) (mouse-yank-from-menu click (car item)))))))

2
lisp/net/eww.el
View file

@ -326,7 +326,7 @@ parameter, and should return the (possibly) transformed URL."
"<mouse-2>" #'eww-follow-link) "<mouse-2>" #'eww-follow-link)
(defvar-keymap eww-image-link-keymap (defvar-keymap eww-image-link-keymap
:parent shr-map :parent shr-image-map
"RET" #'eww-follow-link) "RET" #'eww-follow-link)
(defun eww-suggested-uris nil (defun eww-suggested-uris nil

2
lisp/net/shr.el
View file

@ -276,7 +276,7 @@ and other things:
(defvar-keymap shr-map (defvar-keymap shr-map
"a" #'shr-show-alt-text "a" #'shr-show-alt-text
"i" #'shr-browse-image "M-i" #'shr-browse-image
"z" #'shr-zoom-image "z" #'shr-zoom-image
"TAB" #'shr-next-link "TAB" #'shr-next-link
"C-M-i" #'shr-previous-link "C-M-i" #'shr-previous-link

175
lisp/progmodes/c-ts-mode.el
View file

@ -79,6 +79,7 @@
(declare-function treesit-node-type "treesit.c") (declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-prev-sibling "treesit.c") (declare-function treesit-node-prev-sibling "treesit.c")
(declare-function treesit-node-first-child-for-pos "treesit.c") (declare-function treesit-node-first-child-for-pos "treesit.c")
(declare-function treesit-node-next-sibling "treesit.c")
;;; Custom variables ;;; Custom variables
@ -192,6 +193,10 @@ To set the default indent style globally, use
(c-ts-mode--get-indent-style (c-ts-mode--get-indent-style
(if (derived-mode-p 'c-ts-mode) 'c 'cpp)))))) (if (derived-mode-p 'c-ts-mode) 'c 'cpp))))))
(defvar c-ts-mode-emacs-devel nil
"If the value is t, enable Emacs source-specific features.
This needs to be set before enabling `c-ts-mode'.")
;;; Syntax table ;;; Syntax table
(defvar c-ts-mode--syntax-table (defvar c-ts-mode--syntax-table
@ -802,7 +807,14 @@ Return nil if NODE is not a defun node or doesn't have a name."
((or "struct_specifier" "enum_specifier" ((or "struct_specifier" "enum_specifier"
"union_specifier" "class_specifier" "union_specifier" "class_specifier"
"namespace_definition") "namespace_definition")
(treesit-node-child-by-field-name node "name"))) (treesit-node-child-by-field-name node "name"))
;; DEFUNs in Emacs source.
("expression_statement"
(let* ((call-exp-1 (treesit-node-child node 0))
(call-exp-2 (treesit-node-child call-exp-1 0))
(arg-list (treesit-node-child call-exp-2 1))
(name (treesit-node-child arg-list 1 t)))
name)))
t)) t))
;;; Defun navigation ;;; Defun navigation
@ -810,28 +822,29 @@ Return nil if NODE is not a defun node or doesn't have a name."
(defun c-ts-mode--defun-valid-p (node) (defun c-ts-mode--defun-valid-p (node)
"Return non-nil if NODE is a valid defun node. "Return non-nil if NODE is a valid defun node.
Ie, NODE is not nested." Ie, NODE is not nested."
(not (or (and (member (treesit-node-type node) (or (c-ts-mode--emacs-defun-p node)
'("struct_specifier" (not (or (and (member (treesit-node-type node)
"enum_specifier" '("struct_specifier"
"union_specifier"
"declaration"))
;; If NODE's type is one of the above, make sure it is
;; top-level.
(treesit-node-top-level
node (rx (or "function_definition"
"type_definition"
"struct_specifier"
"enum_specifier" "enum_specifier"
"union_specifier" "union_specifier"
"declaration")))) "declaration"))
;; If NODE's type is one of the above, make sure it is
;; top-level.
(treesit-node-top-level
node (rx (or "function_definition"
"type_definition"
"struct_specifier"
"enum_specifier"
"union_specifier"
"declaration"))))
(and (equal (treesit-node-type node) "declaration") (and (equal (treesit-node-type node) "declaration")
;; If NODE is a declaration, make sure it is not a ;; If NODE is a declaration, make sure it is not a
;; function declaration. ;; function declaration.
(equal (treesit-node-type (equal (treesit-node-type
(treesit-node-child-by-field-name (treesit-node-child-by-field-name
node "declarator")) node "declarator"))
"function_declarator"))))) "function_declarator"))))))
(defun c-ts-mode--defun-for-class-in-imenu-p (node) (defun c-ts-mode--defun-for-class-in-imenu-p (node)
"Check if NODE is a valid entry for the Class subindex. "Check if NODE is a valid entry for the Class subindex.
@ -859,17 +872,85 @@ the semicolon. This function skips the semicolon."
(goto-char (match-end 0))) (goto-char (match-end 0)))
(treesit-default-defun-skipper)) (treesit-default-defun-skipper))
(defun c-ts-base--before-indent (args)
(pcase-let ((`(,node ,parent ,bol) args))
(when (null node)
(let ((smallest-node (treesit-node-at (point))))
;; "Virtual" closer curly added by the
;; parser's error recovery.
(when (and (equal (treesit-node-type smallest-node) "}")
(equal (treesit-node-end smallest-node)
(treesit-node-start smallest-node)))
(setq parent (treesit-node-parent smallest-node)))))
(list node parent bol)))
(defun c-ts-mode--emacs-defun-p (node)
"Return non-nil if NODE is a DEFUN in Emacs source files."
(and (equal (treesit-node-type node) "expression_statement")
(equal (treesit-node-text
(treesit-node-child-by-field-name
(treesit-node-child
(treesit-node-child node 0) 0)
"function")
t)
"DEFUN")))
(defun c-ts-mode--emacs-defun-at-point (&optional range)
"Return the current defun node.
This function recognizes DEFUNs in Emacs source files.
Note that for the case of a DEFUN, it is made of two separate
nodes, one for the declaration and one for the body, this
function returns the declaration node.
If RANGE is non-nil, return (BEG . END) where BEG end END
encloses the whole defun. This solves the problem of only
returning the declaration part for DEFUN."
(or (when-let ((node (treesit-defun-at-point)))
(if range
(cons (treesit-node-start node)
(treesit-node-end node))
node))
(and c-ts-mode-emacs-devel
(let ((candidate-1 ; For when point is in the DEFUN statement.
(treesit-node-prev-sibling
(treesit-node-top-level
(treesit-node-at (point))
"compound_statement")))
(candidate-2 ; For when point is in the body.
(treesit-node-top-level
(treesit-node-at (point))
"expression_statement")))
(when-let
((node (or (and (c-ts-mode--emacs-defun-p candidate-1)
candidate-1)
(and (c-ts-mode--emacs-defun-p candidate-2)
candidate-2))))
(if range
(cons (treesit-node-start node)
(treesit-node-end
(treesit-node-next-sibling node)))
node))))))
(defun c-ts-mode-indent-defun () (defun c-ts-mode-indent-defun ()
"Indent the current top-level declaration syntactically. "Indent the current top-level declaration syntactically.
`treesit-defun-type-regexp' defines what constructs to indent." `treesit-defun-type-regexp' defines what constructs to indent."
(interactive "*") (interactive "*")
(when-let ((orig-point (point-marker)) (when-let ((orig-point (point-marker))
(node (treesit-defun-at-point))) (range (c-ts-mode--emacs-defun-at-point t)))
(indent-region (treesit-node-start node) (indent-region (car range) (cdr range))
(treesit-node-end node))
(goto-char orig-point))) (goto-char orig-point)))
(defun c-ts-mode--emacs-current-defun-name ()
"Return the name of the current defun.
This is used for `add-log-current-defun-function'. This
recognizes DEFUN in Emacs sources, in addition to normal function
definitions."
(or (treesit-add-log-current-defun)
(c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point))))
;;; Modes ;;; Modes
(defvar-keymap c-ts-base-mode-map (defvar-keymap c-ts-base-mode-map
@ -933,6 +1014,11 @@ the semicolon. This function skips the semicolon."
;; function_definitions, so we need to find the top-level node. ;; function_definitions, so we need to find the top-level node.
(setq-local treesit-defun-prefer-top-level t) (setq-local treesit-defun-prefer-top-level t)
;; When the code is in incomplete state, try to make a better guess
;; about which node to indent against.
(add-function :filter-args (local 'treesit-indent-function)
#'c-ts-base--before-indent)
;; Indent. ;; Indent.
(when (eq c-ts-mode-indent-style 'linux) (when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t)) (setq-local indent-tabs-mode t))
@ -1008,7 +1094,11 @@ in your configuration."
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c)) (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
;; Navigation. ;; Navigation.
(setq-local treesit-defun-tactic 'top-level) (setq-local treesit-defun-tactic 'top-level)
(treesit-major-mode-setup))) (treesit-major-mode-setup)
(when c-ts-mode-emacs-devel
(setq-local add-log-current-defun-function
#'c-ts-mode--emacs-current-defun-name))))
;;;###autoload ;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++" (define-derived-mode c++-ts-mode c-ts-base-mode "C++"
@ -1050,8 +1140,43 @@ recommended to enable `electric-pair-mode' with this mode."
;; Font-lock. ;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp)) (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp))
(treesit-major-mode-setup)
(when c-ts-mode-emacs-devel
(setq-local add-log-current-defun-function
#'c-ts-mode--emacs-current-defun-name))))
(treesit-major-mode-setup))) (easy-menu-define c-ts-mode-menu (list c-ts-mode-map c++-ts-mode-map)
"Menu for `c-ts-mode' and `c++-ts-mode'."
'("C/C++"
["Comment Out Region" comment-region
:enable mark-active
:help "Comment out the region between the mark and point"]
["Uncomment Region" (comment-region (region-beginning)
(region-end) '(4))
:enable mark-active
:help "Uncomment the region between the mark and point"]
["Indent Top-level Expression" c-ts-mode-indent-defun
:help "Indent/reindent top-level function, class, etc."]
["Indent Line or Region" indent-for-tab-command
:help "Indent current line or region, or insert a tab"]
["Forward Expression" forward-sexp
:help "Move forward across one balanced expression"]
["Backward Expression" backward-sexp
:help "Move back across one balanced expression"]
"--"
("Style..."
["Set Indentation Style..." c-ts-mode-set-style
:help "Set C/C++ indentation style for current buffer"]
["Show Current Indentation Style" (message "Indentation Style: %s"
c-ts-mode-indent-style)
:help "Show the name of the C/C++ indentation style for current buffer"]
["Set Comment Style" c-ts-mode-toggle-comment-style
:help "Toglle C/C++ comment style between block and line comments"])
"--"
("Toggle..."
["SubWord Mode" subword-mode
:style toggle :selected subword-mode
:help "Toggle sub-word movement and editing mode"])))
;; We could alternatively use parsers, but if this works well, I don't ;; We could alternatively use parsers, but if this works well, I don't
;; see the need to change. This is copied verbatim from cc-guess.el. ;; see the need to change. This is copied verbatim from cc-guess.el.

6
lisp/progmodes/eglot.el
View file

@ -250,7 +250,11 @@ chosen (interactively or automatically)."
("csharp-ls")))) ("csharp-ls"))))
(purescript-mode . ("purescript-language-server" "--stdio")) (purescript-mode . ("purescript-language-server" "--stdio"))
((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
(markdown-mode . ("marksman" "server"))) (markdown-mode
. ,(eglot-alternatives
'(("marksman" "server")
("vscode-markdown-language-server" "--stdio"))))
(graphviz-dot-mode . ("dot-language-server" "--stdio")))
"How the command `eglot' guesses the server to start. "How the command `eglot' guesses the server to start.
An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
identifies the buffers that are to be managed by a specific identifies the buffers that are to be managed by a specific

5
lisp/progmodes/project.el
View file

@ -1227,7 +1227,10 @@ To continue searching for the next match, use the
command \\[fileloop-continue]." command \\[fileloop-continue]."
(interactive "sSearch (regexp): ") (interactive "sSearch (regexp): ")
(fileloop-initialize-search (fileloop-initialize-search
regexp (project-files (project-current t)) 'default) regexp
;; XXX: See the comment in project-query-replace-regexp.
(cl-delete-if-not #'file-regular-p (project-files (project-current t)))
'default)
(fileloop-continue)) (fileloop-continue))
;;;###autoload ;;;###autoload

4
lisp/progmodes/ruby-mode.el
View file

@ -1904,13 +1904,13 @@ See `add-log-current-defun-function'."
(progn (progn
(unless (string-equal "self" (car mn)) ; def self.foo (unless (string-equal "self" (car mn)) ; def self.foo
;; def C.foo ;; def C.foo
(let ((ml (nreverse mlist))) (let ((ml (reverse mlist)))
;; If the method name references one of the ;; If the method name references one of the
;; containing modules, drop the more nested ones. ;; containing modules, drop the more nested ones.
(while ml (while ml
(if (string-equal (car ml) (car mn)) (if (string-equal (car ml) (car mn))
(setq mlist (nreverse (cdr ml)) ml nil)) (setq mlist (nreverse (cdr ml)) ml nil))
(or (setq ml (cdr ml)) (nreverse mlist)))) (setq ml (cdr ml))))
(if mlist (if mlist
(setcdr (last mlist) (butlast mn)) (setcdr (last mlist) (butlast mn))
(setq mlist (butlast mn)))) (setq mlist (butlast mn))))

20
lisp/progmodes/sh-script.el
View file

@ -1539,13 +1539,7 @@ implementations. Currently there are two: `sh-mode' and
(lambda (terminator) (lambda (terminator)
(if (eq terminator ?') (if (eq terminator ?')
"'\\'" "'\\'"
"\\"))) "\\"))))
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell (sh--guess-shell) nil nil)
(add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t)
(add-hook 'hack-local-variables-hook
#'sh-after-hack-local-variables nil t))
;;;###autoload ;;;###autoload
(define-derived-mode sh-mode sh-base-mode "Shell-script" (define-derived-mode sh-mode sh-base-mode "Shell-script"
@ -1605,7 +1599,13 @@ with your script for an edit-interpret-debug cycle."
nil nil nil nil
((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil
(font-lock-syntactic-face-function (font-lock-syntactic-face-function
. ,#'sh-font-lock-syntactic-face-function)))) . ,#'sh-font-lock-syntactic-face-function)))
;; Parse or insert magic number for exec, and set all variables depending
;; on the shell thus determined.
(sh-set-shell (sh--guess-shell) nil nil)
(add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t)
(add-hook 'hack-local-variables-hook
#'sh-after-hack-local-variables nil t))
;;;###autoload ;;;###autoload
(defalias 'shell-script-mode 'sh-mode) (defalias 'shell-script-mode 'sh-mode)
@ -1617,6 +1617,10 @@ This mode automatically falls back to `sh-mode' if the buffer is
not written in Bash or sh." not written in Bash or sh."
:syntax-table sh-mode-syntax-table :syntax-table sh-mode-syntax-table
(when (treesit-ready-p 'bash) (when (treesit-ready-p 'bash)
(sh-set-shell "bash" nil nil)
(add-hook 'flymake-diagnostic-functions #'sh-shellcheck-flymake nil t)
(add-hook 'hack-local-variables-hook
#'sh-after-hack-local-variables nil t)
(treesit-parser-create 'bash) (treesit-parser-create 'bash)
(setq-local treesit-font-lock-feature-list (setq-local treesit-font-lock-feature-list
'(( comment function) '(( comment function)

87
lisp/subr.el
View file

@ -1555,31 +1555,32 @@ EVENT may be an event or an event type. If EVENT is a symbol
that has never been used in an event that has been read as input that has never been used in an event that has been read as input
in the current Emacs session, then this function may fail to include in the current Emacs session, then this function may fail to include
the `click' modifier." the `click' modifier."
(let ((type event)) (unless (stringp event)
(if (listp type) (let ((type event))
(setq type (car type))) (if (listp type)
(if (symbolp type) (setq type (car type)))
;; Don't read event-symbol-elements directly since we're not (if (symbolp type)
;; sure the symbol has already been parsed. ;; Don't read event-symbol-elements directly since we're not
(cdr (internal-event-symbol-parse-modifiers type)) ;; sure the symbol has already been parsed.
(let ((list nil) (cdr (internal-event-symbol-parse-modifiers type))
(char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0 (let ((list nil)
?\H-\0 ?\s-\0 ?\A-\0))))) (char (logand type (lognot (logior ?\M-\0 ?\C-\0 ?\S-\0
(if (not (zerop (logand type ?\M-\0))) ?\H-\0 ?\s-\0 ?\A-\0)))))
(push 'meta list)) (if (not (zerop (logand type ?\M-\0)))
(if (or (not (zerop (logand type ?\C-\0))) (push 'meta list))
(< char 32)) (if (or (not (zerop (logand type ?\C-\0)))
(push 'control list)) (< char 32))
(if (or (not (zerop (logand type ?\S-\0))) (push 'control list))
(/= char (downcase char))) (if (or (not (zerop (logand type ?\S-\0)))
(push 'shift list)) (/= char (downcase char)))
(or (zerop (logand type ?\H-\0)) (push 'shift list))
(push 'hyper list)) (or (zerop (logand type ?\H-\0))
(or (zerop (logand type ?\s-\0)) (push 'hyper list))
(push 'super list)) (or (zerop (logand type ?\s-\0))
(or (zerop (logand type ?\A-\0)) (push 'super list))
(push 'alt list)) (or (zerop (logand type ?\A-\0))
list)))) (push 'alt list))
list)))))
(defun event-basic-type (event) (defun event-basic-type (event)
"Return the basic type of the given event (all modifiers removed). "Return the basic type of the given event (all modifiers removed).
@ -1587,17 +1588,18 @@ The value is a printing character (not upper case) or a symbol.
EVENT may be an event or an event type. If EVENT is a symbol EVENT may be an event or an event type. If EVENT is a symbol
that has never been used in an event that has been read as input that has never been used in an event that has been read as input
in the current Emacs session, then this function may return nil." in the current Emacs session, then this function may return nil."
(if (consp event) (unless (stringp event)
(setq event (car event))) (if (consp event)
(if (symbolp event) (setq event (car event)))
(car (get event 'event-symbol-elements)) (if (symbolp event)
(let* ((base (logand event (1- ?\A-\0))) (car (get event 'event-symbol-elements))
(uncontrolled (if (< base 32) (logior base 64) base))) (let* ((base (logand event (1- ?\A-\0)))
;; There are some numbers that are invalid characters and (uncontrolled (if (< base 32) (logior base 64) base)))
;; cause `downcase' to get an error. ;; There are some numbers that are invalid characters and
(condition-case () ;; cause `downcase' to get an error.
(downcase uncontrolled) (condition-case ()
(error uncontrolled))))) (downcase uncontrolled)
(error uncontrolled))))))
(defsubst mouse-movement-p (object) (defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event." "Return non-nil if OBJECT is a mouse movement event."
@ -7208,12 +7210,13 @@ CONDITION is either:
(funcall match (list condition)))) (funcall match (list condition))))
(defun match-buffers (condition &optional buffers arg) (defun match-buffers (condition &optional buffers arg)
"Return a list of buffers that match CONDITION. "Return a list of buffers that match CONDITION, or nil if none match.
See `buffer-match-p' for details on CONDITION. By default all See `buffer-match-p' for various supported CONDITIONs.
buffers are checked, this can be restricted by passing an By default all buffers are checked, but the optional
optional argument BUFFERS, set to a list of buffers to check. argument BUFFERS can restrict that: its value should be
ARG is passed to `buffer-match', for predicate conditions in an explicit list of buffers to check.
CONDITION." Optional argument ARG is passed to `buffer-match-p', for
predicate conditions in CONDITION."
(let (bufs) (let (bufs)
(dolist (buf (or buffers (buffer-list))) (dolist (buf (or buffers (buffer-list)))
(when (buffer-match-p condition (get-buffer buf) arg) (when (buffer-match-p condition (get-buffer buf) arg)

17
lisp/textmodes/ispell.el
View file

@ -214,12 +214,14 @@ Must be greater than 1."
((file-readable-p "/usr/share/lib/dict/words") ((file-readable-p "/usr/share/lib/dict/words")
"/usr/share/lib/dict/words") "/usr/share/lib/dict/words")
((file-readable-p "/sys/dict") "/sys/dict")) ((file-readable-p "/sys/dict") "/sys/dict"))
"Alternate plain word-list dictionary for spelling help." "Alternate plain word-list dictionary for spelling help.
This is also used by `ispell-lookup-words' and `ispell-complete-word'."
:type '(choice file (const :tag "None" nil))) :type '(choice file (const :tag "None" nil)))
(defcustom ispell-complete-word-dict nil (defcustom ispell-complete-word-dict nil
"Plain word-list dictionary used for word completion if "Plain word-list dictionary used for word completion if
different from `ispell-alternate-dictionary'." different from `ispell-alternate-dictionary'.
This is also used by `ispell-lookup-words' and `ispell-complete-word'."
:type '(choice file (const :tag "None" nil))) :type '(choice file (const :tag "None" nil)))
(defcustom ispell-message-dictionary-alist nil (defcustom ispell-message-dictionary-alist nil
@ -2510,7 +2512,9 @@ Otherwise the variable `ispell-grep-command' contains the command
Optional second argument contains the dictionary to use; the default is Optional second argument contains the dictionary to use; the default is
`ispell-alternate-dictionary', overridden by `ispell-complete-word-dict' `ispell-alternate-dictionary', overridden by `ispell-complete-word-dict'
if defined." if defined. If none of LOOKUP-DICT, `ispell-alternate-dictionary',
and `ispell-complete-word-dict' name an existing word-list file,
this function signals an error."
;; We don't use the filter for this function, rather the result is written ;; We don't use the filter for this function, rather the result is written
;; into a buffer. Hence there is no need to save the filter values. ;; into a buffer. Hence there is no need to save the filter values.
(if (null lookup-dict) (if (null lookup-dict)
@ -3685,7 +3689,12 @@ If APPEND is non-nil, don't erase previous debugging output."
If optional INTERIOR-FRAG is non-nil, then the word may be a character If optional INTERIOR-FRAG is non-nil, then the word may be a character
sequence inside of a word. sequence inside of a word.
Standard ispell choices are then available." Standard ispell choices are then available.
This command uses a word-list file specified
by `ispell-alternate-dictionary' or by `ispell-complete-word-dict';
if none of those name an existing word-list file, this command
signals an error."
;; FIXME: completion-at-point-function. ;; FIXME: completion-at-point-function.
(interactive "P") (interactive "P")
(let ((case-fold-search-val case-fold-search) (let ((case-fold-search-val case-fold-search)

98
lisp/treesit.el
View file

@ -88,6 +88,7 @@
(declare-function treesit-search-forward "treesit.c") (declare-function treesit-search-forward "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-subtree-stat "treesit.c") (declare-function treesit-subtree-stat "treesit.c")
(declare-function treesit-node-match-p "treesit.c")
(declare-function treesit-available-p "treesit.c") (declare-function treesit-available-p "treesit.c")
@ -245,21 +246,19 @@ is nil, try to guess the language at BEG using `treesit-language-at'."
Specifically, return the highest parent of NODE that has the same Specifically, return the highest parent of NODE that has the same
type as it. If no such parent exists, return nil. type as it. If no such parent exists, return nil.
If PRED is non-nil, match each parent's type with PRED as a If PRED is non-nil, match each parent's type with PRED rather
regexp, rather than using NODE's type. PRED can also be a than using NODE's type. PRED can also be a predicate function,
function that takes the node as an argument, and return and more. See `treesit-thing-settings' for details.
non-nil/nil for match/no match.
If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
(let ((pred (or pred (treesit-node-type node))) (let ((pred (or pred (rx-to-string
`(bos ,(treesit-node-type node) eos))))
(result nil)) (result nil))
(cl-loop for cursor = (if include-node node (cl-loop for cursor = (if include-node node
(treesit-node-parent node)) (treesit-node-parent node))
then (treesit-node-parent cursor) then (treesit-node-parent cursor)
while cursor while cursor
if (if (stringp pred) if (treesit-node-match-p cursor pred)
(string-match-p pred (treesit-node-type cursor))
(funcall pred cursor))
do (setq result cursor)) do (setq result cursor))
result)) result))
@ -1887,21 +1886,10 @@ nil.")
"The delimiter used to connect several defun names. "The delimiter used to connect several defun names.
This is used in `treesit-add-log-current-defun'.") This is used in `treesit-add-log-current-defun'.")
(defsubst treesit--thing-unpack-pattern (pattern) (defun treesit-beginning-of-thing (pred &optional arg tactic)
"Unpack PATTERN in the shape of `treesit-defun-type-regexp'.
Basically,
(unpack REGEXP) = (REGEXP . nil)
(unpack (REGEXP . PRED)) = (REGEXP . PRED)"
(if (consp pattern)
pattern
(cons pattern nil)))
(defun treesit-beginning-of-thing (pattern &optional arg tactic)
"Like `beginning-of-defun', but generalized into things. "Like `beginning-of-defun', but generalized into things.
PATTERN is like `treesit-defun-type-regexp', ARG PRED is like `treesit-defun-type-regexp', ARG
is the same as in `beginning-of-defun'. is the same as in `beginning-of-defun'.
TACTIC determines how does this function move between things. It TACTIC determines how does this function move between things. It
@ -1916,17 +1904,15 @@ should there be one. If omitted, TACTIC is considered to be
Return non-nil if successfully moved, nil otherwise." Return non-nil if successfully moved, nil otherwise."
(pcase-let* ((arg (or arg 1)) (pcase-let* ((arg (or arg 1))
(`(,regexp . ,pred) (treesit--thing-unpack-pattern
pattern))
(dest (treesit--navigate-thing (dest (treesit--navigate-thing
(point) (- arg) 'beg regexp pred tactic))) (point) (- arg) 'beg pred tactic)))
(when dest (when dest
(goto-char dest)))) (goto-char dest))))
(defun treesit-end-of-thing (pattern &optional arg tactic) (defun treesit-end-of-thing (pred &optional arg tactic)
"Like `end-of-defun', but generalized into things. "Like `end-of-defun', but generalized into things.
PATTERN is like `treesit-defun-type-regexp', ARG is the same as PRED is like `treesit-defun-type-regexp', ARG is the same as
in `end-of-defun'. in `end-of-defun'.
TACTIC determines how does this function move between things. It TACTIC determines how does this function move between things. It
@ -1941,10 +1927,8 @@ should there be one. If omitted, TACTIC is considered to be
Return non-nil if successfully moved, nil otherwise." Return non-nil if successfully moved, nil otherwise."
(pcase-let* ((arg (or arg 1)) (pcase-let* ((arg (or arg 1))
(`(,regexp . ,pred) (treesit--thing-unpack-pattern
pattern))
(dest (treesit--navigate-thing (dest (treesit--navigate-thing
(point) arg 'end regexp pred tactic))) (point) arg 'end pred tactic)))
(when dest (when dest
(goto-char dest)))) (goto-char dest))))
@ -2069,7 +2053,7 @@ the current line if the beginning of the defun is indented."
;; parent: ;; parent:
;; 1. node covers pos ;; 1. node covers pos
;; 2. smallest such node ;; 2. smallest such node
(defun treesit--things-around (pos regexp &optional pred) (defun treesit--things-around (pos pred)
"Return the previous, next, and parent thing around POS. "Return the previous, next, and parent thing around POS.
Return a list of (PREV NEXT PARENT), where PREV and NEXT are Return a list of (PREV NEXT PARENT), where PREV and NEXT are
@ -2077,7 +2061,8 @@ previous and next sibling things around POS, and PARENT is the
parent thing surrounding POS. All of three could be nil if no parent thing surrounding POS. All of three could be nil if no
sound things exists. sound things exists.
REGEXP and PRED are the same as in `treesit-thing-at-point'." PRED can be a regexp, a predicate function, and more. See
`treesit-thing-settings' for details."
(let* ((node (treesit-node-at pos)) (let* ((node (treesit-node-at pos))
(result (list nil nil nil))) (result (list nil nil nil)))
;; 1. Find previous and next sibling defuns. ;; 1. Find previous and next sibling defuns.
@ -2100,9 +2085,7 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'."
when node when node
do (let ((cursor node) do (let ((cursor node)
(iter-pred (lambda (node) (iter-pred (lambda (node)
(and (string-match-p (and (treesit-node-match-p node pred)
regexp (treesit-node-type node))
(or (null pred) (funcall pred node))
(funcall pos-pred node))))) (funcall pos-pred node)))))
;; Find the node just before/after POS to start searching. ;; Find the node just before/after POS to start searching.
(save-excursion (save-excursion
@ -2116,13 +2099,11 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'."
(setf (nth idx result) (setf (nth idx result)
(treesit-node-top-level cursor iter-pred t)) (treesit-node-top-level cursor iter-pred t))
(setq cursor (treesit-search-forward (setq cursor (treesit-search-forward
cursor regexp backward backward))))) cursor pred backward backward)))))
;; 2. Find the parent defun. ;; 2. Find the parent defun.
(let ((cursor (or (nth 0 result) (nth 1 result) node)) (let ((cursor (or (nth 0 result) (nth 1 result) node))
(iter-pred (lambda (node) (iter-pred (lambda (node)
(and (string-match-p (and (treesit-node-match-p node pred)
regexp (treesit-node-type node))
(or (null pred) (funcall pred node))
(not (treesit-node-eq node (nth 0 result))) (not (treesit-node-eq node (nth 0 result)))
(not (treesit-node-eq node (nth 1 result))) (not (treesit-node-eq node (nth 1 result)))
(< (treesit-node-start node) (< (treesit-node-start node)
@ -2132,15 +2113,6 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'."
(treesit-parent-until cursor iter-pred))) (treesit-parent-until cursor iter-pred)))
result)) result))
(defun treesit--top-level-thing (node regexp &optional pred)
"Return the top-level parent thing of NODE.
REGEXP and PRED are the same as in `treesit-thing-at-point'."
(treesit-node-top-level
node (lambda (node)
(and (string-match-p regexp (treesit-node-type node))
(or (null pred) (funcall pred node))))
t))
;; The basic idea for nested defun navigation is that we first try to ;; The basic idea for nested defun navigation is that we first try to
;; move across sibling defuns in the same level, if no more siblings ;; move across sibling defuns in the same level, if no more siblings
;; exist, we move to parents's beg/end, rinse and repeat. We never ;; exist, we move to parents's beg/end, rinse and repeat. We never
@ -2168,7 +2140,7 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'."
;; -> Obviously we don't want to go to parent's end, instead, we ;; -> Obviously we don't want to go to parent's end, instead, we
;; want to go to parent's prev-sibling's end. Again, we recurse ;; want to go to parent's prev-sibling's end. Again, we recurse
;; in the function to do that. ;; in the function to do that.
(defun treesit--navigate-thing (pos arg side regexp &optional pred tactic recursing) (defun treesit--navigate-thing (pos arg side pred &optional tactic recursing)
"Navigate thing ARG steps from POS. "Navigate thing ARG steps from POS.
If ARG is positive, move forward that many steps, if negative, If ARG is positive, move forward that many steps, if negative,
@ -2179,7 +2151,8 @@ This function doesn't actually move point, it just returns the
position it would move to. If there aren't enough things to move position it would move to. If there aren't enough things to move
across, return nil. across, return nil.
REGEXP and PRED are the same as in `treesit-thing-at-point'. PRED can be a regexp, a predicate function, and more. See
`treesit-thing-settings' for details.
TACTIC determines how does this function move between things. It TACTIC determines how does this function move between things. It
can be `nested', `top-level', `restricted', or nil. `nested' can be `nested', `top-level', `restricted', or nil. `nested'
@ -2208,14 +2181,13 @@ function is called recursively."
(while (> counter 0) (while (> counter 0)
(pcase-let (pcase-let
((`(,prev ,next ,parent) ((`(,prev ,next ,parent)
(treesit--things-around pos regexp pred))) (treesit--things-around pos pred)))
;; When PARENT is nil, nested and top-level are the same, if ;; When PARENT is nil, nested and top-level are the same, if
;; there is a PARENT, make PARENT to be the top-level parent ;; there is a PARENT, make PARENT to be the top-level parent
;; and pretend there is no nested PREV and NEXT. ;; and pretend there is no nested PREV and NEXT.
(when (and (eq tactic 'top-level) (when (and (eq tactic 'top-level)
parent) parent)
(setq parent (treesit--top-level-thing (setq parent (treesit-node-top-level parent pred t)
parent regexp pred)
prev nil prev nil
next nil)) next nil))
;; If TACTIC is `restricted', the implementation is very simple. ;; If TACTIC is `restricted', the implementation is very simple.
@ -2247,7 +2219,7 @@ function is called recursively."
;; the end of next before recurring.) ;; the end of next before recurring.)
(setq pos (or (treesit--navigate-thing (setq pos (or (treesit--navigate-thing
(treesit-node-end (or next parent)) (treesit-node-end (or next parent))
1 'beg regexp pred tactic t) 1 'beg pred tactic t)
(throw 'term nil))) (throw 'term nil)))
;; Normal case. ;; Normal case.
(setq pos (funcall advance (or next parent)))) (setq pos (funcall advance (or next parent))))
@ -2259,7 +2231,7 @@ function is called recursively."
;; Special case: go to prev end-of-defun. ;; Special case: go to prev end-of-defun.
(setq pos (or (treesit--navigate-thing (setq pos (or (treesit--navigate-thing
(treesit-node-start (or prev parent)) (treesit-node-start (or prev parent))
-1 'end regexp pred tactic t) -1 'end pred tactic t)
(throw 'term nil))) (throw 'term nil)))
;; Normal case. ;; Normal case.
(setq pos (funcall advance (or prev parent)))))) (setq pos (funcall advance (or prev parent))))))
@ -2269,21 +2241,17 @@ function is called recursively."
(if (eq counter 0) pos nil))) (if (eq counter 0) pos nil)))
;; TODO: In corporate into thing-at-point. ;; TODO: In corporate into thing-at-point.
(defun treesit-thing-at-point (pattern tactic) (defun treesit-thing-at-point (pred tactic)
"Return the thing node at point or nil if none is found. "Return the thing node at point or nil if none is found.
\"Thing\" is defined by PATTERN, which can be either a string \"Thing\" is defined by PRED, which can be a regexp, a
REGEXP or a cons cell (REGEXP . PRED): if a node's type matches predication function, and more, see `treesit-thing-settings'
REGEXP, it is a thing. The \"thing\" could be further restricted for details.
by PRED: if non-nil, PRED should be a function that takes a node
and returns t if the node is a \"thing\", and nil if not.
Return the top-level defun if TACTIC is `top-level', return the Return the top-level defun if TACTIC is `top-level', return the
immediate parent thing if TACTIC is `nested'." immediate parent thing if TACTIC is `nested'."
(pcase-let* ((`(,regexp . ,pred) (pcase-let* ((`(,_ ,next ,parent)
(treesit--thing-unpack-pattern pattern)) (treesit--things-around (point) pred))
(`(,_ ,next ,parent)
(treesit--things-around (point) regexp pred))
;; If point is at the beginning of a thing, we ;; If point is at the beginning of a thing, we
;; prioritize that thing over the parent in nested ;; prioritize that thing over the parent in nested
;; mode. ;; mode.
@ -2291,7 +2259,7 @@ immediate parent thing if TACTIC is `nested'."
next) next)
parent))) parent)))
(if (eq tactic 'top-level) (if (eq tactic 'top-level)
(treesit--top-level-thing node regexp pred) (treesit-node-top-level node pred t)
node))) node)))
(defun treesit-defun-at-point () (defun treesit-defun-at-point ()

2
lisp/vc/vc.el
View file

@ -1594,7 +1594,7 @@ After check-out, runs the normal hook `vc-checkout-hook'."
(vc-call make-version-backups-p file) (vc-call make-version-backups-p file)
(vc-up-to-date-p file) (vc-up-to-date-p file)
(vc-make-version-backup file)) (vc-make-version-backup file))
(let ((backend (vc-backend file))) (let ((backend (or (bound-and-true-p vc-dir-backend) (vc-backend file))))
(with-vc-properties (list file) (with-vc-properties (list file)
(condition-case err (condition-case err
(vc-call-backend backend 'checkout file rev) (vc-call-backend backend 'checkout file rev)

116
lisp/x-dnd.el
View file

@ -34,20 +34,20 @@
;;; Customizable variables ;;; Customizable variables
(defcustom x-dnd-test-function #'x-dnd-default-test-function (defcustom x-dnd-test-function #'x-dnd-default-test-function
"The function drag and drop uses to determine if to accept or reject a drop. "Function to be used by drag-and-drop to determine whether to accept a drop.
The function takes three arguments, WINDOW, ACTION and TYPES. The function takes three arguments: WINDOW, ACTION, and TYPES.
WINDOW is where the mouse is when the function is called. WINDOW WINDOW is where the window under the mouse is when the function is called.
may be a frame if the mouse isn't over a real window (i.e. menu WINDOW may be a frame if the mouse isn't over a real window (e.g., menu
bar, tool bar or scroll bar). ACTION is the suggested action bar, tool bar, scroll bar, etc.).
from the drag and drop source, one of the symbols move, copy, ACTION is the suggested action from the drag and drop source, one of the
link or ask. TYPES is a vector of available types for the drop. symbols `move', `copy', `link' or `ask'.
TYPES is a vector of available types for the drop.
Each element of TYPE should either be a string (containing the Each element of TYPES should either be a string (containing the
name of the type's X atom), or a symbol, whose name will be used. name of the type's X atom), or a symbol, whose name will be used.
The function shall return nil to reject the drop or a cons with The function shall return nil to reject the drop or a cons with
two values, the wanted action as car and the wanted type as cdr. two values, the wanted action as `car' and the wanted type as `cdr'.
The wanted action can be copy, move, link, ask or private. The wanted action can be `copy', `move', `link', `ask' or `private'.
The default value for this variable is `x-dnd-default-test-function'." The default value for this variable is `x-dnd-default-test-function'."
:version "22.1" :version "22.1"
@ -70,14 +70,18 @@ The default value for this variable is `x-dnd-default-test-function'."
(,(purecopy "DndTypeFile") . x-dnd-handle-offix-file) (,(purecopy "DndTypeFile") . x-dnd-handle-offix-file)
(,(purecopy "DndTypeFiles") . x-dnd-handle-offix-files) (,(purecopy "DndTypeFiles") . x-dnd-handle-offix-files)
(,(purecopy "DndTypeText") . dnd-insert-text)) (,(purecopy "DndTypeText") . dnd-insert-text))
"Which function to call to handle a drop of that type. "Functions to call to handle drag-and-drop of known types.
If the type for the drop is not present, or the function is nil, If the type of the drop is not present in the alist, or the
the drop is rejected. The function takes three arguments, WINDOW, ACTION function corresponding to the type is nil, the drop of that
and DATA. WINDOW is where the drop occurred, ACTION is the action for type will be rejected.
this drop (copy, move, link, private or ask) as determined by a previous
call to `x-dnd-test-function'. DATA is the drop data. Each function takes three arguments: WINDOW, ACTION, and DATA.
The function shall return the action used (copy, move, link or private) WINDOW is the window where the drop occurred.
if drop is successful, nil if not." ACTION is the action for this drop (`copy', `move', `link', `private'
or `ask'), as determined by a previous call to `x-dnd-test-function'.
DATA is the drop data.
The function shall return the action it used (one of the above,
excluding `ask') if drop is successful, nil if not."
:version "22.1" :version "22.1"
:type 'alist :type 'alist
:group 'x) :group 'x)
@ -122,22 +126,27 @@ like xterm) for text."
:group 'x) :group 'x)
(defcustom x-dnd-direct-save-function #'x-dnd-save-direct (defcustom x-dnd-direct-save-function #'x-dnd-save-direct
"Function called when a file is dropped that Emacs must save. "Function called when a file is dropped via XDS protocol.
It is called with two arguments: the first is either nil or t, The value should be a function of two arguments that supports
and the second is a string. the X Direct Save (XDS) protocol. The function will be called
twice during the protocol execution.
If the first argument is t, the second argument is the name the When the function is called with the first argument non-nil,
dropped file should be saved under. The function should return a it should return an absolute file name whose base name is
complete file name describing where the file should be saved. the value of the second argument, a string. The return value
is the file name for the dragged file to be saved. The function
can also return nil if saving the file should be refused for some
reason; in that case the drop will be canceled.
It can also return nil, which means to cancel the drop. When the function is called with the first argument nil, the
second argument specifies the file name where the file was saved;
If the first argument is nil, the second is the name of the file the function should then do whatever is appropriate when such a
that was dropped." file is saved, like show the file in the Dired buffer or visit
the file."
:version "29.1" :version "29.1"
:type '(choice (const :tag "Prompt for name before saving" :type '(choice (const :tag "Prompt for file name to save"
x-dnd-save-direct) x-dnd-save-direct)
(const :tag "Save and open immediately without prompting" (const :tag "Save in `default-directory' without prompting"
x-dnd-save-direct-immediately) x-dnd-save-direct-immediately)
(function :tag "Other function")) (function :tag "Other function"))
:group 'x) :group 'x)
@ -222,14 +231,14 @@ any protocol specific data.")
(cdr (x-dnd-get-state-cons-for-frame frame-or-window))) (cdr (x-dnd-get-state-cons-for-frame frame-or-window)))
(defun x-dnd-default-test-function (_window _action types) (defun x-dnd-default-test-function (_window _action types)
"The default test function for drag and drop. "The default test function for drag-and-drop.
WINDOW is where the mouse is when this function is called. It WINDOW is where the mouse is when this function is called. It
may be a frame if the mouse is over the menu bar, scroll bar or may be a frame if the mouse is over the menu bar, scroll bar or
tool bar. ACTION is the suggested action from the source, and tool bar. ACTION is the suggested action from the source, and
TYPES are the types the drop data can have. This function only TYPES are the types the drop data can have. This function only
accepts drops with types in `x-dnd-known-types'. It always accepts drops with types in `x-dnd-known-types'. It always
returns the action `private', unless `types' contains a value returns the action `private', unless `types' contains a value
inside `x-dnd-copy-types'." inside `x-dnd-copy-types', in which case it may return `copy'."
(let ((type (x-dnd-choose-type types))) (let ((type (x-dnd-choose-type types)))
(when type (let ((list x-dnd-copy-types)) (when type (let ((list x-dnd-copy-types))
(catch 'out (catch 'out
@ -1564,17 +1573,24 @@ was taken, or the direct save failed."
(when (not (equal file-name original-file-name)) (when (not (equal file-name original-file-name))
(delete-file file-name))))) (delete-file file-name)))))
(defun x-dnd-save-direct (need-name name) (defun x-dnd-save-direct (need-name filename)
"Handle dropping a file that should be saved immediately. "Handle dropping a file FILENAME that should be saved first, asking the user.
NEED-NAME tells whether or not the file was not yet saved. NAME NEED-NAME non-nil means the caller requests the full absolute
is either the name of the file, or the name the drop source wants file name of FILENAME under which to save it; FILENAME is just
us to save under. the base name in that case. The function then prompts the user
for where to save to file and returns the result to the caller.
Prompt the user for a file name, then open it." NEED-NAME nil means the file was saved as FILENAME (which should
be the full absolute file name in that case). The function then
refreshes the Dired display, if the current buffer is in Dired
mode, or visits the file otherwise.
This function is intended to be the value of `x-dnd-direct-save-function',
which see."
(if need-name (if need-name
(let ((file-name (read-file-name "Write file: " (let ((file-name (read-file-name "Write file: "
default-directory default-directory
nil nil name))) nil nil filename)))
(when (file-exists-p file-name) (when (file-exists-p file-name)
(unless (y-or-n-p (format-message (unless (y-or-n-p (format-message
"File `%s' exists; overwrite? " file-name)) "File `%s' exists; overwrite? " file-name))
@ -1584,18 +1600,18 @@ Prompt the user for a file name, then open it."
;; interface can be found. ;; interface can be found.
(if (derived-mode-p 'dired-mode) (if (derived-mode-p 'dired-mode)
(revert-buffer) (revert-buffer)
(find-file name)))) (find-file filename))))
(defun x-dnd-save-direct-immediately (need-name name) (defun x-dnd-save-direct-immediately (need-name filename)
"Save and open a dropped file, like `x-dnd-save-direct'. "Handle dropping a file FILENAME that should be saved first.
NEED-NAME tells whether or not the file was not yet saved. NAME Like `x-dnd-save-direct', but do not prompt for the file name;
is either the name of the file, or the name the drop source wants instead, return its absolute file name for saving in the current
us to save under. directory.
Unlike `x-dnd-save-direct', do not prompt for the name by which This function is intended to be the value of `x-dnd-direct-save-function',
to save the file. Simply save it in the current directory." which see."
(if need-name (if need-name
(let ((file-name (expand-file-name name))) (let ((file-name (expand-file-name filename)))
(when (file-exists-p file-name) (when (file-exists-p file-name)
(unless (y-or-n-p (format-message (unless (y-or-n-p (format-message
"File `%s' exists; overwrite? " file-name)) "File `%s' exists; overwrite? " file-name))
@ -1605,7 +1621,7 @@ to save the file. Simply save it in the current directory."
;; interface can be found. ;; interface can be found.
(if (derived-mode-p 'dired-mode) (if (derived-mode-p 'dired-mode)
(revert-buffer) (revert-buffer)
(find-file name)))) (find-file filename))))
(defun x-dnd-handle-octet-stream-for-drop (save-to) (defun x-dnd-handle-octet-stream-for-drop (save-to)
"Save the contents of the XDS selection to SAVE-TO. "Save the contents of the XDS selection to SAVE-TO.

50
src/macfont.m
View file

@ -632,21 +632,35 @@ get_cgcolor_from_nscolor (NSColor *nsColor, struct frame *f)
#define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face) \ #define CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND(context, face) \
do { \ do { \
CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ CGColorRef refcol = get_cgcolor (NS_FACE_FOREGROUND (face)); \
CGContextSetFillColorWithColor (context, refcol_) ; \ CGContextSetFillColorWithColor (context, refcol); \
CGColorRelease (refcol_); \ CGColorRelease (refcol); \
} while (0) } while (0)
#define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face) \ #define CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND(context, face) \
do { \ do { \
CGColorRef refcol_ = get_cgcolor (NS_FACE_BACKGROUND (face)); \ CGColorRef refcol = get_cgcolor (NS_FACE_BACKGROUND (face)); \
CGContextSetFillColorWithColor (context, refcol_); \ CGContextSetFillColorWithColor (context, refcol); \
CGColorRelease (refcol_); \ CGColorRelease (refcol); \
} while (0)
#define CG_SET_FILL_COLOR_WITH_FRAME_CURSOR(context, frame) \
do { \
CGColorRef refcol \
= get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (frame), frame); \
CGContextSetFillColorWithColor (context, refcol); \
CGColorRelease (refcol); \
} while (0)
#define CG_SET_FILL_COLOR_WITH_FRAME_BACKGROUND(context, frame) \
do { \
CGColorRef refcol \
= get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (frame), frame); \
CGContextSetFillColorWithColor (context, refcol); \
CGColorRelease (refcol); \
} while (0) } while (0)
#define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face) \ #define CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND(context, face) \
do { \ do { \
CGColorRef refcol_ = get_cgcolor (NS_FACE_FOREGROUND (face)); \ CGColorRef refcol = get_cgcolor (NS_FACE_FOREGROUND (face)); \
CGContextSetStrokeColorWithColor (context, refcol_); \ CGContextSetStrokeColorWithColor (context, refcol); \
CGColorRelease (refcol_); \ CGColorRelease (refcol); \
} while (0) } while (0)
@ -2933,9 +2947,12 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
{ {
if (s->hl == DRAW_CURSOR) if (s->hl == DRAW_CURSOR)
{ {
CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_CURSOR_COLOR (f), f); if (face && (NS_FACE_BACKGROUND (face)
CGContextSetFillColorWithColor (context, colorref); == [(NSColor *) FRAME_CURSOR_COLOR (f)
CGColorRelease (colorref); unsignedLong]))
CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face);
else
CG_SET_FILL_COLOR_WITH_FRAME_CURSOR (context, f);
} }
else else
CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face); CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face);
@ -2949,9 +2966,12 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
CGContextScaleCTM (context, 1, -1); CGContextScaleCTM (context, 1, -1);
if (s->hl == DRAW_CURSOR) if (s->hl == DRAW_CURSOR)
{ {
CGColorRef colorref = get_cgcolor_from_nscolor (FRAME_BACKGROUND_COLOR (f), f); if (face && (NS_FACE_BACKGROUND (face)
CGContextSetFillColorWithColor (context, colorref); == [(NSColor *) FRAME_CURSOR_COLOR (f)
CGColorRelease (colorref); unsignedLong]))
CG_SET_FILL_COLOR_WITH_FACE_BACKGROUND (context, face);
else
CG_SET_FILL_COLOR_WITH_FRAME_BACKGROUND (context, f);
} }
else else
CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face); CG_SET_FILL_COLOR_WITH_FACE_FOREGROUND (context, face);

20
src/nsterm.m
View file

@ -3750,14 +3750,18 @@ ns_maybe_dumpglyphs_background (struct glyph_string *s, char force_p)
{ {
struct face *face = s->face; struct face *face = s->face;
if (!face->stipple) if (!face->stipple)
{ {
if (s->hl != DRAW_CURSOR) if (s->hl != DRAW_CURSOR)
[(NS_FACE_BACKGROUND (face) != 0 [(NS_FACE_BACKGROUND (face) != 0
? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)] ? [NSColor colorWithUnsignedLong:NS_FACE_BACKGROUND (face)]
: FRAME_BACKGROUND_COLOR (s->f)) set]; : FRAME_BACKGROUND_COLOR (s->f)) set];
else else if (face && (NS_FACE_BACKGROUND (face)
[FRAME_CURSOR_COLOR (s->f) set]; == [(NSColor *) FRAME_CURSOR_COLOR (s->f)
} unsignedLong]))
[[NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (face)] set];
else
[FRAME_CURSOR_COLOR (s->f) set];
}
else else
{ {
struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); struct ns_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);

256
src/treesit.c
View file

@ -421,10 +421,17 @@ static Lisp_Object Vtreesit_str_match;
static Lisp_Object Vtreesit_str_pred; static Lisp_Object Vtreesit_str_pred;
/* This is the limit on recursion levels for some tree-sitter /* This is the limit on recursion levels for some tree-sitter
functions. Remember to update docstrings when changing this functions. Remember to update docstrings when changing this value.
value. */
const ptrdiff_t treesit_recursion_limit = 1000; If we think of programs and AST, it is very rare for any program to
bool treesit_initialized = false; have a very deep AST. For example, you would need 1000+ levels of
nested if-statements, or a struct somehow nested for 1000+ levels.
It’s hard for me to imagine any hand-written or machine generated
program to be like that. So I think 1000 is already generous. If
we look at xdisp.c, its AST only have 30 levels. */
#define TREESIT_RECURSION_LIMIT 1000
static bool treesit_initialized = false;
static bool static bool
load_tree_sitter_if_necessary (bool required) load_tree_sitter_if_necessary (bool required)
@ -478,40 +485,47 @@ treesit_initialize (void)
static void static void
treesit_symbol_to_c_name (char *symbol_name) treesit_symbol_to_c_name (char *symbol_name)
{ {
for (int idx = 0; idx < strlen (symbol_name); idx++) size_t len = strlen (symbol_name);
for (int idx = 0; idx < len; idx++)
{ {
if (symbol_name[idx] == '-') if (symbol_name[idx] == '-')
symbol_name[idx] = '_'; symbol_name[idx] = '_';
} }
} }
/* Find the override name for LANGUAGE_SYMBOL in
treesit-load-name-override-list. Set NAME and C_SYMBOL to the
override name, and return true if there exists one, otherwise
return false.
This function may signal if treesit-load-name-override-list is
malformed. */
static bool static bool
treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name, treesit_find_override_name (Lisp_Object language_symbol, Lisp_Object *name,
Lisp_Object *c_symbol) Lisp_Object *c_symbol)
{ {
Lisp_Object tem;
CHECK_LIST (Vtreesit_load_name_override_list); CHECK_LIST (Vtreesit_load_name_override_list);
Lisp_Object tail = Vtreesit_load_name_override_list;
tem = Vtreesit_load_name_override_list; FOR_EACH_TAIL (tail)
FOR_EACH_TAIL (tem)
{ {
Lisp_Object lang = XCAR (XCAR (tem)); Lisp_Object entry = XCAR (tail);
CHECK_LIST (entry);
Lisp_Object lang = XCAR (entry);
CHECK_SYMBOL (lang); CHECK_SYMBOL (lang);
if (EQ (lang, language_symbol)) if (EQ (lang, language_symbol))
{ {
*name = Fnth (make_fixnum (1), XCAR (tem)); *name = Fnth (make_fixnum (1), entry);
CHECK_STRING (*name); CHECK_STRING (*name);
*c_symbol = Fnth (make_fixnum (2), XCAR (tem)); *c_symbol = Fnth (make_fixnum (2), entry);
CHECK_STRING (*c_symbol); CHECK_STRING (*c_symbol);
return true; return true;
} }
} }
CHECK_LIST_END (tem, Vtreesit_load_name_override_list); CHECK_LIST_END (tail, Vtreesit_load_name_override_list);
return false; return false;
} }
@ -1619,6 +1633,9 @@ buffer. */)
TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len); TSRange *treesit_ranges = xmalloc (sizeof (TSRange) * len);
struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer); struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer);
/* We can use XFUXNUM, XCAR, XCDR freely because we have checked
the input by treesit_check_range_argument. */
for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges)) for (int idx = 0; !NILP (ranges); idx++, ranges = XCDR (ranges))
{ {
Lisp_Object range = XCAR (ranges); Lisp_Object range = XCAR (ranges);
@ -1639,9 +1656,6 @@ buffer. */)
} }
success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser, success = ts_parser_set_included_ranges (XTS_PARSER (parser)->parser,
treesit_ranges, len); treesit_ranges, len);
/* Although XFIXNUM could signal, it should be impossible
because we have checked the input by treesit_check_range_argument.
So there is no need for unwind-protect. */
xfree (treesit_ranges); xfree (treesit_ranges);
} }
@ -2295,11 +2309,11 @@ See Info node `(elisp)Pattern Matching' for detailed explanation. */)
{ {
if (BASE_EQ (pattern, QCanchor)) if (BASE_EQ (pattern, QCanchor))
return Vtreesit_str_dot; return Vtreesit_str_dot;
if (BASE_EQ (pattern, intern_c_string (":?"))) if (BASE_EQ (pattern, QCquestion))
return Vtreesit_str_question_mark; return Vtreesit_str_question_mark;
if (BASE_EQ (pattern, intern_c_string (":*"))) if (BASE_EQ (pattern, QCstar))
return Vtreesit_str_star; return Vtreesit_str_star;
if (BASE_EQ (pattern, intern_c_string (":+"))) if (BASE_EQ (pattern, QCplus))
return Vtreesit_str_plus; return Vtreesit_str_plus;
if (BASE_EQ (pattern, QCequal)) if (BASE_EQ (pattern, QCequal))
return Vtreesit_str_pound_equal; return Vtreesit_str_pound_equal;
@ -3008,7 +3022,7 @@ treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser)
TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree); TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree);
*cursor = ts_tree_cursor_new (root); *cursor = ts_tree_cursor_new (root);
bool success = treesit_cursor_helper_1 (cursor, &node, end_pos, bool success = treesit_cursor_helper_1 (cursor, &node, end_pos,
treesit_recursion_limit); TREESIT_RECURSION_LIMIT);
if (!success) if (!success)
ts_tree_cursor_delete (cursor); ts_tree_cursor_delete (cursor);
return success; return success;
@ -3139,17 +3153,80 @@ treesit_traverse_child_helper (TSTreeCursor *cursor,
} }
} }
/* Assq but doesn't signal. */
static Lisp_Object
safe_assq (Lisp_Object key, Lisp_Object alist)
{
Lisp_Object tail = alist;
FOR_EACH_TAIL_SAFE (tail)
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
return Qnil;
}
/* Given a symbol THING, and a language symbol LANGUAGE, find the
corresponding predicate definition in treesit-things-settings.
Don't check for the type of THING and LANGUAGE.
If there isn't one, return Qnil. */
static Lisp_Object
treesit_traverse_get_predicate (Lisp_Object thing, Lisp_Object language)
{
Lisp_Object cons = safe_assq (language, Vtreesit_thing_settings);
if (NILP (cons))
return Qnil;
Lisp_Object definitions = XCDR (cons);
Lisp_Object entry = safe_assq (thing, definitions);
if (NILP (entry))
return Qnil;
/* ENTRY looks like (THING PRED). */
Lisp_Object cdr = XCDR (entry);
if (!CONSP (cdr))
return Qnil;
return XCAR (cdr);
}
/* Validate the PRED passed to treesit_traverse_match_predicate. If /* Validate the PRED passed to treesit_traverse_match_predicate. If
there's an error, set SIGNAL_DATA to something signal accepts, and there's an error, set SIGNAL_DATA to something signal accepts, and
return false, otherwise return true. */ return false, otherwise return true. This function also check for
recusion levels: we place a arbitrary 100 level limit on recursive
predicates. RECURSION_LEVEL is the current recursion level (that
starts at 0), if it goes over 99, return false and set
SIGNAL_DATA. LANGUAGE is a LANGUAGE symbol. */
static bool static bool
treesit_traverse_validate_predicate (Lisp_Object pred, treesit_traverse_validate_predicate (Lisp_Object pred,
Lisp_Object *signal_data) Lisp_Object language,
Lisp_Object *signal_data,
ptrdiff_t recursion_level)
{ {
if (recursion_level > 99)
{
*signal_data = list1 (build_string ("Predicate recursion level "
"exceeded: it must not exceed "
"100 levels"));
return false;
}
if (STRINGP (pred)) if (STRINGP (pred))
return true; return true;
else if (FUNCTIONP (pred)) else if (FUNCTIONP (pred))
return true; return true;
else if (SYMBOLP (pred))
{
Lisp_Object definition = treesit_traverse_get_predicate (pred,
language);
if (NILP (definition))
{
*signal_data = list2 (build_string ("Cannot find the definition "
"of the predicate in "
"`treesit-things-settings'"),
pred);
return false;
}
return treesit_traverse_validate_predicate (definition,
language,
signal_data,
recursion_level + 1);
}
else if (CONSP (pred)) else if (CONSP (pred))
{ {
Lisp_Object car = XCAR (pred); Lisp_Object car = XCAR (pred);
@ -3172,7 +3249,9 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
return false; return false;
} }
return treesit_traverse_validate_predicate (XCAR (cdr), return treesit_traverse_validate_predicate (XCAR (cdr),
signal_data); language,
signal_data,
recursion_level + 1);
} }
else if (BASE_EQ (car, Qor)) else if (BASE_EQ (car, Qor))
{ {
@ -3187,7 +3266,9 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
FOR_EACH_TAIL (cdr) FOR_EACH_TAIL (cdr)
{ {
if (!treesit_traverse_validate_predicate (XCAR (cdr), if (!treesit_traverse_validate_predicate (XCAR (cdr),
signal_data)) language,
signal_data,
recursion_level + 1))
return false; return false;
} }
return true; return true;
@ -3195,8 +3276,7 @@ treesit_traverse_validate_predicate (Lisp_Object pred,
else if (STRINGP (car) && FUNCTIONP (cdr)) else if (STRINGP (car) && FUNCTIONP (cdr))
return true; return true;
} }
*signal_data = list2 (build_string ("Invalid predicate, see TODO for " *signal_data = list2 (build_string ("Invalid predicate, see `treesit-thing-settings' for valid forms of predicate"),
"valid forms of predicate"),
pred); pred);
return false; return false;
} }
@ -3232,6 +3312,14 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
Lisp_Object lisp_node = make_treesit_node (parser, node); Lisp_Object lisp_node = make_treesit_node (parser, node);
return !NILP (CALLN (Ffuncall, pred, lisp_node)); return !NILP (CALLN (Ffuncall, pred, lisp_node));
} }
else if (SYMBOLP (pred))
{
Lisp_Object language = XTS_PARSER (parser)->language_symbol;
Lisp_Object definition = treesit_traverse_get_predicate (pred,
language);
return treesit_traverse_match_predicate (cursor, definition,
parser, named);
}
else if (CONSP (pred)) else if (CONSP (pred))
{ {
Lisp_Object car = XCAR (pred); Lisp_Object car = XCAR (pred);
@ -3268,10 +3356,11 @@ treesit_traverse_match_predicate (TSTreeCursor *cursor, Lisp_Object pred,
return false; return false;
} }
/* Traverse the parse tree starting from CURSOR. See TODO for the /* Traverse the parse tree starting from CURSOR. See
shapes PRED can have. If the node satisfies PRED, leave CURSOR on `treesit-thing-settings' for the shapes PRED can have. If the
that node and return true. If no node satisfies PRED, move CURSOR node satisfies PRED, leave CURSOR on that node and return true. If
back to starting position and return false. no node satisfies PRED, move CURSOR back to starting position and
return false.
LIMIT is the number of levels we descend in the tree. FORWARD LIMIT is the number of levels we descend in the tree. FORWARD
controls the direction in which we traverse the tree, true means controls the direction in which we traverse the tree, true means
@ -3384,13 +3473,9 @@ Return the first matched node, or nil if none matches. */)
CHECK_SYMBOL (all); CHECK_SYMBOL (all);
CHECK_SYMBOL (backward); CHECK_SYMBOL (backward);
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, &signal_data))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
/* We use a default limit of 1000. See bug#59426 for the /* We use a default limit of 1000. See bug#59426 for the
discussion. */ discussion. */
ptrdiff_t the_limit = treesit_recursion_limit; ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT;
if (!NILP (depth)) if (!NILP (depth))
{ {
CHECK_FIXNUM (depth); CHECK_FIXNUM (depth);
@ -3400,6 +3485,13 @@ Return the first matched node, or nil if none matches. */)
treesit_initialize (); treesit_initialize ();
Lisp_Object parser = XTS_NODE (node)->parser; Lisp_Object parser = XTS_NODE (node)->parser;
Lisp_Object language = XTS_PARSER (parser)->language_symbol;
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, language,
&signal_data, 0))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
Lisp_Object return_value = Qnil; Lisp_Object return_value = Qnil;
TSTreeCursor cursor; TSTreeCursor cursor;
if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser)) if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser))
@ -3455,13 +3547,16 @@ always traverse leaf nodes first, then upwards. */)
CHECK_SYMBOL (all); CHECK_SYMBOL (all);
CHECK_SYMBOL (backward); CHECK_SYMBOL (backward);
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, &signal_data))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
treesit_initialize (); treesit_initialize ();
Lisp_Object parser = XTS_NODE (start)->parser; Lisp_Object parser = XTS_NODE (start)->parser;
Lisp_Object language = XTS_PARSER (parser)->language_symbol;
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, language,
&signal_data, 0))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
Lisp_Object return_value = Qnil; Lisp_Object return_value = Qnil;
TSTreeCursor cursor; TSTreeCursor cursor;
if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser)) if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser))
@ -3572,16 +3667,12 @@ a regexp. */)
{ {
CHECK_TS_NODE (root); CHECK_TS_NODE (root);
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, &signal_data))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
if (!NILP (process_fn)) if (!NILP (process_fn))
CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn); CHECK_TYPE (FUNCTIONP (process_fn), Qfunctionp, process_fn);
/* We use a default limit of 1000. See bug#59426 for the /* We use a default limit of 1000. See bug#59426 for the
discussion. */ discussion. */
ptrdiff_t the_limit = treesit_recursion_limit; ptrdiff_t the_limit = TREESIT_RECURSION_LIMIT;
if (!NILP (depth)) if (!NILP (depth))
{ {
CHECK_FIXNUM (depth); CHECK_FIXNUM (depth);
@ -3591,6 +3682,13 @@ a regexp. */)
treesit_initialize (); treesit_initialize ();
Lisp_Object parser = XTS_NODE (root)->parser; Lisp_Object parser = XTS_NODE (root)->parser;
Lisp_Object language = XTS_PARSER (parser)->language_symbol;
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, language,
&signal_data, 0))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
Lisp_Object parent = Fcons (Qnil, Qnil); Lisp_Object parent = Fcons (Qnil, Qnil);
/* In this function we never traverse above NODE, so we don't need /* In this function we never traverse above NODE, so we don't need
to use treesit_cursor_helper. */ to use treesit_cursor_helper. */
@ -3612,6 +3710,40 @@ a regexp. */)
return parent; return parent;
} }
DEFUN ("treesit-node-match-p",
Ftreesit_node_match_p,
Streesit_node_match_p, 2, 2, 0,
doc: /* Check whether NODE matches PREDICATE.
PREDICATE can be a regexp matching node type, a predicate function,
and more, see `treesit-things-definition' for detail. Return non-nil
if NODE matches PRED, nil otherwise. */)
(Lisp_Object node, Lisp_Object predicate)
{
CHECK_TS_NODE (node);
Lisp_Object parser = XTS_NODE (node)->parser;
Lisp_Object language = XTS_PARSER (parser)->language_symbol;
Lisp_Object signal_data = Qnil;
if (!treesit_traverse_validate_predicate (predicate, language,
&signal_data, 0))
xsignal1 (Qtreesit_invalid_predicate, signal_data);
TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (node)->node);
specpdl_ref count = SPECPDL_INDEX ();
record_unwind_protect_ptr (treesit_traverse_cleanup_cursor, &cursor);
bool match = false;
match = treesit_traverse_match_predicate (&cursor, predicate,
parser, false);
unbind_to (count, Qnil);
return match ? Qt : Qnil;
}
DEFUN ("treesit-subtree-stat", DEFUN ("treesit-subtree-stat",
Ftreesit_subtree_stat, Ftreesit_subtree_stat,
Streesit_subtree_stat, 1, 1, 0, Streesit_subtree_stat, 1, 1, 0,
@ -3709,6 +3841,9 @@ syms_of_treesit (void)
DEFSYM (Qnot, "not"); DEFSYM (Qnot, "not");
DEFSYM (QCanchor, ":anchor"); DEFSYM (QCanchor, ":anchor");
DEFSYM (QCquestion, ":?");
DEFSYM (QCstar, ":*");
DEFSYM (QCplus, ":+");
DEFSYM (QCequal, ":equal"); DEFSYM (QCequal, ":equal");
DEFSYM (QCmatch, ":match"); DEFSYM (QCmatch, ":match");
DEFSYM (QCpred, ":pred"); DEFSYM (QCpred, ":pred");
@ -3760,7 +3895,8 @@ syms_of_treesit (void)
"This parser is deleted and cannot be used", "This parser is deleted and cannot be used",
Qtreesit_error); Qtreesit_error);
define_error (Qtreesit_invalid_predicate, define_error (Qtreesit_invalid_predicate,
"Invalid predicate, see TODO for valid forms for a predicate", "Invalid predicate, see `treesit-thing-settings' "
"for valid forms for a predicate",
Qtreesit_error); Qtreesit_error);
DEFVAR_LISP ("treesit-load-name-override-list", DEFVAR_LISP ("treesit-load-name-override-list",
@ -3792,6 +3928,33 @@ then in the `tree-sitter' subdirectory of `user-emacs-directory', and
then in the system default locations for dynamic libraries, in that order. */); then in the system default locations for dynamic libraries, in that order. */);
Vtreesit_extra_load_path = Qnil; Vtreesit_extra_load_path = Qnil;
DEFVAR_LISP ("treesit-thing-settings",
Vtreesit_thing_settings,
doc:
/* A list defining things.
The value should be an alist of (LANGUAGE . DEFINITIONS), where
LANGUAGE is a language symbol, and DEFINITIONS is a list of
(THING PRED)
THING is a symbol representing the thing, like `defun', `sexp', or
`block'; PRED defines what kind of node can be qualified as THING.
PRED can be a regexp string that matches the type of the node; it can
be a predicate function that takes the node as the sole argument and
returns t if the node is the thing; it can be a cons (REGEXP . FN),
which is a combination of a regexp and a predicate function, and the
node has to match both to qualify as the thing.
PRED can also be recursively defined. It can be (or PRED...), meaning
satisfying anyone of the inner PREDs qualifies the node; or (not
PRED), meaning not satisfying the inner PRED qualifies the node.
Finally, PRED can refer to other THINGs defined in this list by using
the symbol of that THING. For example, (or block sexp). */);
Vtreesit_thing_settings = Qnil;
staticpro (&Vtreesit_str_libtree_sitter); staticpro (&Vtreesit_str_libtree_sitter);
Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-");
staticpro (&Vtreesit_str_tree_sitter); staticpro (&Vtreesit_str_tree_sitter);
@ -3879,6 +4042,7 @@ then in the system default locations for dynamic libraries, in that order. */);
defsubr (&Streesit_search_subtree); defsubr (&Streesit_search_subtree);
defsubr (&Streesit_search_forward); defsubr (&Streesit_search_forward);
defsubr (&Streesit_induce_sparse_tree); defsubr (&Streesit_induce_sparse_tree);
defsubr (&Streesit_node_match_p);
defsubr (&Streesit_subtree_stat); defsubr (&Streesit_subtree_stat);
#endif /* HAVE_TREE_SITTER */ #endif /* HAVE_TREE_SITTER */
defsubr (&Streesit_available_p); defsubr (&Streesit_available_p);

9
src/w32.c
View file

@ -543,7 +543,14 @@ typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void);
typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD); typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD);
#if _WIN32_WINNT < 0x0501 /* Old versions of mingw.org's MinGW, before v5.2.0, don't have a
_WIN32_WINNT guard for CONSOLE_FONT_INFO in wincon.h, and so don't
need the conditional definition below, which causes compilation
errors. Note: MinGW64 sets _WIN32_WINNT to a higher version, and
its w32api.h version stays fixed at 3.14. */
#if _WIN32_WINNT < 0x0501 \
&& (__W32API_MAJOR_VERSION > 5 \
|| (__W32API_MAJOR_VERSION == 5 && __W32API_MINOR_VERSION >= 2))
typedef struct typedef struct
{ {
DWORD nFont; DWORD nFont;

33
test/lisp/image/wallpaper-tests.el
View file

@ -24,7 +24,8 @@
(require 'wallpaper) (require 'wallpaper)
(ert-deftest wallpaper--find-setter () (ert-deftest wallpaper--find-setter ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(let (wallpaper--current-setter (let (wallpaper--current-setter
(wallpaper--default-setters (wallpaper--default-setters
(wallpaper--default-methods-create (wallpaper--default-methods-create
@ -32,7 +33,8 @@
(should (wallpaper--find-setter)))) (should (wallpaper--find-setter))))
(ert-deftest wallpaper--find-setter/call-predicate () (ert-deftest wallpaper--find-setter/call-predicate ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(let* ( wallpaper--current-setter called (let* ( wallpaper--current-setter called
(wallpaper--default-setters (wallpaper--default-setters
(wallpaper--default-methods-create (wallpaper--default-methods-create
@ -43,7 +45,8 @@
(should called))) (should called)))
(ert-deftest wallpaper--find-setter/set-current-setter () (ert-deftest wallpaper--find-setter/set-current-setter ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(let (wallpaper--current-setter (let (wallpaper--current-setter
(wallpaper--default-setters (wallpaper--default-setters
(wallpaper--default-methods-create (wallpaper--default-methods-create
@ -52,7 +55,8 @@
(should wallpaper--current-setter))) (should wallpaper--current-setter)))
(ert-deftest wallpaper-set/runs-command () (ert-deftest wallpaper-set/runs-command ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(ert-with-temp-file fil-jpg (ert-with-temp-file fil-jpg
:suffix ".jpg" :suffix ".jpg"
(ert-with-temp-file fil (ert-with-temp-file fil
@ -70,7 +74,8 @@
(should (file-exists-p fil))))))) (should (file-exists-p fil)))))))
(ert-deftest wallpaper-set/runs-command/detach () (ert-deftest wallpaper-set/runs-command/detach ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(ert-with-temp-file fil-jpg (ert-with-temp-file fil-jpg
:suffix ".jpg" :suffix ".jpg"
(ert-with-temp-file fil (ert-with-temp-file fil
@ -89,7 +94,8 @@
(should (file-exists-p fil)))))) (should (file-exists-p fil))))))
(ert-deftest wallpaper-set/calls-init-action () (ert-deftest wallpaper-set/calls-init-action ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(ert-with-temp-file fil-jpg (ert-with-temp-file fil-jpg
:suffix ".jpg" :suffix ".jpg"
(ert-with-temp-file fil (ert-with-temp-file fil
@ -108,7 +114,8 @@
(should called))))) (should called)))))
(ert-deftest wallpaper-set/calls-wallpaper-set-function () (ert-deftest wallpaper-set/calls-wallpaper-set-function ()
(skip-unless (executable-find "touch")) (skip-unless (and (executable-find "touch")
(wallpaper--use-default-set-function-p)))
(ert-with-temp-file fil-jpg (ert-with-temp-file fil-jpg
:suffix ".jpg" :suffix ".jpg"
(let* ( wallpaper--current-setter called (let* ( wallpaper--current-setter called
@ -122,12 +129,16 @@
(should (equal called fil-jpg))))) (should (equal called fil-jpg)))))
(ert-deftest wallpaper--find-command/return-string () (ert-deftest wallpaper--find-command/return-string ()
(should (or (not (wallpaper--find-command)) (let ((cmd (wallpaper--find-command)))
(stringp (wallpaper--find-command))))) (should (or (not cmd)
(stringp cmd)))))
(ert-deftest wallpaper--find-command-args/return-list () (ert-deftest wallpaper--find-command-args/return-list ()
(should (or (not (wallpaper--find-command-args)) (let ((cmdargs (wallpaper--find-command-args)))
(listp (wallpaper--find-command-args))))) (if (functionp cmdargs)
(setq cmdargs (funcall cmdargs)))
(should (or (not cmdargs)
(listp cmdargs)))))
(ert-deftest wallpaper--image-file-regexp/return-string () (ert-deftest wallpaper--image-file-regexp/return-string ()
(should (stringp (wallpaper--image-file-regexp)))) (should (stringp (wallpaper--image-file-regexp))))

14
test/lisp/progmodes/c-ts-mode-resources/indent.erts
View file

@ -464,3 +464,17 @@ main (void)
| |
} }
=-=-= =-=-=
Name: Empty Line (Block Start)
=-=
int
main (void)
{
|
=-=
int
main (void)
{
|
=-=-=

1
test/lisp/progmodes/eglot-tests.el
View file

@ -804,6 +804,7 @@ int main() {
(ert-deftest eglot-test-json-basic () (ert-deftest eglot-test-json-basic ()
"Test basic autocompletion in vscode-json-languageserver." "Test basic autocompletion in vscode-json-languageserver."
(skip-unless (executable-find "vscode-json-languageserver")) (skip-unless (executable-find "vscode-json-languageserver"))
(skip-unless (fboundp 'yas-minor-mode))
(eglot--with-fixture (eglot--with-fixture
'(("project" . '(("project" .
(("p.json" . "{\"foo.b") (("p.json" . "{\"foo.b")

16
test/lisp/progmodes/ruby-mode-tests.el
View file

@ -567,6 +567,22 @@ VALUES-PLIST is a list with alternating index and value elements."
(search-backward "_") (search-backward "_")
(should (string= (ruby-add-log-current-method) "C::D#foo")))) (should (string= (ruby-add-log-current-method) "C::D#foo"))))
(ert-deftest ruby-add-log-current-method-singleton-referencing-outer ()
(ruby-with-temp-buffer (ruby-test-string
"module M
| module N
| module C
| class D
| def C.foo
| _
| end
| end
| end
| end
|end")
(search-backward "_")
(should (string= (ruby-add-log-current-method) "M::N::C.foo"))))
(ert-deftest ruby-add-log-current-method-after-inner-class () (ert-deftest ruby-add-log-current-method-after-inner-class ()
(ruby-with-temp-buffer (ruby-test-string (ruby-with-temp-buffer (ruby-test-string
"module M "module M

4
test/src/treesit-tests.el
View file

@ -916,8 +916,6 @@ and \"]\"."
collect collect
(cl-loop for pos in record (cl-loop for pos in record
collect (alist-get pos marker-alist)))) collect (alist-get pos marker-alist))))
(`(,regexp . ,pred) (treesit--thing-unpack-pattern
treesit-defun-type-regexp))
;; Collect positions each function returns. ;; Collect positions each function returns.
(positions (positions
(treesit--ert-collect-positions (treesit--ert-collect-positions
@ -929,7 +927,7 @@ and \"]\"."
(if-let ((pos (funcall (if-let ((pos (funcall
#'treesit--navigate-thing #'treesit--navigate-thing
(point) (car conf) (cdr conf) (point) (car conf) (cdr conf)
regexp pred tactic))) treesit-defun-type-regexp tactic)))
(save-excursion (save-excursion
(goto-char pos) (goto-char pos)
(funcall treesit-defun-skipper) (funcall treesit-defun-skipper)