[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android fd074f3133 2/2: Merge remote-tracking branch 'origin/mas
|
From: |
Po Lu |
|
Subject: |
feature/android fd074f3133 2/2: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Sat, 31 Dec 2022 05:05:30 -0500 (EST) |
branch: feature/android
commit fd074f3133a348dd1d3b7ee569f0fc046223efb9
Merge: cfbc8a5dbc f59d012af7
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
admin/admin.el | 3 +
admin/find-gc.el | 2 +-
admin/gitmerge.el | 2 +-
configure.ac | 34 +-
doc/emacs/display.texi | 12 +-
doc/lispref/display.texi | 43 +-
doc/lispref/edebug.texi | 23 +-
doc/lispref/elisp.texi | 2 +-
doc/lispref/eval.texi | 3 -
doc/lispref/modes.texi | 45 +-
doc/lispref/parsing.texi | 199 ++++--
doc/lispref/text.texi | 2 +-
doc/misc/calc.texi | 10 +-
doc/misc/erc.texi | 12 +-
doc/misc/info.texi | 5 +-
doc/misc/mh-e.texi | 2 +-
doc/misc/sc.texi | 4 +-
doc/misc/texinfo.tex | 177 ++---
etc/DEBUG | 9 +-
etc/ERC-NEWS | 11 +-
etc/NEWS | 62 ++
etc/NEWS.29 | 601 ++++++++++-------
etc/PROBLEMS | 12 +
etc/emacsclient-mail.desktop | 4 +-
etc/emacsclient.desktop | 2 +-
etc/package-keyring.gpg | Bin 2069 -> 2043 bytes
etc/tutorials/TUTORIAL.fr | 2 +-
lib/file-has-acl.c | 120 +++-
lib/time.in.h | 1 +
lisp/abbrev.el | 2 +-
lisp/calendar/cal-dst.el | 12 +-
lisp/calendar/diary-lib.el | 2 +-
lisp/calendar/solar.el | 10 +-
lisp/cedet/semantic/lex-spp.el | 2 +-
lisp/cedet/semantic/lex.el | 2 +-
lisp/desktop.el | 2 +-
lisp/elide-head.el | 62 +-
lisp/emacs-lisp/byte-opt.el | 5 +-
lisp/emacs-lisp/byte-run.el | 7 +-
lisp/emacs-lisp/bytecomp.el | 33 +-
lisp/emacs-lisp/edebug.el | 6 +-
lisp/emacs-lisp/ert-x.el | 53 +-
lisp/emacs-lisp/loaddefs-gen.el | 3 +-
lisp/emacs-lisp/macroexp.el | 4 +-
lisp/emacs-lisp/package-vc.el | 266 +++++---
lisp/emacs-lisp/package.el | 2 +-
lisp/emacs-lisp/shortdoc.el | 9 +
lisp/emacs-lisp/subr-x.el | 5 +-
lisp/epa-ks.el | 6 +-
lisp/erc/erc-backend.el | 10 +
lisp/erc/erc-compat.el | 2 +-
lisp/erc/erc-networks.el | 26 +-
lisp/erc/erc-sasl.el | 2 +-
lisp/erc/erc.el | 6 +-
lisp/eshell/em-tramp.el | 5 +-
lisp/eshell/esh-cmd.el | 25 +-
lisp/eshell/esh-io.el | 123 ++--
lisp/eshell/esh-proc.el | 2 +-
lisp/faces.el | 7 +-
lisp/files.el | 55 +-
lisp/font-lock.el | 6 +-
lisp/gnus/gnus-registry.el | 2 +-
lisp/gnus/nndiary.el | 7 +
lisp/help-fns.el | 4 +-
lisp/help.el | 32 +-
lisp/hi-lock.el | 33 +-
lisp/htmlfontify.el | 5 +-
lisp/image-mode.el | 2 +-
lisp/indent.el | 3 +-
lisp/international/characters.el | 2 +-
lisp/international/mule-conf.el | 2 +-
lisp/isearch.el | 13 +-
lisp/mail/rmailout.el | 5 +-
lisp/minibuffer.el | 5 +-
lisp/net/gnutls.el | 15 +-
lisp/net/newst-backend.el | 20 +-
lisp/net/tramp.el | 2 +-
lisp/org/ob-core.el | 10 +-
lisp/org/ob-tangle.el | 3 +-
lisp/org/oc-basic.el | 18 +-
lisp/org/org-element.el | 16 +-
lisp/org/org-persist.el | 46 +-
lisp/org/org-version.el | 2 +-
lisp/org/org.el | 5 +-
lisp/org/ox-html.el | 2 +-
lisp/pcomplete.el | 27 +-
lisp/progmodes/c-ts-mode.el | 426 +++++++-----
lisp/progmodes/csharp-mode.el | 91 +--
lisp/progmodes/java-ts-mode.el | 86 +--
lisp/progmodes/js.el | 257 +++-----
lisp/progmodes/json-ts-mode.el | 43 +-
lisp/progmodes/prog-mode.el | 6 +-
lisp/progmodes/python.el | 60 +-
lisp/progmodes/ruby-mode.el | 145 ++++-
lisp/progmodes/rust-ts-mode.el | 122 ++--
lisp/progmodes/scheme.el | 20 +-
lisp/progmodes/sh-script.el | 2 +
lisp/progmodes/typescript-ts-mode.el | 32 +-
lisp/repeat.el | 3 +-
lisp/simple.el | 88 +--
lisp/startup.el | 2 +-
lisp/subr.el | 40 +-
lisp/tab-bar.el | 3 +-
lisp/tab-line.el | 14 +-
lisp/textmodes/bibtex.el | 28 +-
lisp/textmodes/css-mode.el | 57 +-
lisp/textmodes/toml-ts-mode.el | 52 +-
lisp/treesit.el | 711 ++++++++++++++++-----
lisp/vc/diff-mode.el | 3 +-
lisp/whitespace.el | 35 +-
m4/gnulib-common.m4 | 57 +-
nt/INSTALL.W64 | 88 +--
src/dispnew.c | 2 +-
src/emacs.c | 1 +
src/eval.c | 6 +-
src/frame.h | 14 +
src/gnutls.c | 142 ++++
src/indent.c | 2 +
src/json.c | 79 ++-
src/keyboard.c | 5 +-
src/lisp.h | 1 -
src/process.c | 11 +-
src/treesit.c | 289 ++++++---
src/w32menu.c | 13 +-
src/w32term.c | 11 +-
src/xdisp.c | 40 +-
src/xfns.c | 1 +
src/xterm.c | 6 +-
src/xterm.h | 10 +
test/lisp/elide-head-tests.el | 106 +++
test/lisp/emacs-lisp/bytecomp-tests.el | 108 +++-
test/lisp/emacs-lisp/ert-x-tests.el | 39 ++
test/lisp/emacs-lisp/multisession-tests.el | 2 +-
test/lisp/erc/erc-scenarios-base-unstable.el | 54 +-
.../erc/resources/networks/no-module/basic.eld | 44 ++
test/lisp/eshell/em-tramp-tests.el | 99 ++-
test/lisp/eshell/esh-cmd-tests.el | 46 +-
test/lisp/eshell/esh-io-tests.el | 24 +-
test/lisp/eshell/eshell-tests-helpers.el | 29 +-
test/lisp/eshell/eshell-tests.el | 19 +-
test/lisp/net/tramp-tests.el | 14 +-
.../ruby-after-operator-indent.rb | 29 +
.../ruby-mode-resources/ruby-block-indent.rb | 33 +
.../ruby-mode-resources/ruby-method-call-indent.rb | 15 +
.../ruby-parenless-call-arguments-indent.rb | 23 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 23 +
test/lisp/progmodes/ruby-mode-tests.el | 4 +
test/lisp/vc/diff-mode-tests.el | 79 +++
test/lisp/whitespace-tests.el | 31 +-
test/src/process-tests.el | 2 +-
test/src/regex-emacs-tests.el | 4 +-
test/src/treesit-tests.el | 121 ++--
152 files changed, 4350 insertions(+), 2149 deletions(-)
diff --git a/admin/admin.el b/admin/admin.el
index 6a67f172e2..12c9c10b1a 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -843,8 +843,11 @@ $Date: %s $
(package-install pkg)
(require pkg nil t))))
+(declare-function org-html-export-as-html "ox-html.el")
(defvar org-html-postamble)
(defvar org-html-mathjax-template)
+(defvar htmlize-output-type)
+
(defun make-news-html-file (root version)
"Convert the NEWS file into an HTML file."
(interactive (let ((root
diff --git a/admin/find-gc.el b/admin/find-gc.el
index 1c3c419c56..6b0e2a3d80 100644
--- a/admin/find-gc.el
+++ b/admin/find-gc.el
@@ -100,7 +100,7 @@ Also store it in `find-gc-unsafe-list'."
-(defun trace-call-tree (&optional ignored)
+(defun trace-call-tree (&optional _ignored)
(message "Setting up directories...")
(setq find-gc-subrs-called nil)
(let ((case-fold-search nil)
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index ddd3e18442..1ff8137e15 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -293,7 +293,7 @@ should not be skipped."
"Try to resolve conflicts in FILE with smerge.
Returns non-nil if conflicts remain."
(unless (file-exists-p file) (error "Gitmerge-resolve: Can't find %s" file))
- (with-demoted-errors
+ (with-demoted-errors "Error: %S"
(let ((exists (find-buffer-visiting file)))
(with-current-buffer (let ((enable-local-variables :safe)
(enable-local-eval nil))
diff --git a/configure.ac b/configure.ac
index ad2d306c64..da8d753afc 100644
--- a/configure.ac
+++ b/configure.ac
@@ -3017,39 +3017,6 @@ if test "${HAVE_X11}" = "yes"; then
export LD_RUN_PATH
fi
- if test "${opsys}" = "gnu-linux"; then
- AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link],
[emacs_cv_b_link],
- [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
- [[XOpenDisplay ("foo");]])],
- [xgnu_linux_first_failure=no],
- [xgnu_linux_first_failure=yes])
- if test "${xgnu_linux_first_failure}" = "yes"; then
- OLD_CPPFLAGS="$CPPFLAGS"
- OLD_LIBS="$LIBS"
- CPPFLAGS="$CPPFLAGS -b i486-linuxaout"
- LIBS="$LIBS -b i486-linuxaout"
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
- [[XOpenDisplay ("foo");]])],
- [xgnu_linux_second_failure=no],
- [xgnu_linux_second_failure=yes])
- if test "${xgnu_linux_second_failure}" = "yes"; then
- # If we get the same failure with -b, there is no use adding -b.
- # So leave it out. This plays safe.
- emacs_cv_b_link=no
- else
- emacs_cv_b_link=yes
- fi
- CPPFLAGS=$OLD_CPPFLAGS
- LIBS=$OLD_LIBS
- else
- emacs_cv_b_link=no
- fi])
- if test "x$emacs_cv_b_link" = xyes ; then
- LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout"
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout"
- fi
- fi
-
# Reportedly, some broken Solaris systems have XKBlib.h but are missing
# header files included from there.
AC_CACHE_CHECK([for Xkb], [emacs_cv_xkb],
@@ -5597,6 +5564,7 @@ AC_CACHE_CHECK([whether signals can be handled on
alternate stack],
[emacs_cv_alternate_stack],
[AC_COMPILE_IFELSE(
[AC_LANG_PROGRAM([[#include <signal.h>
+ #include <stdlib.h>
]],
[[stack_t ss;
struct sigaction sa;
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index cf4f041452..ce2dd0a78b 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -920,12 +920,12 @@ decrease the font size of the affected faces, depending
on the
direction of the scrolling.
The final key of these commands may be repeated without the leading
-@kbd{C-x}. For instance, @kbd{C-x C-= C-= C-=} increases the face
-height by three steps. Each step scales the text height by a factor
-of 1.2; to change this factor, customize the variable
-@code{text-scale-mode-step}. A numeric argument of 0
-to the @code{text-scale-adjust} command restores the default height,
-the same as typing @kbd{C-x C-0}.
+@kbd{C-x} and without the modifiers. For instance, @w{@kbd{C-x C-= C-= C-=}}
+and @w{@kbd{C-x C-= = =}} increase the face height by three steps. Each
+step scales the text height by a factor of 1.2; to change this factor,
+customize the variable @code{text-scale-mode-step}. A numeric
+argument of 0 to the @code{text-scale-adjust} command restores the
+default height, the same as typing @kbd{C-x C-0}.
@cindex adjust global font size
@findex global-text-scale-adjust
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 2332bf3ecf..604d5bd1a2 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -346,6 +346,20 @@ The default value is the function that clears the message
displayed in
an active minibuffer.
@end defvar
+@defopt set-message-functions
+The value of this user option is a list of functions to be called for
+handling display of echo-area messages. Each function is called with
+one argument, the text of the message to display. If the function
+returns a string, that string replaces the original message, and the
+next function in the list is called with the new message text. If the
+function returns @code{nil}, the next function in the list is called
+with the same text; if the last function in the list returns
+@code{nil}, the message text is displayed in the echo area. If the
+function returns a non-@code{nil} value that is not a string, the
+message is considered to be handled, and no further functions in the
+list are called.
+@end defopt
+
@defvar inhibit-message
When this variable is non-@code{nil}, @code{message} and related functions
will not use the Echo Area to display messages.
@@ -3043,17 +3057,30 @@ If @var{frame} is @code{t}, this function sets the
default attributes
for newly created frames; they will effectively override the attribute
values specified by @code{defface}. If @var{frame} is @code{nil},
this function sets the attributes for all existing frames, as well as
-for newly created frames. However, if you want to @emph{reset} the
-value of an attribute to @code{unspecified} in a way that also affects
-newly created frames, you @emph{must} explicitly call this function
-with @var{frame} set to @code{t} and the value of the attribute set to
-@code{unspecified} (@emph{not} @code{nil}!@:), in addition to the call
-with @var{frame} set to @code{nil}. This is because the default
-attributes for newly created frames are merged with the face's spec in
-@code{defface} when a new frame is created, and so having
+for newly created frames.
+
+To @emph{reset} the value of an attribute, that is, to indicate that
+the face doesn't by itself specify a value for the attribute, use the
+special value @code{unspecified} (@emph{not} @code{nil}!@:) for the
+attribute, and set the @var{frame} argument to @code{t}, in addition
+to the call with @var{frame} set to @code{nil}. This is because the
+default attributes for newly created frames are merged with the face's
+spec in @code{defface} when a new frame is created, and so having
@code{unspecified} in the default attributes for new frames will be
unable to override @code{defface}; the special call to this function
as described above will arrange for @code{defface} to be overridden.
+
+Note that the attribute-value pairs are evaluated in the order they
+are specified, with the exception of the @code{:family} and
+@code{:foundry} attributes, which are evaluated first. This means
+that if a certain attribute is specified more than once, only the last
+value will be used. It also means that in some cases a different
+order of attributes will produce different results. For example, when
+@code{:weight} is placed before @code{:font}, the weight value is
+applied to the current font of the face, and might be rounded to the
+closest available weight of that font, whereas when @code{:font} is
+placed before @code{:weight} the weight value is applied to the
+specified font.
@end defun
The following commands and functions mostly provide compatibility
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 1562a37842..93bafce1f3 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -171,14 +171,13 @@ of the variable @code{edebug-all-defs}.
@findex eval-region @r{(Edebug)}
@findex eval-buffer @r{(Edebug)}
-@findex eval-current-buffer @r{(Edebug)}
If @code{edebug-all-defs} is non-@code{nil}, then the commands
-@code{eval-region}, @code{eval-current-buffer}, and @code{eval-buffer}
-also instrument any definitions they evaluate. Similarly,
-@code{edebug-all-forms} controls whether @code{eval-region} should
-instrument @emph{any} form, even non-defining forms. This doesn't apply
-to loading or evaluations in the minibuffer. The command @kbd{M-x
-edebug-all-forms} toggles this option.
+@code{eval-region}, and @code{eval-buffer} also instrument any
+definitions they evaluate. Similarly, @code{edebug-all-forms}
+controls whether @code{eval-region} should instrument @emph{any} form,
+even non-defining forms. This doesn't apply to loading or evaluations
+in the minibuffer. The command @kbd{M-x edebug-all-forms} toggles
+this option.
@findex edebug-eval-top-level-form
@findex edebug-defun
@@ -1635,8 +1634,8 @@ but only when you also use Edebug.
@defopt edebug-all-defs
If this is non-@code{nil}, normal evaluation of defining forms such as
@code{defun} and @code{defmacro} instruments them for Edebug. This
-applies to @code{eval-defun}, @code{eval-region}, @code{eval-buffer},
-and @code{eval-current-buffer}.
+applies to @code{eval-defun}, @code{eval-region} and
+@code{eval-buffer}.
Use the command @kbd{M-x edebug-all-defs} to toggle the value of this
option. @xref{Instrumenting}.
@@ -1644,9 +1643,9 @@ option. @xref{Instrumenting}.
@defopt edebug-all-forms
If this is non-@code{nil}, the commands @code{eval-defun},
-@code{eval-region}, @code{eval-buffer}, and @code{eval-current-buffer}
-instrument all forms, even those that don't define anything.
-This doesn't apply to loading or evaluations in the minibuffer.
+@code{eval-region} and @code{eval-buffer} instrument all forms, even
+those that don't define anything. This doesn't apply to loading or
+evaluations in the minibuffer.
Use the command @kbd{M-x edebug-all-forms} to toggle the value of this
option. @xref{Instrumenting}.
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index b1bbe5e0a9..fa4bc36b25 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -1364,7 +1364,7 @@ Syntax Tables
Parsing Program Source
-* Language Definitions:: Loading tree-sitter language definitions.
+* Language Grammar:: Loading tree-sitter language grammar.
* Using Parser:: Introduction to parsers.
* Retrieving Nodes:: Retrieving nodes from a syntax tree.
* Accessing Node Information:: Accessing node information.
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 11c321b32e..159e440a98 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -819,9 +819,6 @@ output of the output functions is printed in the echo area.
(@pxref{Unloading}), and defaults to @code{buffer-file-name}
(@pxref{Buffer File Name}). If @var{unibyte} is non-@code{nil},
@code{read} converts strings to unibyte whenever possible.
-
-@findex eval-current-buffer
-@code{eval-current-buffer} is an alias for this command.
@end deffn
@defopt max-lisp-eval-depth
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index c44938f392..9eb4f120f3 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -2841,6 +2841,35 @@ function uses @code{imenu-generic-expression} instead.
Setting this variable makes it buffer-local in the current buffer.
@end defvar
+If built with tree-sitter, Emacs can automatically generate an Imenu
+index if the major mode sets relevant variables.
+
+@defvar treesit-simple-imenu-settings
+This variable instructs Emacs how to generate Imenu indexes. It
+should be a list of @w{(@var{category} @var{regexp} @var{pred}
+@var{name-fn})}.
+
+@var{category} should be the name of a category, like "Function",
+"Class", etc. @var{regexp} should be a regexp matching the type of
+nodes that belong to @var{category}. @var{pred} should be either
+@code{nil} or a function that takes a node as the argument. It should
+return non-@code{nil} if the node is a valid node for @var{category},
+or @code{nil} if not.
+
+@var{category} could also be @code{nil}. In which case the entries
+matched by @var{regexp} and @var{pred} are not grouped under
+@var{category}.
+
+@var{name-fn} should be either @var{nil} or a function that takes a
+defun node and returns the name of that defun, e.g., the function name
+for a function definition. If @var{name-fn} is @var{nil},
+@code{treesit-defun-name} (@pxref{Tree-sitter major modes}) is used
+instead.
+
+@code{treesit-major-mode-setup} (@pxref{Tree-sitter major modes})
+automatically sets up Imenu if this variable is non-@code{nil}.
+@end defvar
+
@node Font Lock Mode
@section Font Lock Mode
@cindex Font Lock mode
@@ -4023,11 +4052,12 @@ This function takes a series of @var{query-spec}s,
where each
@var{:keyword}/@var{value} pairs. Each @var{query} is a
tree-sitter query in either the string, s-expression or compiled form.
+@c FIXME: Cross-ref treesit-font-lock-level to user manual.
For each @var{query}, the @var{:keyword}/@var{value} pairs that
precede it add meta information to it. The @code{:lang} keyword
declares @var{query}'s language. The @code{:feature} keyword sets the
feature name of @var{query}. Users can control which features are
-enabled with @code{font-lock-maximum-decoration} and
+enabled with @code{treesit-font-lock-level} and
@code{treesit-font-lock-feature-list} (described below). These two
keywords are mandatory.
@@ -4067,10 +4097,11 @@ priority. If a capture name is neither a face nor a
function, it is
ignored.
@end defun
+@c FIXME: Cross-ref treesit-font-lock-level to user manual.
@defvar treesit-font-lock-feature-list
This is a list of lists of feature symbols. Each element of the list
is a list that represents a decoration level.
-@code{font-lock-maximum-decoration} controls which levels are
+@code{treesit-font-lock-level} controls which levels are
activated.
Each element of the list is a list of the form @w{@code{(@var{feature}
@@ -5024,6 +5055,14 @@ comment-start token. Comment-start tokens are defined
by regular
expression @code{comment-start-skip}. This function assumes
@var{parent} is the comment node.
+@item prev-adaptive-prefix
+This anchor is a function that is called with 3 arguments: @var{node},
+@var{parent}, and @var{bol}. It tries to go to the beginning of the
+previous non-empty line, and matches @code{adaptive-fill-regexp}. If
+there is a match, this function returns the end of the match,
+otherwise it returns nil. This anchor is useful for a
+@code{indent-relative}-like indent behavior for block comments.
+
@end ftable
@end defvar
@@ -5043,7 +5082,7 @@ shown in red color. @c Are colors customizable? faces?
@end defun
It is also helpful to use @code{treesit-inspect-mode} (@pxref{Language
-Definitions}) when writing indentation rules.
+Grammar}) when writing indentation rules.
@node Desktop Save Mode
@section Desktop Save Mode
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index adb4c5e6e0..8803991b72 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -30,7 +30,7 @@ available for the current Emacs session.
To be able to parse the program source using the tree-sitter library
and access the syntax tree of the program, a Lisp program needs to
-load a language definition library, and create a parser for that
+load a language grammar library, and create a parser for that
language and the current buffer. After that, the Lisp program can
query the parser about specific nodes of the syntax tree. Then, it
can access various kinds of information about each node, and search
@@ -39,7 +39,7 @@ explains how to do all this, and also how a Lisp program can
work with
source files that mix multiple programming languages.
@menu
-* Language Definitions:: Loading tree-sitter language definitions.
+* Language Grammar:: Loading tree-sitter language grammar.
* Using Parser:: Introduction to parsers.
* Retrieving Nodes:: Retrieving nodes from a syntax tree.
* Accessing Node Information:: Accessing node information.
@@ -49,27 +49,27 @@ source files that mix multiple programming languages.
* Tree-sitter C API:: Compare the C API and the ELisp API.
@end menu
-@node Language Definitions
-@section Tree-sitter Language Definitions
-@cindex language definitions, for tree-sitter
+@node Language Grammar
+@section Tree-sitter Language Grammar
+@cindex language grammar, for tree-sitter
-@heading Loading a language definition
-@cindex loading language definition for tree-sitter
+@heading Loading a language grammar
+@cindex loading language grammar for tree-sitter
@cindex language argument, for tree-sitter
-Tree-sitter relies on language definitions to parse text in that
-language. In Emacs, a language definition is represented by a symbol.
-For example, the C language definition is represented as the symbol
+Tree-sitter relies on language grammar to parse text in that
+language. In Emacs, a language grammar is represented by a symbol.
+For example, the C language grammar is represented as the symbol
@code{c}, and @code{c} can be passed to tree-sitter functions as the
@var{language} argument.
@vindex treesit-extra-load-path
@vindex treesit-load-language-error
@vindex treesit-load-suffixes
-Tree-sitter language definitions are distributed as dynamic libraries.
-In order to use a language definition in Emacs, you need to make sure
+Tree-sitter language grammar are distributed as dynamic libraries.
+In order to use a language grammar in Emacs, you need to make sure
that the dynamic library is installed on the system. Emacs looks for
-language definitions in several places, in the following order:
+language grammar in several places, in the following order:
@itemize @bullet
@item
@@ -91,12 +91,12 @@ that signal could be one of the following:
@table @code
@item (not-found @var{error-msg} @dots{})
-This means that Emacs could not find the language definition library.
+This means that Emacs could not find the language grammar library.
@item (symbol-error @var{error-msg})
This means that Emacs could not find in the library the expected function
-that every language definition library should export.
+that every language grammar library should export.
@item (version-mismatch @var{error-msg})
-This means that the version of language definition library is incompatible
+This means that the version of language grammar library is incompatible
with that of the tree-sitter library.
@end table
@@ -105,7 +105,7 @@ In all of these cases, @var{error-msg} might provide
additional
details about the failure.
@defun treesit-language-available-p language &optional detail
-This function returns non-@code{nil} if the language definitions for
+This function returns non-@code{nil} if the language grammar for
@var{language} exist and can be loaded.
If @var{detail} is non-@code{nil}, return @code{(t . nil)} when
@@ -119,7 +119,7 @@ By convention, the file name of the dynamic library for
@var{language} is
@file{libtree-sitter-@var{language}.@var{ext}}, where @var{ext} is the
system-specific extension for dynamic libraries. Also by convention,
the function provided by that library is named
-@code{tree_sitter_@var{language}}. If a language definition library
+@code{tree_sitter_@var{language}}. If a language grammar library
doesn't follow this convention, you should add an entry
@example
@@ -140,19 +140,25 @@ to the list in the variable
@code{treesit-load-name-override-list}, where
for a language that considers itself too ``cool'' to abide by
conventions.
-@cindex language-definition version, compatibility
-@defun treesit-language-version &optional min-compatible
-This function returns the version of the language-definition
+@cindex language grammar version, compatibility
+@defun treesit-library-abi-version &optional min-compatible
+This function returns the version of the language grammar
Application Binary Interface (@acronym{ABI}) supported by the
tree-sitter library. By default, it returns the latest ABI version
supported by the library, but if @var{min-compatible} is
non-@code{nil}, it returns the oldest ABI version which the library
-still can support. Language definition libraries must be built for
+still can support. language grammar libraries must be built for
ABI versions between the oldest and the latest versions supported by
the tree-sitter library, otherwise the library will be unable to load
them.
@end defun
+@defun treesit-language-abi-version language
+This function returns the language grammar @acronym{ABI} version of
+language grammar for @var{language} loaded by Emacs. If
+@var{language} is unavailable, this function returns @code{nil}.
+@end defun
+
@heading Concrete syntax tree
@cindex syntax tree, concrete
@@ -210,7 +216,7 @@ punctuation characters like bracket @samp{]}, and keywords
like
@cindex field name, tree-sitter
@cindex tree-sitter node field name
@anchor{tree-sitter node field name}
-To make the syntax tree easier to analyze, many language definitions
+To make the syntax tree easier to analyze, many language grammar
assign @dfn{field names} to child nodes. For example, a
@code{function_definition} node could have a @code{declarator} and a
@code{body}:
@@ -266,13 +272,13 @@ parser in @code{(treesit-parser-list)} (@pxref{Using
Parser}).
@heading Reading the grammar definition
@cindex reading grammar definition, tree-sitter
-Authors of language definitions define the @dfn{grammar} of a
+Authors of language grammar define the @dfn{grammar} of a
programming language, which determines how a parser constructs a
concrete syntax tree out of the program text. In order to use the
syntax tree effectively, you need to consult the @dfn{grammar file}.
The grammar file is usually @file{grammar.js} in a language
-definition's project repository. The link to a language definition's
+grammar's project repository. The link to a language grammar's
home page can be found on
@uref{https://tree-sitter.github.io/tree-sitter, tree-sitter's
homepage}.
@@ -350,7 +356,7 @@ makes any node matched by @code{preprocessor_call_exp}
appear as
@end table
Below are grammar functions of lesser importance for reading a
-language definition.
+language grammar.
@table @code
@item token(@var{rule})
@@ -393,17 +399,11 @@ tree-sitter can be activated. Major modes should check
this value
when deciding whether to enable tree-sitter features.
@end defvar
-@defun treesit-can-enable-p
-This function checks whether the current buffer is suitable for
-activating tree-sitter features. It basically checks
-@code{treesit-available-p} and @code{treesit-max-buffer-size}.
-@end defun
-
@cindex creating tree-sitter parsers
@cindex tree-sitter parser, creating
@defun treesit-parser-create language &optional buffer no-reuse
Create a parser for the specified @var{buffer} and @var{language}
-(@pxref{Language Definitions}). If @var{buffer} is omitted or
+(@pxref{Language Grammar}). If @var{buffer} is omitted or
@code{nil}, it stands for the current buffer.
By default, this function reuses a parser if one already exists for
@@ -511,7 +511,9 @@ notification.
Every time a parser reparses a buffer, it compares the old and new
parse-tree, computes the ranges in which nodes have changed, and
-passes the ranges to notifier functions.
+passes the ranges to notifier functions. Note that the initial parse
+is also considered a ``change'', so notifier functions are called on
+the initial parse, with range being the whole buffer.
@defun treesit-parser-add-notifier parser function
This function adds @var{function} to @var{parser}'s list of
@@ -576,12 +578,12 @@ leaf node after @var{pos}.
Finally, if there is no leaf node after @var{pos}, return the first
leaf node before @var{pos}.
-When @var{parser-or-lang} is @code{nil} or omitted, this function uses
-the first parser in @code{(treesit-parser-list)} of the current
-buffer. If @var{parser-or-lang} is a parser object, it uses that
-parser; if @var{parser-or-lang} is a language, it finds the first
-parser using that language in @code{(treesit-parser-list)}, and uses
-that.
+If @var{parser-or-lang} is a parser object, this function uses that
+parser; if @var{parser-or-lang} is a language, this function uses the
+first parser for that language in the current buffer, or creates one
+if none exists; if @var{parser-or-lang} is @code{nil}, this function
+tries to guess the language at @var{pos} by calling
+@code{treesit-language-at} (@pxref{Multiple Languages}).
If this function cannot find a suitable node to return, it returns
@code{nil}.
@@ -610,13 +612,14 @@ is at or after @var{end}.
inside any top-level construct (function definition, etc.) most
probably will give you the root node, because the root node is the
smallest node that covers that empty line. Most of the time, you want
-to use @code{treesit-node-at}, described above, instead.
+to use @code{treesit-node-at} instead.
-When @var{parser-or-lang} is @code{nil}, this function uses the first
-parser in @code{(treesit-parser-list)} of the current buffer. If
-@var{parser-or-lang} is a parser object, it uses that parser; if
-@var{parser-or-lang} is a language, it finds the first parser using
-that language in @code{(treesit-parser-list)}, and uses that.
+If @var{parser-or-lang} is a parser object, this function uses that
+parser; if @var{parser-or-lang} is a language, this function uses the
+first parser for that language in the current buffer, or creates one
+if none exists; if @var{parser-or-lang} is @code{nil}, this function
+tries to guess the language at @var{beg} by calling
+@code{treesit-language-at}.
If @var{named} is non-@code{nil}, this function looks for a named node
only (@pxref{tree-sitter named node, named node}).
@@ -628,9 +631,10 @@ This function returns the root node of the syntax tree
generated by
@end defun
@defun treesit-buffer-root-node &optional language
-This function finds the first parser that uses @var{language} in
-@code{(treesit-parser-list)} of the current buffer, and returns the
-root node generated by that parser. If it cannot find an appropriate
+This function finds the first parser for @var{language} in the current
+buffer, or creates one if none exists, and returns the root node
+generated by that parser. If @var{language} is omitted, it uses the
+first parser in the parser list. If it cannot find an appropriate
parser, it returns @code{nil}.
@end defun
@@ -647,6 +651,10 @@ it, or query for information about this node.
@defun treesit-node-parent node
This function returns the immediate parent of @var{node}.
+
+If @var{node} is more than 1000 levels deep in a parse tree, the
+return value is undefined. Currently it returns @var{nil}, but that
+could change in the future.
@end defun
@defun treesit-node-child node n &optional named
@@ -683,7 +691,7 @@ This function finds the previous sibling of @var{node}. If
@cindex nodes, by field name
@cindex syntax tree nodes, by field name
-To make the syntax tree easier to analyze, many language definitions
+To make the syntax tree easier to analyze, many language grammar
assign @dfn{field names} to child nodes (@pxref{tree-sitter node field
name, field name}). For example, a @code{function_definition} node
could have a @code{declarator} node and a @code{body} node.
@@ -927,7 +935,7 @@ tree.
In general, nodes in a concrete syntax tree fall into two categories:
@dfn{named nodes} and @dfn{anonymous nodes}. Whether a node is named
-or anonymous is determined by the language definition
+or anonymous is determined by the language grammar
(@pxref{tree-sitter named node, named node}).
@cindex tree-sitter missing node
@@ -966,7 +974,7 @@ Named nodes have ``types'' (@pxref{tree-sitter node type,
node type}).
For example, a named node can be a @code{string_literal} node, where
@code{string_literal} is its type. The type of an anonymous node is
just the text that the node represents; e.g., the type of a @samp{,}
-node 480is just @samp{,}.
+node is just @samp{,}.
This function returns @var{node}'s type as a string.
@end defun
@@ -1266,10 +1274,11 @@ example, with the following pattern:
@end example
@noindent
-tree-sitter only matches arrays where the first element equals to
-the last element. To attach a predicate to a pattern, we need to
-group them together. A predicate always starts with a @samp{#}.
-Currently there are two predicates, @code{#equal} and @code{#match}.
+tree-sitter only matches arrays where the first element equals to the
+last element. To attach a predicate to a pattern, we need to group
+them together. A predicate always starts with a @samp{#}. Currently
+there are three predicates, @code{#equal}, @code{#match}, and
+@code{#pred}.
@deffn Predicate equal arg1 arg2
Matches if @var{arg1} equals to @var{arg2}. Arguments can be either
@@ -1282,6 +1291,11 @@ Matches if the text that @var{capture-name}'s node spans
in the buffer
matches regular expression @var{regexp}. Matching is case-sensitive.
@end deffn
+@deffn Predicate pred fn &rest nodes
+Matches if function @var{fn} returns non-@code{nil} when passed each
+node in @var{nodes} as arguments.
+@end deffn
+
Note that a predicate can only refer to capture names that appear in
the same pattern. Indeed, it makes little sense to refer to capture
names in other patterns.
@@ -1696,8 +1710,8 @@ whether tree-sitter can be activated in this mode.
This function checks for conditions for activating tree-sitter. It
checks whether Emacs was built with tree-sitter, whether the buffer's
size is not too large for tree-sitter to handle it, and whether the
-language definition for @var{language} is available on the system
-(@pxref{Language Definitions}).
+language grammar for @var{language} is available on the system
+(@pxref{Language Grammar}).
This function emits a warning if tree-sitter cannot be activated. If
@var{quiet} is @code{message}, the warning is turned into a message;
@@ -1716,15 +1730,25 @@ This function activates some tree-sitter features for a
major mode.
Currently, it sets up the following features:
@itemize
@item
-If @code{treesit-font-lock-settings} is non-@code{nil}, it sets up
-fontification.
+If @code{treesit-font-lock-settings} (@pxref{Parser-based Font Lock})
+is non-@code{nil}, it sets up fontification.
+
@item
-If @code{treesit-simple-indent-rules} is non-@code{nil}, it sets up
-indentation.
+If @code{treesit-simple-indent-rules} (@pxref{Parser-based Font Lock})
+is non-@code{nil}, it sets up indentation.
+
@item
If @code{treesit-defun-type-regexp} is non-@code{nil}, it sets up
navigation functions for @code{beginning-of-defun} and
@code{end-of-defun}.
+
+@item
+If @code{treesit-defun-name-function} is non-@code{nil}, it sets up
+add-log functions used by @code{add-log-current-defun}.
+
+@item
+If @code{treesit-simple-imenu-settings} (@pxref{Imenu}) is
+non-@code{nil}, it sets up Imenu.
@end itemize
@end defun
@@ -1735,6 +1759,55 @@ For more information of these built-in tree-sitter
features,
For supporting mixing of multiple languages in a major mode,
@pxref{Multiple Languages}.
+Besides @code{beginning-of-defun} and @code{end-of-defun}, Emacs
+provides some additional functions for working with defuns:
+@code{treesit-defun-at-point} returns the defun node at point, and
+@code{treesit-defun-name} returns the name of a defun node.
+
+@c FIXME: Cross-reference to treesit-defun-tactic once we have it in
+@c the user manual.
+@defun treesit-defun-at-point
+This function returns the defun node at point, or @code{nil} if none
+is found. It respects @code{treesit-defun-tactic}: if its value is
+@code{top-level}, this function returns the top-level defun, and if
+its value is @code{nested}, it returns the immediate enclosing defun.
+
+This function requires @code{treesit-defun-type-regexp} to work. If
+it is @code{nil}, this function simply returns @code{nil}.
+@end defun
+
+@defun treesit-defun-name node
+This function returns the defun name of @var{node}. It returns
+@code{nil} if there is no defun name for @var{node}, or if @var{node}
+is not a defun node, or if @var{node} is @code{nil}.
+
+Depending on the language and major mode, the defun names are names
+like function name, class name, struct name, etc.
+
+If @code{treesit-defun-name-function} is @code{nil}, this function
+always returns @code{nil}.
+@end defun
+
+@defvar treesit-defun-name-function
+If non-@code{nil}, this variable's value should be a function that is
+called with a node as its argument, and returns the defun name of the
+node. The function should have the same semantic as
+@code{treesit-defun-name}: if the node is not a defun node, or the
+node is a defun node but doesn't have a name, or the node is
+@code{nil}, it should return @code{nil}.
+@end defvar
+
+@defvar treesit-defun-type-regexp
+This variable determines which nodes are considered defuns by Emacs.
+It can be a regexp that matches the type of defun nodes.
+
+Sometimes not all nodes matched by the regexp are valid defuns.
+Therefore, this variable can also be a cons cell of the form
+@w{(@var{regexp} . @var{pred})}, where @var{pred} should be a function
+that takes a node as its argument, and returns @code{t} if the node is
+valid defun, or @code{nil} if it is not valid.
+@end defvar
+
@node Tree-sitter C API
@section Tree-sitter C API Correspondence
@@ -1759,7 +1832,7 @@ Using (row, column) coordinates as position.
Updating a node with changes. (In Emacs, retrieve a new node instead
of updating the existing one.)
@item
-Querying statics of a language definition.
+Querying statics of a language grammar.
@end itemize
In addition, Emacs makes some changes to the C API to make the API more
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index ef938e88ec..9834909993 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5351,7 +5351,7 @@ called @var{gif}, you have to mark it specially to let
@end defun
-@defun sqlite-select db query &optional values result-type
+@defun sqlite-select db query &optional values return-type
Select some data from @var{db} and return them. For instance:
@lisp
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index ef9990c057..e5bac25cac 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -17341,8 +17341,12 @@ it can be a variable which is a time zone name in
upper- or lower-case.
For example @samp{tzone(PST) = tzone(8)} and @samp{tzone(pdt) = tzone(7)}
(for Pacific standard and daylight saving times, respectively).
-North American and European time zone names are defined as follows;
-note that for each time zone there is one name for standard time,
+North American and European time zone names are defined as follows.
+These names are obsolescent and new code should not rely on them:
+the @samp{YST}-related names have disagreed with time in Yukon since 1973,
+and other names could well become confusing or wrong in the future
+as countries change their time zone rules.
+For each time zone there is one name for standard time,
another for daylight saving time, and a third for ``generalized'' time
in which the daylight saving adjustment is computed from context.
@@ -17364,7 +17368,7 @@ To define time zone names that do not appear in the
above table,
you must modify the Lisp variable @code{math-tzone-names}. This
is a list of lists describing the different time zone names; its
structure is best explained by an example. The three entries for
-Pacific Time look like this:
+circa-2022 US Pacific Time look like this:
@smallexample
@group
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 2ab2e90894..249b58c73d 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -529,6 +529,16 @@ Translate morse code in messages
@end table
+@anchor{Required Modules}
+@subheading Required Modules
+@cindex required modules
+
+Note that some modules are essential to core IRC operations and thus
+not listed above. You can nevertheless still remove these, but doing
+so demands special precautions to avoid degrading the user experience.
+At present, the only such module is @code{networks}, whose library ERC
+always loads anyway.
+
@subheading Local Modules
@cindex local modules
@@ -1290,7 +1300,7 @@ When preparing entries for your backend, it may help to
get a feel for
how ERC and its modules conduct searches, especially when exploring a
new context, such as channel keys. (Hint: in such situations, try
temporarily setting the variable @code{auth-source-debug} to @code{t}
-and checking @samp{*Messages*} periodically for insights into how
+and checking @file{*Messages*} periodically for insights into how
auth-source is operating.) Overall, though, ERC tries to be
consistent in performing queries across various authentication
contexts. Here's what to expect with respect to the @samp{host}
diff --git a/doc/misc/info.texi b/doc/misc/info.texi
index 4db35ebf0f..84c4eeba4b 100644
--- a/doc/misc/info.texi
+++ b/doc/misc/info.texi
@@ -1098,9 +1098,8 @@ name, and @key{RET}. Thus, @kbd{gTop@key{RET}} would go
to the node
called @samp{Top} in this file. (This is equivalent to @kbd{t}, see
@ref{Help-Int}.) @kbd{gGo to node@key{RET}} would come back here.
- Unlike @kbd{m}, @kbd{g} does not allow the use of abbreviations.
-But it does allow completion, so you can type @key{TAB} to complete a
-partial node name.
+ Like @kbd{m}, @kbd{g} allows the use of abbreviations. It also allows
+completion, so you can type @key{TAB} to complete a partial node name.
@cindex go to another Info file
To go to a node in another file, you can include the file name in the
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 1a80c62edb..0650ad69a8 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -793,7 +793,7 @@ You should see the scan line for your message, and perhaps
others. Use
@cartouche
@smallexample
- 3 t08/24 root received fax files on Wed Aug 24 11:00:13 PDT 1
+ 3 t08/24 root received fax files on Wed Aug 24 11:00:13 -0700 1
# 4+t08/24 To:wohler Test<<This is a test message to get the wheels
-:%% @{+inbox/select@} 4 msgs (1-4) Bot L4 (MH-Folder Show)---------
diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi
index 3f6dcd022a..49c86f6812 100644
--- a/doc/misc/sc.texi
+++ b/doc/misc/sc.texi
@@ -404,7 +404,7 @@ from the alist with the @code{sc-mail-field} function.
Thus, if the
following fields were present in the original article:
@example
-Date:@: 08 April 1991, 17:32:09 EST
+Date:@: 08 Apr 1991 17:32:09 -0500
Subject:@: Better get out your asbestos suit
@end example
@@ -415,7 +415,7 @@ then, the following lisp constructs return:
@example
(sc-mail-field "date")
-==> "08 April 1991, 17:32:09 EST"
+==> "08 Apr 1991 17:32:09 -0500"
(sc-mail-field "subject")
==> "Better get out your asbestos suit"
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index cfc77a84ea..cfe83359f6 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2022-11-12.22}
+\def\texinfoversion{2022-12-19.22}
%
% Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc.
%
@@ -591,6 +591,9 @@
% @/ allows a line break.
\let\/=\allowbreak
+% @- allows explicit insertion of hyphenation points
+\def\-{\discretionary{\normaldash}{}{}}%
+
% @. is an end-of-sentence period.
\def\.{.\spacefactor=\endofsentencespacefactor\space}
@@ -1537,9 +1540,10 @@ output) for that.)}
\next}
\def\makelink{\addtokens{\toksB}%
{\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0}
- \def\pdflink#1{%
+ \def\pdflink#1{\pdflinkpage{#1}{#1}}%
+ \def\pdflinkpage#1#2{%
\startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}}
- \setcolor{\linkcolor}#1\endlink}
+ \setcolor{\linkcolor}#2\endlink}
\def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
\else
% non-pdf mode
@@ -1786,10 +1790,11 @@ output) for that.)}
\next}
\def\makelink{\addtokens{\toksB}%
{\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0}
- \def\pdflink#1{%
+ \def\pdflink#1{\pdflinkpage{#1}{#1}}%
+ \def\pdflinkpage#1#2{%
\special{pdf:bann << /Border [0 0 0]
/Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}%
- \setcolor{\linkcolor}#1\endlink}
+ \setcolor{\linkcolor}#2\endlink}
\def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
%
%
@@ -2134,6 +2139,11 @@ end
\pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}%
}%
\fi\fi
+%
+% This is what gets called when #5 of \setfont is empty.
+\let\cmap\gobble
+%
+% (end of cmaps)
% Set the font macro #1 to the font named \fontprefix#2.
@@ -2149,11 +2159,10 @@ end
\def\setfont#1#2#3#4#5{%
\font#1=\fontprefix#2#3 scaled #4
\csname cmap#5\endcsname#1%
+ \ifx#2\ttshape\hyphenchar#1=-1 \fi
+ \ifx#2\ttbshape\hyphenchar#1=-1 \fi
+ \ifx#2\ttslshape\hyphenchar#1=-1 \fi
}
-% This is what gets called when #5 of \setfont is empty.
-\let\cmap\gobble
-%
-% (end of cmaps)
% Use cm as the default font prefix.
% To specify the font prefix, you must define \fontprefix
@@ -2815,13 +2824,6 @@ end
% @sansserif, explicit sans.
\def\sansserif#1{{\sf #1}}
-% We can't just use \exhyphenpenalty, because that only has effect at
-% the end of a paragraph. Restore normal hyphenation at the end of the
-% group within which \nohyphenation is presumably called.
-%
-\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation}
-\def\restorehyphenation{\hyphenchar\font = `- }
-
\newif\iffrenchspacing
\frenchspacingfalse
@@ -2890,27 +2892,29 @@ end
% Switch to typewriter.
\tt
%
- % But `\ ' produces the large typewriter interword space.
+ % `\ ' produces the large typewriter interword space.
\def\ {{\spaceskip = 0pt{} }}%
%
- % Turn off hyphenation.
- \nohyphenation
- %
\plainfrenchspacing
#1%
}%
\null % reset spacefactor to 1000
}
-% We *must* turn on hyphenation at `-' and `_' in @code.
-% (But see \codedashfinish below.)
+% This is for LuaTeX: It is not sufficient to disable hyphenation at
+% explicit dashes by setting `\hyphenchar` to -1.
+\def\dashnobreak{%
+ \normaldash
+ \penalty 10000 }
+
+% We must turn on hyphenation at `-' and `_' in @code.
% Otherwise, it is too hard to avoid overfull hboxes
% in the Emacs manual, the Library manual, etc.
+% We explicitly allow hyphenation at these characters
+% using \discretionary.
%
-% Unfortunately, TeX uses one parameter (\hyphenchar) to control
-% both hyphenation at - and hyphenation within words.
-% We must therefore turn them both off (\tclose does that)
-% and arrange explicitly to hyphenate at a dash. -- rms.
+% Hyphenation at - and hyphenation within words was turned off
+% by default for the tt fonts using the \hyphenchar parameter of TeX.
{
\catcode`\-=\active \catcode`\_=\active
\catcode`\'=\active \catcode`\`=\active
@@ -2923,7 +2927,7 @@ end
\let-\codedash
\let_\codeunder
\else
- \let-\normaldash
+ \let-\dashnobreak
\let_\realunder
\fi
% Given -foo (with a single dash), we do not want to allow a break
@@ -3200,7 +3204,7 @@ end
% definition of @key with no lozenge.
%
-\def\key#1{{\setregularquotes \nohyphenation \tt #1}\null}
+\def\key#1{{\setregularquotes \tt #1}\null}
% @clicksequence{File @click{} Open ...}
\def\clicksequence#1{\begingroup #1\endgroup}
@@ -3747,6 +3751,7 @@ $$%
% Open one extra group, as we want to close it in the middle of \Etitlepage.
\begingroup
\parindent=0pt \textfonts
+ \headingsoff
% Leave some space at the very top of the page.
\vglue\titlepagetopglue
% No rule at page bottom unless we print one at the top with @title.
@@ -3774,11 +3779,9 @@ $$%
% If we use the new definition of \page, we always get a blank page
% after the title page, which we certainly don't want.
\oldpage
+ \pageone
\endgroup
%
- % Need this before the \...aftertitlepage checks so that if they are
- % in effect the toc pages will come out with page numbers.
- \HEADINGSon
}
\def\finishtitlepage{%
@@ -3947,7 +3950,6 @@ $$%
}
\def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting
-\HEADINGSoff % it's the default
% When we turn headings on, set the page number to 1.
\def\pageone{
@@ -3971,7 +3973,7 @@ $$%
\pageone
\HEADINGSsinglex
}
-\def\HEADINGSon{\HEADINGSdouble}
+% \def\HEADINGSon{\HEADINGSdouble} % defined by \CHAPPAGon
\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
\let\HEADINGSdoubleafter=\HEADINGSafter
@@ -5616,6 +5618,11 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\newdimen\entryrightmargin
\entryrightmargin=0pt
+% for PDF output, whether to make the text of the entry a link to the page
+% number. set for @contents and @shortcontents where there is only one
+% page number.
+\newif\iflinkentrytext
+
% \entry typesets a paragraph consisting of the text (#1), dot leaders, and
% then page number (#2) flushed to the right margin. It is used for index
% and table of contents entries. The paragraph is indented by \leftskip.
@@ -5642,7 +5649,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
}
\def\entrybreak{\unskip\space\ignorespaces}%
\def\doentry{%
- % Save the text of the entry
+ % Save the text of the entry in \boxA
\global\setbox\boxA=\hbox\bgroup
\bgroup % Instead of the swallowed brace.
\noindent
@@ -5652,12 +5659,21 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% with catcodes occurring.
}
{\catcode`\@=11
+% #1 is the page number
\gdef\finishentry#1{%
- \egroup % end box A
+ \egroup % end \boxA
\dimen@ = \wd\boxA % Length of text of entry
+ % add any leaders and page number to \boxA.
\global\setbox\boxA=\hbox\bgroup
- \unhbox\boxA
- % #1 is the page number.
+ \ifpdforxetex
+ \iflinkentrytext
+ \pdflinkpage{#1}{\unhbox\boxA}%
+ \else
+ \unhbox\boxA
+ \fi
+ \else
+ \unhbox\boxA
+ \fi
%
% Get the width of the page numbers, and only use
% leaders if they are present.
@@ -5676,6 +5692,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi
\fi
\egroup % end \boxA
+ %
+ % now output
\ifdim\wd\boxB = 0pt
\noindent\unhbox\boxA\par
\nobreak
@@ -6375,7 +6393,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi
}
-\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname}
+\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname\HEADINGSon}
\def\CHAPPAGoff{%
\global\let\contentsalignmacro = \chappager
@@ -6392,7 +6410,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\global\let\pchapsepmacro=\chapoddpage
\global\def\HEADINGSon{\HEADINGSdouble}}
-\CHAPPAGon
+\setchapternewpage on
% \chapmacro - Chapter opening.
%
@@ -6772,6 +6790,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\thistitle{}% no title in double-sided headings
% Record where the Roman numerals started.
\ifnum\romancount=0 \global\romancount=\pagecount \fi
+ \linkentrytexttrue
}
% \raggedbottom in plain.tex hardcodes \topskip so override it
@@ -6899,7 +6918,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Chapters, in the short toc.
% See comments in \dochapentry re vbox and related settings.
\def\shortchapentry#1#2#3#4{%
- \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}%
+ \tocentry{\shortchaplabel{#2}\labelspace #1}{#4}%
}
% Appendices, in the main contents.
@@ -6914,7 +6933,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Unnumbered chapters.
\def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}}
-\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}}
+\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{#4}}
% Sections.
\def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}}
@@ -6946,24 +6965,24 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Move the page numbers slightly to the right
\advance\entryrightmargin by -0.05em
\chapentryfonts
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+ \tocentry{#1}{#2}%
\endgroup
\nobreak\vskip .25\baselineskip plus.1\baselineskip
}
\def\dosecentry#1#2{\begingroup
\secentryfonts \leftskip=\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+ \tocentry{#1}{#2}%
\endgroup}
\def\dosubsecentry#1#2{\begingroup
\subsecentryfonts \leftskip=2\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+ \tocentry{#1}{#2}%
\endgroup}
\def\dosubsubsecentry#1#2{\begingroup
\subsubsecentryfonts \leftskip=3\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
+ \tocentry{#1}{#2}%
\endgroup}
% We use the same \entry macro as for the index entries.
@@ -6972,9 +6991,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% Space between chapter (or whatever) number and the title.
\def\labelspace{\hskip1em \relax}
-\def\dopageno#1{{\rm #1}}
-\def\doshortpageno#1{{\rm #1}}
-
\def\chapentryfonts{\secfonts \rm}
\def\secentryfonts{\textfonts}
\def\subsecentryfonts{\textfonts}
@@ -7410,7 +7426,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\endgroup
%
\def\setupverb{%
- \tt % easiest (and conventionally used) font for verbatim
+ \tt
\def\par{\leavevmode\endgraf}%
\setcodequotes
\tabeightspaces
@@ -7587,32 +7603,28 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\exdentamount=\defbodyindent
}
-\def\dodefunx#1{%
- % First, check whether we are in the right environment:
- \checkenv#1%
- %
- % As above, allow line break if we have multiple x headers in a row.
- % It's not a great place, though.
- \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi
- %
- % And now, it's time to reuse the body of the original defun:
- \expandafter\gobbledefun#1%
-}
-\def\gobbledefun#1\startdefun{}
+\newtoks\defidx
+\newtoks\deftext
-% \printdefunline \deffnheader{text}
+\def\useindex#1{\defidx={#1}\ignorespaces}
+
+% Called as \printdefunline \deffooheader{text}
%
\def\printdefunline#1#2{%
\begingroup
\plainfrenchspacing
- % call \deffnheader:
+ % call \deffooheader:
#1#2 \endheader
+ % create the index entry
+ \defcharsdefault
+ \edef\temp{\noexpand\doind{\the\defidx}{\the\deftext}}%
+ \temp
% common ending:
\interlinepenalty = 10000
\advance\rightskip by 0pt plus 1fil\relax
\endgraf
\nobreak\vskip -\parskip
- \penalty\defunpenalty % signal to \startdefun and \dodefunx
+ \penalty\defunpenalty % signal to \startdefun and \deffoox
% Some of the @defun-type tags do not enable magic parentheses,
% rendering the following check redundant. But we don't optimize.
\checkparencounts
@@ -7621,7 +7633,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\def\Edefun{\endgraf\medbreak}
-% \makedefun{deffoo}{ (definition of \deffooheader) }
+% \makedefun{deffoo} (\deffooheader parameters) { (\deffooheader expansion) }
%
% Define \deffoo, \deffoox \Edeffoo and \deffooheader.
\def\makedefun#1{%
@@ -7636,8 +7648,18 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\doingtypefnfalse % distinguish typed functions from all else
\parseargusing\activeparens{\printdefunline#3}%
}%
- \def#2{\dodefunx#1}%
- \def#3%
+ \def#2{%
+ % First, check whether we are in the right environment:
+ \checkenv#1%
+ %
+ % As in \startdefun, allow line break if we have multiple x headers
+ % in a row. It's not a great place, though.
+ \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi
+ %
+ \doingtypefnfalse % distinguish typed functions from all else
+ \parseargusing\activeparens{\printdefunline#3}%
+ }%
+ \def#3% definition of \deffooheader follows
}
\newif\ifdoingtypefn % doing typed function?
@@ -7662,18 +7684,23 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\fi\fi
}
+\def\defind#1#2{
+ \defidx={#1}%
+ \deftext={#2}%
+}
+
% Untyped functions:
% @deffn category name args
\makedefun{deffn}#1 #2 #3\endheader{%
- \doind{fn}{\code{#2}}%
+ \defind{fn}{\code{#2}}%
\defname{#1}{}{#2}\magicamp\defunargs{#3\unskip}%
}
% @defop category class name args
\makedefun{defop}#1 {\defopheaderx{#1\ \putwordon}}
\def\defopheaderx#1#2 #3 #4\endheader{%
- \doind{fn}{\code{#3}\space\putwordon\ \code{#2}}%
+ \defind{fn}{\code{#3}\space\putwordon\ \code{#2}}%
\defname{#1\ \code{#2}}{}{#3}\magicamp\defunargs{#4\unskip}%
}
@@ -7681,7 +7708,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @deftypefn category type name args
\makedefun{deftypefn}#1 #2 #3 #4\endheader{%
- \doind{fn}{\code{#3}}%
+ \defind{fn}{\code{#3}}%
\doingtypefntrue
\defname{#1}{#2}{#3}\defunargs{#4\unskip}%
}
@@ -7689,7 +7716,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @deftypeop category class type name args
\makedefun{deftypeop}#1 {\deftypeopheaderx{#1\ \putwordon}}
\def\deftypeopheaderx#1#2 #3 #4 #5\endheader{%
- \doind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}%
+ \defind{fn}{\code{#4}\space\putwordon\ \code{#1\ \code{#2}}}%
\doingtypefntrue
\defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}%
}
@@ -7698,14 +7725,14 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @deftypevr category type var args
\makedefun{deftypevr}#1 #2 #3 #4\endheader{%
- \doind{vr}{\code{#3}}%
+ \defind{vr}{\code{#3}}%
\defname{#1}{#2}{#3}\defunargs{#4\unskip}%
}
% @deftypecv category class type var args
\makedefun{deftypecv}#1 {\deftypecvheaderx{#1\ \putwordof}}
\def\deftypecvheaderx#1#2 #3 #4 #5\endheader{%
- \doind{vr}{\code{#4}\space\putwordof\ \code{#2}}%
+ \defind{vr}{\code{#4}\space\putwordof\ \code{#2}}%
\defname{#1\ \code{#2}}{#3}{#4}\defunargs{#5\unskip}%
}
@@ -7722,7 +7749,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% @deftp category name args
\makedefun{deftp}#1 #2 #3\endheader{%
- \doind{tp}{\code{#2}}%
+ \defind{tp}{\code{#2}}%
\defname{#1}{}{#2}\defunargs{#3\unskip}%
}
@@ -10489,7 +10516,7 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}%
\DeclareUnicodeCharacter{00AF}{\={ }}%
%
- \DeclareUnicodeCharacter{00B0}{\textdegree}
+ \DeclareUnicodeCharacter{00B0}{\textdegree}%
\DeclareUnicodeCharacter{00B1}{\ensuremath\pm}%
\DeclareUnicodeCharacter{00B2}{$^2$}%
\DeclareUnicodeCharacter{00B3}{$^3$}%
diff --git a/etc/DEBUG b/etc/DEBUG
index 2fe2fbc2ce..0ace2a120f 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -277,8 +277,13 @@ GDB:
If you do this, then typing C-c or C-BREAK into the console window
through which you interact with GDB will stop Emacs and return control
to the debugger, no matter if Emacs displays GUI or text-mode frames.
-This is the only reliable alternative on MS-Windows to get control to
-the debugger, besides setting breakpoints in advance.
+With GDB versions before 13.1, this is the only reliable alternative
+on MS-Windows to get control to the debugger, besides setting
+breakpoints in advance. GDB 13.1 changed the way C-c and C-BREAK are
+handled on Windows, so with those newer versions, you don't need the
+"set new-console 1" setting to be able to interrupt Emacs by typing
+C-c or C-BREAK into the console window from which you started Emacs
+and where you interact with GDB.
** Examining Lisp object values.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 76439f1d06..b577047ebc 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -39,6 +39,14 @@ anew. The pre-5.4 "disabled" behavior has been restored and
will
remain accessible for the foreseeable future, warts and all (e.g.,
with its often superfluous "/DIALED-HOST" suffixing always present).
+** The 'networks' module is now quasi-required.
+The 'networks' module is now all but required for everyday interactive
+use. A default member of 'erc-modules' since ERC 5.3, 'networks' has
+grown increasingly integral to core client operations over the years.
+From now on, only the most essential operations will be officially
+supported in its absence, and users will see a warning upon
+entry-point invocation when it's not present.
+
** Tighter auth-source integration with bigger changes on the horizon.
The days of hit-and-miss auth-source queries are hopefully behind us.
With the overhaul of the services module temporarily shelved and the
@@ -111,7 +119,8 @@ and 'erc-backend'.
The function 'erc-network' always returns non-nil in server and target
buffers belonging to a successfully established IRC connection, even
-after that connection has been closed.
+after that connection has been closed. (Also see the note in the
+section above about the 'networks' module basically being mandatory.)
In 5.4, support for network symbols as keys was added for
'erc-autojoin-channels-alist'. This has been extended to include
diff --git a/etc/NEWS b/etc/NEWS
index af7f1050b7..50937f5e96 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -35,9 +35,24 @@ This means it should be less necessary to disable the likes
of
`select-active-regions' when Emacs is running over a slow network
connection.
+** Emacs now updates invisible frames that are made visible by a compositor.
+If an invisible or an iconified frame is shown to the user by the
+compositing manager, Emacs will now redisplay such a frame even though
+'frame-visible-' returns nil or 'icon' for it. This can happen, for
+example, as part of preview for iconified frames.
+
* Editing Changes in Emacs 30.1
+** New helper 'transpose-sexps-function'
+Emacs now can set this defvar to customize the behavior of the
+'transpose-sexps' function.
+
+** New function 'treesit-transpose-sexps'
+treesit.el now unconditionally sets 'transpose-sexps-function' for all
+Tree-sitter modes. This functionality utilizes the new
+'transpose-sexps-function'.
+
* Changes in Specialized Modes and Packages in Emacs 30.1
---
@@ -102,6 +117,53 @@ point is not in a comment or a string. It is by default
bound to
* Lisp Changes in Emacs 30.1
+** New or changed byte-compilation warnings
+
+---
+*** Warn about empty bodies for more special forms and macros.
+The compiler now warns about an empty body argument to 'when',
+'unless', 'ignore-error' and 'with-suppressed-warnings' in addition to
+the existing warnings for 'let' and 'let*'. Example:
+
+ (when (> x 2))
+
+This warning can be suppressed using 'with-suppressed-warnings' with
+the warning name 'empty-body'.
+
+---
+*** Warn about quoted error names in 'condition-case' and 'ignore-error'.
+The compiler now warns about quoted condition (error) names
+in 'condition-case' and 'ignore-error'. Example:
+
+ (condition-case nil
+ (/ x y)
+ ('arith-error "division by zero"))
+
+Quoting them adds the error name 'quote' to those handled or ignored
+respectively, which was probably not intended.
+
+---
+*** Warn about comparison with literal constants without defined identity.
+The compiler now warns about comparisons by identity with a literal
+string, cons, vector, record, function, large integer or float as this
+may not match any value at all. Example:
+
+ (eq x "hello")
+
+Only literals for symbols and small integers (fixnums), including
+characters, are guaranteed to have a consistent (unique) identity.
+This warning applies to 'eq', 'eql', 'memq', 'memql', 'assq', 'rassq',
+'remq' and 'delq'.
+
+To compare by (structural) value, use 'equal', 'member', 'assoc',
+'rassoc', 'remove' or 'delete' instead. Floats and bignums can also
+be compared using 'eql', '=' and 'memql'. Function literals cannot be
+compared reliably at all.
+
+This warning can be suppressed using 'with-suppressed-warnings' with
+the warning name 'suspicious'.
+
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index 6f2f74fab4..38b7865626 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -106,7 +106,7 @@ If a constant file name is required, the file can be
renamed to
"emacs.pdmp", and Emacs will find it during startup anyway.
---
-** Emacs now uses XInput 2 for input events.
+** Emacs on X now uses XInput 2 for input events.
If your X server has support and you have the XInput 2 development
headers installed, Emacs will use the X Input Extension for handling
input. If this causes problems, you can configure Emacs with the
@@ -115,6 +115,19 @@ option '--without-xinput2' to disable this support.
'(featurep 'xinput2)' can be used to test for the presence of XInput 2
support from Lisp programs.
++++
+** Emacs now supports being built with pure GTK.
+To use this option, make sure the GTK 3 (version 3.22.23 or later) and
+Cairo development files are installed, and configure Emacs with the
+option '--with-pgtk'. Unlike the default X and GTK build, the
+resulting Emacs binary will work on any underlying window system
+supported by GDK, such as Wayland and Broadway. We recommend that you
+use this configuration only if you are running a window system other
+than X that's supported by GDK. Running this configuration on X is
+known to have problems, such as undesirable frame positioning and
+various issues with keyboard input of sequences such as 'C-;' and
+'C-S-u'.
+
---
** Emacs no longer reduces the size of the Japanese dictionary.
Building Emacs includes generation of a Japanese dictionary, which is
@@ -130,23 +143,10 @@ by saying
after deleting "lisp/leim/ja-dic/ja-dic.el".
-+++
-** Emacs now supports being built with pure GTK.
-To use this option, make sure the GTK 3 (version 3.22.23 or later) and
-Cairo development files are installed, and configure Emacs with the
-option '--with-pgtk'. Unlike the default X and GTK build, the
-resulting Emacs binary will work on any underlying window system
-supported by GDK, such as Wayland and Broadway. We do not recommend
-that you use this configuration, unless you are running a window
-system that's supported by GDK other than X. Running this
-configuration on X is known to have problems, such as undesirable
-frame positioning and various issues with keyboard input of sequences
-such as 'C-;' and 'C-S-u'.
-
---
** The docstrings of preloaded files are not in "etc/DOC" any more.
-Instead, they're fetched as needed from the corresponding ".elc" file,
-as was already the case for all the non-preloaded files.
+Instead, they're fetched as needed from the corresponding ".elc"
+files, as was already the case for all the non-preloaded files.
* Startup Changes in Emacs 29.1
@@ -172,16 +172,18 @@ the value of the final form.
+++
** Emacs now supports setting 'user-emacs-directory' via '--init-directory'.
+Use the '--init-directory' command-line option to set
+'user-emacs-directory'.
+++
** Emacs now has a '--fingerprint' option.
-This will output a string identifying the current Emacs build.
+This will output a string identifying the current Emacs build, and exit.
+++
** New hook 'after-pdump-load-hook'.
This is run at the end of the Emacs startup process, and is meant to
-be used to reinitialize structures that would normally be done at load
-time.
+be used to reinitialize data structures that would normally be done at
+load time.
** Native Compilation
@@ -189,13 +191,15 @@ time.
*** New variable 'inhibit-automatic-native-compilation'.
If set, Emacs will inhibit native compilation (and won't write
anything to the eln cache automatically). The variable is initialized
-from the 'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION' environment
-variable on Emacs startup.
+during Emacs startup from the environment variable
+'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION'.
---
*** New command 'native-compile-prune-cache'.
-This command deletes older eln cache entries (but not the ones for
-the current Emacs version).
+This command deletes old subdirectories of the eln cache (but not the
+ones for the current Emacs version). Note that subdirectories of the
+system directory where the "*.eln" files are installed (usually, the
+last entry in 'native-comp-eln-load-path') are not deleted.
---
*** New function 'startup-redirect-eln-cache'.
@@ -219,12 +223,12 @@ moved to the 'i' keymap, so '+' is now 'i +', '-' is now
'i -', and
you can rotate an image twice by saying 'i r r', for instance.
+++
-** Emacs now picks the correct coding system for X input methods.
-Previously, Emacs would use the locale coding system for input
+** Emacs now picks the correct coding-system for X input methods.
+Previously, Emacs would use 'locale-coding-system' for input
methods, which could in some circumstances be incorrect, especially
when the input method chose to fall back to some other coding system.
-Now, Emacs automatically detects the coding system used by input
+Emacs now automatically detects the coding-system used by input
methods, and uses that to decode input in preference to the value of
'locale-coding-system'. This unfortunately means that users who have
changed the coding system used to decode X keyboard input must adjust
@@ -244,7 +248,7 @@ names to be excluded from adding such excerpts.
In Emacs versions previous to Emacs 28.1, 'show-paren-mode' defaulted
off. In Emacs 28.1, the mode was switched on in all buffers. In
Emacs 29.1, this was changed to be switched on in all editing-related
-buffers, but not in buffers that inherit from 'special-mode'. To get
+buffers, but not in buffers that inherit from 'special-mode'. To go
back to how things worked in Emacs 28.1, put the following in your
init file:
@@ -291,7 +295,7 @@ mouse (in 'transient-mark-mode') and then hitting 'd' would
skip dot
files. These now work equivalently.
+++
-** Warning about "eager macro-expansion failure" is changed into an error.
+** Warning about "eager macro-expansion failure" is now an error.
---
** Previously, the X "reverseVideo" value at startup was heeded for all frames.
@@ -324,9 +328,9 @@ this off, disable the new 'isearch-fold-quotes-mode' minor
mode.
** Sorting commands no longer necessarily change modification status.
In earlier Emacs versions, commands like 'M-x sort-lines' would always
change buffer modification status to "modified", whether they changed
-something in the buffer or not. This has been changed: The buffer is
-marked as modified only if the sorting ended up changing the contents
-of the buffer.
+something in the buffer or not. This has been changed: the buffer is
+marked as modified only if the sorting ended up actually changing the
+contents of the buffer.
---
** 'string-lines' handles trailing newlines differently.
@@ -355,7 +359,7 @@ your Init file:
---
** New user option 'term-clear-full-screen-programs'.
-By default, term will now work like most terminals when displaying
+By default, term.el will now work like most terminals when displaying
full-screen programs: When they exit, the output is cleared, leaving
what was displayed in the window before the programs started. Set
this user option to nil to revert back to the old behavior.
@@ -452,8 +456,8 @@ Names of thumbnail files generated when
'image-dired-thumbnail-storage'
is 'image-dired' now always end in ".jpg". This fixes various issues
on different platforms, but means that thumbnails generated in Emacs 28
will not be used in Emacs 29, and vice-versa. If disk space is an
-issue, consider deleting the 'image-dired-dir' directory after
-upgrading (usually "~/.emacs.d/image-dired/").
+issue, consider deleting the 'image-dired-dir' directory (usually
+"~/.emacs.d/image-dired/") after upgrading to Emacs 29.
---
** The 'rlogin' method in the URL library is now obsolete.
@@ -506,7 +510,7 @@ We recommend using 'M-x image-dired' instead.
** The autoarg.el library is now marked obsolete.
This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor
modes to emulate the behavior of the historical editor Twenex Emacs.
-It is believed to no longer be useful.
+We believe it is no longer useful.
---
** The quickurl.el library is now obsolete.
@@ -521,7 +525,7 @@ Use something like 'M-x shell RET ssh <host> RET' instead.
---
** The autoload.el library is now obsolete.
-It is superseded by the loaddefs-gen.el library.
+It is superseded by the new loaddefs-gen.el library.
---
** The netrc.el library is now obsolete.
@@ -566,7 +570,8 @@ optimizations are in effect.
A companion variable 'large-hscroll-threshold' controls when another
set of display optimizations are in effect, which are aimed
-specifically at speeding up display of long lines that are truncated.
+specifically at speeding up display of long lines that are truncated
+on display.
If you still experience slowdowns while editing files with long lines,
this may be due to line truncation, or to one of the enabled minor
@@ -594,14 +599,15 @@ increase and decrease the font size globally.
Additionally, the
user option 'global-text-scale-adjust-resizes-frames' controls whether
the frames are resized when the font size is changed.
+---
** New config variable 'syntax-wholeline-max' to reduce the cost of long lines.
This variable is used by some operations (mostly syntax-propertization
and font-locking) to treat lines longer than this variable as if they
were made up of various smaller lines. This can help reduce the
slowdowns seen in buffers made of a single long line, but can also
-cause misbehavior in the presence of such long lines (tho most of that
-misbehavior should usually be limited to mis-highlighting). You can
-recover the previous behavior with:
+cause misbehavior in the presence of such long lines (though most of
+that misbehavior should usually be limited to mis-highlighting). You
+can recover the previous behavior with:
(setq syntax-wholeline-max most-positive-fixnum)
@@ -616,7 +622,7 @@ and 'C-x 5 L' is now bound to 'find-library-other-frame'.
Emacs allows different completion predicates to be used with 'M-x'
(i.e., 'execute-extended-command') via the
'read-extended-command-predicate' user option. Emacs also has the
-'M-X' (note upper case) command, which only displays commands
+'M-X' (note upper case X) command, which only displays commands
especially relevant to the current buffer. Emacs now allows toggling
between these modes while the user is inputting a command by hitting
'M-X' while in the minibuffer.
@@ -662,7 +668,8 @@ match those regexps will be ignored by
'switch-to-prev-buffer' and
+++
** New command 'rename-visited-file'.
This command renames the file visited by the current buffer by moving
-it to a new location, and also makes the buffer visit this new file.
+it to a new name or location, and also makes the buffer visit this new
+file.
** Menus
@@ -687,19 +694,21 @@ the current Emacs process at the end, it starts a new
Emacs process
optional parameters to restart instead of just killing the current
process.
+** Drag and Drop
+
+++
-** New user option 'mouse-drag-mode-line-buffer'.
+*** New user option 'mouse-drag-mode-line-buffer'.
If non-nil, dragging on the buffer name part of the mode-line will
drag the buffer's associated file to other programs. This option is
currently only available on X, Haiku and Nextstep (GNUstep or macOS).
+++
-** New user option 'mouse-drag-and-drop-region-cross-program'.
+*** New user option 'mouse-drag-and-drop-region-cross-program'.
If non-nil, this option allows dragging text in the region from Emacs
to another program.
---
-** New user option 'mouse-drag-and-drop-region-scroll-margin'.
+*** New user option 'mouse-drag-and-drop-region-scroll-margin'.
If non-nil, this option allows scrolling a window while dragging text
around without a scroll wheel.
@@ -709,12 +718,12 @@ This prevents mouse drag gestures from putting empty
strings onto the
kill ring.
+++
-** New user options 'dnd-indicate-insertion-point' and 'dnd-scroll-margin'.
+*** New user options 'dnd-indicate-insertion-point' and 'dnd-scroll-margin'.
These options allow adjusting point and scrolling a window when
dragging items from another program.
+++
-** The X Direct Save (XDS) protocol is now supported.
+*** The X Direct Save (XDS) protocol is now supported.
This means dropping an image or file link from programs such as
Firefox will no longer create a temporary file in a random directory,
instead asking you where to save the file first.
@@ -746,6 +755,7 @@ part of the buffer.
+++
** 'count-words' will now report sentence count when used interactively.
++++
** New user option 'set-message-functions'.
It allows selecting more functions for 'set-message-function'
in addition to the default function that handles messages
@@ -884,6 +894,7 @@ This is in addition to previously-supported ways of
discovering 24-bit
color support: either via the "RGB" or "setf24" capabilities, or if
the 'COLORTERM' environment variable is set to the value "truecolor".
+---
*** Select active regions with xterm selection support.
On terminals with xterm setSelection support, the active region may be
saved to the X primary selection, following the
@@ -895,7 +906,8 @@ saved to the X primary selection, following the
The new command 'standard-display-by-replacement-char' produces Lisp
code that sets up the 'standard-display-table' to use a replacement
character for display of characters that the text-mode terminal
-doesn't support. It is most useful with the Linux console and similar
+doesn't support. This code is intended to be used in your init files.
+This feature is most useful with the Linux console and similar
terminals, where Emacs has a reliable way of determining which
characters have glyphs in the font loaded into the terminal's memory.
@@ -936,7 +948,7 @@ This affects the 'ert-select-tests' function and its
callers.
** Emoji
+++
-*** Emacs now has several new methods for inserting Emojis.
+*** Emacs now has several new methods for inserting Emoji.
The Emoji commands are under the new 'C-x 8 e' prefix.
+++
@@ -946,42 +958,42 @@ combinations in a graphical menu system.
+++
*** New command 'emoji-search' (bound to 'C-x 8 e s').
-This command lets you search for Emojis based on names.
+This command lets you search for Emoji based on names.
+++
*** New command 'emoji-list' (bound to 'C-x 8 e l').
-This command lists all Emojis (categorized by themes) in a special
+This command lists all Emoji (categorized by themes) in a special
buffer and lets you choose one of them.
---
*** New command 'emoji-recent' (bound to 'C-x 8 e r').
-This command lets you choose among the Emojis you have recently
+This command lets you choose among the Emoji you have recently
inserted.
+++
*** New command 'emoji-describe' (bound to 'C-x 8 e d').
-This command will tell you the name of the Emoji at point. (This
-command also works for non-Emoji characters.)
+This command will tell you the name of the Emoji at point. (It also
+works for non-Emoji characters.)
---
*** New commands 'emoji-zoom-increase' and 'emoji-zoom-decrease'.
These are bound to 'C-x 8 e +' and 'C-x 8 e -', respectively. They
-can be used on any character, but are mainly useful for emoji.
+can be used on any character, but are mainly useful for Emoji.
---
*** New input method 'emoji'.
-This allows you to enter emoji using short strings, eg ':face_palm:'
+This allows you to enter Emoji using short strings, eg ':face_palm:'
or ':scream:'.
** Help
---
-*** Variable values displayed by 'C-h v' in "*Help*" are now font-locked.
+*** Variable values displayed by 'C-h v' in "*Help*" are now fontified.
+++
*** New user option 'help-clean-buttons'.
-If non-nil, link buttons in "*Help*" will have any surrounding quotes
-removed.
+If non-nil, link buttons in "*Help*" buffers will have any surrounding
+quotes removed.
---
*** 'M-x apropos-variable' output now includes values of variables.
@@ -992,13 +1004,13 @@ When displaying docstrings in "*Help*" buffers, strings
that are
"`like-this'" are made into links (if they point to a bound
function/variable). This can lead to false positives when talking
about values that are symbols that happen to have the same names as
-functions/variables. To inhibit this buttonification, the new
-"\\+`like-this'" syntax can be used.
+functions/variables. To inhibit this buttonification, use the new
+"\\+`like-this'" syntax.
+++
*** New user option 'help-window-keep-selected'.
If non-nil, commands to show the info manual and the source will reuse
-the same window the "*Help*" buffer is shown in.
+the same window in which the "*Help*" buffer is shown.
---
*** Commands like 'C-h f' have changed how they describe menu bindings.
@@ -1027,19 +1039,19 @@ it's easy to make an edit that yields an invalid result.
---
*** 'C-h b' uses outlining by default.
-Set 'describe-bindings-outline' to nil to get the old behavior.
+Set 'describe-bindings-outline' to nil to get back the old behavior.
---
*** Jumping to function/variable source now saves mark before moving point.
-Jumping to source from "*Help*" buffer moves the point when the source
-buffer is already open. Now, the old point is pushed to mark ring.
+Jumping to source from a "*Help*" buffer moves point when the source
+buffer is already open. Now, the old point is pushed onto mark ring.
+++
*** New key bindings in "*Help*" buffers: 'n' and 'p'.
These will take you (respectively) to the next and previous "page".
---
-*** 'describe-char' now also outputs the name of emoji combinations.
+*** 'describe-char' now also outputs the name of Emoji sequences.
+++
*** New key binding in "*Help*" buffer: 'I'.
@@ -1065,9 +1077,9 @@ the default candidate.
*** New command 'help-quick' displays an overview of common commands.
The command pops up a buffer at the bottom of the screen with a few
helpful commands for various tasks. You can toggle the display using
-'C-h q'.
+'C-h C-q'.
-** Emacs 29.1 comes with Org v9.6.
+** Emacs now comes with Org v9.6.
See the file ORG-NEWS for user-visible changes in Org.
** Outline Mode
@@ -1075,12 +1087,12 @@ See the file ORG-NEWS for user-visible changes in Org.
+++
*** Support for customizing the default visibility state of headings.
Customize the user option 'outline-default-state' to define what
-headings will be visible after Outline mode is turned on. When equal
-to a number, the user option 'outline-default-rules' determines the
-visibility of the subtree starting at the corresponding level. Values
-are provided to control showing a heading subtree depending on whether
-the heading matches a regexp, or on whether its subtree has long lines
-or is itself too long.
+headings will be visible initially, after Outline mode is turned on.
+When the value is a number, the user option 'outline-default-rules'
+determines the visibility of the subtree starting at the corresponding
+level. Values are provided to control showing a heading subtree
+depending on whether the heading matches a regexp, or on whether its
+subtree has long lines or is itself too long.
** Outline Minor Mode
@@ -1088,10 +1100,10 @@ or is itself too long.
*** New user option 'outline-minor-mode-use-buttons'.
If non-nil, Outline Minor Mode will use buttons to hide/show outlines
in addition to the ellipsis. The default is nil, but in 'help-mode'
-it has the value 'insert' that inserts the buttons directly to the
-buffer where you can use 'RET' to cycle outline visibility. When
+it has the value 'insert' that inserts the buttons directly into the
+buffer, and you can use 'RET' to cycle outline visibility. When
the value is 'in-margins', Outline Minor Mode uses the window margins
-to hide/show outlines.
+for buttons that hide/show outlines.
** Windows
@@ -1099,17 +1111,19 @@ to hide/show outlines.
*** New commands 'split-root-window-below' and 'split-root-window-right'.
These commands split the root window in two, and are bound to 'C-x w 2'
and 'C-x w 3', respectively. A number of other useful window-related
-commands are now available on the 'C-x w' prefix.
+commands are now available with key sequences that start with the
+'C-x w' prefix.
+++
*** New user option 'display-buffer-avoid-small-windows'.
-If non-nil, this should be a window height, a number. Windows smaller
-than this will be avoided by 'display-buffer', if possible.
+If non-nil, this should be a window height in lines, a number.
+Windows smaller than this will be avoided by 'display-buffer', if
+possible.
+++
*** New display action 'display-buffer-full-frame'.
-This action removes other windows on the frame when displaying a
-buffer.
+This action removes other windows from the frame when displaying a
+buffer on that frame.
+++
*** 'display-buffer' now can set up the body size of the chosen window.
@@ -1118,10 +1132,10 @@ For example, a 'display-buffer-alist' entry of
'(window-width . (body-columns . 40))'
will make the body of the chosen window 40 columns wide. For the
-height use 'window-height' in combination with 'body-lines'.
+height use 'window-height' and 'body-lines', respectively.
---
-*** You can customize which window 'scroll-other-window' operates on.
+*** You can customize on which window 'scroll-other-window' operates.
This is controlled by the new 'other-window-scroll-default' user option.
** Frames
@@ -1145,6 +1159,8 @@ before its name on display is truncated.
---
*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist.
+It prompts for the name of a tab and switches to it, creating a new
+tab if no tab exists by that name.
---
*** New keymap 'tab-bar-history-mode-map'.
@@ -1211,7 +1227,7 @@ Most IRC clients (including rcirc) support basic
formatting using
control codes. Under the 'C-c C-f' prefix a few commands have been
added to insert these automatically. For example, if a region is
active and 'C-c C-f C-b' is invoked, markup is inserted for the region
-to be highlighted bold.
+to be highlighted in bold.
** Imenu
@@ -1223,13 +1239,16 @@ to be highlighted bold.
Use it if you want Imenu to forget the buffer's index alist and
recreate it anew next time 'imenu' is invoked.
-+++
+---
** Emacs is now capable of abandoning a window's redisplay that takes too long.
This is controlled by the new variable 'max-redisplay-ticks'. If that
variable is set to a non-zero value, display of a window will be
aborted after that many low-level redisplay operations, thus
preventing Emacs from becoming wedged when visiting files with very
-long lines.
+long lines. The default is zero, which disables the feature: Emacs
+will wait forever for redisplay to finish. (We believe you won't need
+this feature, given the ability to display buffers with very long
+lines.)
* Editing Changes in Emacs 29.1
@@ -1242,15 +1261,15 @@ option 'cycle-spacing-actions'.
---
** 'zap-to-char' and 'zap-up-to-char' are case-sensitive for upper-case chars.
These commands now behave as case-sensitive for interactive calls when
-they are invoked with an uppercase character, regardless of the
-'case-fold-search' value.
+they are invoked with an uppercase character, regardless of the value
+of 'case-fold-search'.
---
** 'scroll-other-window' and 'scroll-other-window-down' now respect remapping.
These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other
-windows without looking a customizations in that other window. These
-functions now check whether they have been rebound in the buffer in
-that other window, and then call the remapped function instead. In
+windows without looking at customizations in that other window. These
+functions now check whether they have been rebound in the buffer shown
+in that other window, and then call the remapped function instead. In
addition, these commands now also respect the
'scroll-error-top-bottom' user option.
@@ -1267,8 +1286,8 @@ This change also affects 'cl-macrolet', 'cl-flet*' and
+++
** New user option 'translate-upper-case-key-bindings'.
-Set this option to nil to inhibit translating upper case keys to lower
-case keys.
+Set this option to nil to inhibit the default translation of upper
+case keys to their lower case variants.
+++
** New command 'ensure-empty-lines'.
@@ -1279,8 +1298,8 @@ point.
** Improved mouse behavior with auto-scrolling modes.
When clicking inside the 'scroll-margin' or 'hscroll-margin' region,
point is now moved only when releasing the mouse button. This no
-longer results in a bogus selection, unless the mouse has been
-effectively dragged.
+longer results in a bogus selection, unless the mouse has also been
+dragged.
+++
** 'kill-ring-max' now defaults to 120.
@@ -1301,10 +1320,11 @@ When non-nil, if the point is in a closing delimiter
and the opening
delimiter is offscreen, shows some context around the opening
delimiter in the echo area. The default is nil.
-May also be set to the symbols 'overlay' or 'child-frame', in which
-case the context is shown in an overlay or child-frame at the top-left
-of the current window. The latter option requires a graphical frame.
-On non-graphical frames, the context is shown in the echo area.
+This option can also be set to the symbols 'overlay' or 'child-frame',
+in which case the context is shown in an overlay or child-frame at the
+top-left of the current window. The latter option requires a
+graphical frame. On non-graphical frames, the context is shown in the
+echo area.
** Comint
@@ -1318,7 +1338,7 @@ change the terminal used on a remote host.
*** New user option 'comint-delete-old-input'.
When nil, this prevents comint from deleting the current input when
inserting previous input using '<mouse-2>'. The default is t, to
-preserve past behavior.
+preserve previous behavior.
---
*** New minor mode 'comint-fontify-input-mode'.
@@ -1339,55 +1359,88 @@ support systems where two kinds of wheel events can be
received.
** Internationalization changes
+---
*** The <Delete> function key now allows deleting the entire composed sequence.
For the details, see the item about the 'delete-forward-char' command
above.
+---
*** New user option 'composition-break-at-point'.
Setting it to a non-nil value temporarily disables automatic
composition of character sequences at point, and thus makes it easier
-to edit such sequences by allowing point to "enter" the sequence.
+to edit such sequences by allowing point to "enter" the composed
+sequence.
---
*** Support for many old scripts and writing systems.
-Emacs now supports and has language-environments and input methods for
-several dozens of old scripts that were used in the past for various
-languages. For each such script Emacs now has font-selection and
-character composition rules, a language environment, and an input
+Emacs now supports, and has language-environments and input methods,
+for several dozens of old scripts that were used in the past for
+various languages. For each such script Emacs now has font-selection
+and character composition rules, a language environment, and an input
method. The newly-added scripts and the corresponding language
environments are:
-Tai Tham script and the Northern Thai language environment
-Brahmi script and language environment
-Kaithi script and language environment
-Tirhuta script and language environment
-Sharada script and language environment
-Siddham script and language environment
-Syloti Nagri script and language environment
-Modi script and language environment
-Baybayin script and Tagalog language environment
-Hanunoo script and language environment
-Buhid script and language environment
-Tagbanwa script and language environment
-Limbu script and language environment
-Balinese script and language environment
-Javanese script and language environment
-Sundanese script and language environment
-Batak script and language environment
-Rejang script and language environment
-Makasar script and language environment
-Lontara script and language environment
-Hanifi Rohingya script and language environment
-Grantha script and language environment
-Kharoshthi script and language environment
-Lepcha script and language environment
-Meetei Mayek script and language environment
-Adlam script and language environment
-Mende Kikakui script and language environment
-Wancho script and language environment
-Toto script and language environment
-Gothic script and language environment
-Coptic script and language environment
+ Tai Tham script and the Northern Thai language environment
+
+ Brahmi script and language environment
+
+ Kaithi script and language environment
+
+ Tirhuta script and language environment
+
+ Sharada script and language environment
+
+ Siddham script and language environment
+
+ Syloti Nagri script and language environment
+
+ Modi script and language environment
+
+ Baybayin script and Tagalog language environment
+
+ Hanunoo script and language environment
+
+ Buhid script and language environment
+
+ Tagbanwa script and language environment
+
+ Limbu script and language environment
+
+ Balinese script and language environment
+
+ Javanese script and language environment
+
+ Sundanese script and language environment
+
+ Batak script and language environment
+
+ Rejang script and language environment
+
+ Makasar script and language environment
+
+ Lontara script and language environment
+
+ Hanifi Rohingya script and language environment
+
+ Grantha script and language environment
+
+ Kharoshthi script and language environment
+
+ Lepcha script and language environment
+
+ Meetei Mayek script and language environment
+
+ Adlam script and language environment
+
+ Mende Kikakui script and language environment
+
+ Wancho script and language environment
+
+ Toto script and language environment
+
+ Gothic script and language environment
+
+ Coptic script and language environment
---
*** The "Oriya" language environment was renamed to "Odia".
@@ -1423,8 +1476,9 @@ the QWERTY Slovak keyboards.
---
*** New input method 'cyrillic-chuvash'.
-This input method is based on the russian-computer, and is intended
-for the Chuvash language written in the Cyrillic script.
+This input method is based on the russian-computer input method, and
+is intended for typing in the Chuvash language written in the Cyrillic
+script.
* Changes in Specialized Modes and Packages in Emacs 29.1
@@ -1506,6 +1560,40 @@ the following to your Init file:
*** New command 'dired-do-eww'.
This command visits the file on the current line with EWW.
+---
+*** New user option 'dired-omit-lines'.
+This is used by 'dired-omit-mode', and now allows you to hide based on
+other things than just the file names.
+
++++
+*** New user option 'dired-mouse-drag-files'.
+If non-nil, dragging file names with the mouse in a Dired buffer will
+initiate a drag-and-drop session allowing them to be opened in other
+programs.
+
++++
+*** New user option 'dired-free-space'.
+Dired will now, by default, include the free space in the first line
+instead of having it on a separate line. To get the previous behavior
+back, say:
+
+ (setq dired-free-space 'separate)
+
+---
+*** New user option 'dired-make-directory-clickable'.
+If non-nil (which is the default), hitting 'RET' or 'mouse-1' on
+the directory components at the directory displayed at the start of
+the buffer will take you to that directory.
+
+---
+*** Search and replace in Dired/Wdired supports more regexps.
+For example, the regexp ".*" will match only characters that are part
+of the file name. Also "^.*$" can be used to match at the beginning
+of the file name and at the end of the file name. This is used only
+when searching on file names. In Wdired this can be used when the new
+user option 'wdired-search-replace-filenames' is non-nil (which is the
+default).
+
** Elisp
---
@@ -1522,7 +1610,7 @@ byte-compile the visited file and the current buffer,
respectively.
---
*** New user option 'tetris-allow-repetitions'.
This controls how randomness is implemented (whether to use pure
-randomness as before or whether to use a bag).
+randomness as before, or to use a bag).
** Battery
@@ -1553,7 +1641,7 @@ command is installed.
** CC Mode
---
-*** C++ Mode now supports most of the new features in the C++20 standard.
+*** C++ Mode now supports most of the new features in the C++20 Standard.
** Cperl Mode
@@ -1566,8 +1654,8 @@ be used as a file-local variable.
---
*** 'gud-go' is now bound to 'C-c C-v'.
-If given a prefix, it will query the user for an argument to use for
-the run/continue command.
+If given a prefix, it will prompt for an argument to use for the
+run/continue command.
---
*** 'perldb' now recognizes '-E'.
@@ -1588,7 +1676,7 @@ contents.
*** New user option 'diff-whitespace-style'.
Sets the value of the buffer-local variable 'whitespace-style' in
'diff-mode' buffers. By default, this variable is '(face trailing)',
-which preserves behavior from previous Emacs versions.
+which preserves behavior of previous Emacs versions.
+++
*** New user option 'diff-add-log-use-relative-names'.
@@ -1636,8 +1724,8 @@ it isn't already, and remove it if it is installed.
+++
*** New command 'package-vc-install'.
-Packages can now be installed directly from source by cloning from a
-repository.
+Packages can now be installed directly from source by cloning from
+their repository.
+++
*** New command 'package-vc-install-from-checkout'.
@@ -1673,7 +1761,7 @@ The option 'desktop-load-locked-desktop' can now be set
to the value
file if the Emacs process which locked it is no longer running on the
local machine. This allows avoiding questions about locked desktop
files when the Emacs session which locked it crashes, or was otherwise
-interrupted, and didn't exit gracefully. See the "(emacs) Saving
+interrupted and didn't exit gracefully. See the "(emacs) Saving
Emacs Sessions" node in the Emacs manual for more details.
** Miscellaneous
@@ -1732,9 +1820,10 @@ only jump if the location of the first error is known),
and
+++
*** New user option 'compilation-max-output-line-length'.
-Lines longer than this will have the ends hidden, with a button to
-reveal the hidden text. This speeds up operations like grepping on
-files that have few newlines.
+Lines longer than the value of this variable will have their ends
+hidden, with a button to reveal the hidden text. This speeds up
+operations like grepping on files that have few newlines. The default
+value is 400; set to nil to disable hiding.
** Flymake
@@ -1748,12 +1837,12 @@ characters instead of just 'SPC' and 'TAB'.
---
** New mode, 'emacs-news-mode', for editing the NEWS file.
-This mode adds some highlighting, fixes the 'M-q' command, and has
-commands for doing maintenance of the Emacs NEWS files. In addition,
-this mode turns on 'outline-minor-mode', and thus displays
-customizable icons (see 'icon-preference') in the margins. To
-disable these icons, set 'outline-minor-mode-use-buttons' to a
-nil value.
+This mode adds some highlighting, makes the 'M-q' command aware of the
+format of NEWS entries, and has special commands for doing maintenance
+of the Emacs NEWS files. In addition, this mode turns on
+'outline-minor-mode', and thus displays customizable icons (see
+'icon-preference') in the margins. To disable these icons, set
+'outline-minor-mode-use-buttons' to a nil value.
---
** Kmacro
@@ -1785,6 +1874,12 @@ exit the minibuffer. These keys are also available for
in-buffer
completion, but they don't insert candidates automatically, you need
to type 'M-RET' to insert the selected candidate to the buffer.
++++
+*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
+This means that typing 'C-u RET' on a completion candidate in the
+"*Completions*" buffer inserts the completion into the minibuffer,
+but doesn't exit the minibuffer.
+
+++
*** The "*Completions*" buffer can now be automatically selected.
To enable this behavior, customize the user option
@@ -1808,6 +1903,7 @@ to complete. The value 'visual' is like 'always', but
only updates
the completions if they are already visible. The default value t
always hides the completion buffer after some completion is made.
+---
*** New commands to complete the minibuffer history.
'minibuffer-complete-history' ('C-x <up>') is like 'minibuffer-complete'
but completes on the history items instead of the default completion
@@ -1830,25 +1926,20 @@ This option limits the height of the "*Completions*"
buffer.
+++
*** New user option 'completions-header-format'.
-This is a string to control the heading line to show in the
+This is a string to control the header line to show in the
"*Completions*" buffer before the list of completions.
If it contains "%s", that is replaced with the number of completions.
-If nil, the heading line is not shown.
+If nil, the header line is not shown.
+++
*** New user option 'completions-highlight-face'.
When this user option names a face, the current
candidate in the "*Completions*" buffer is highlighted with that face.
-The nil value disables this highlighting.
-
-+++
-*** Choosing a completion with a prefix argument doesn't exit the minibuffer.
-This means that typing 'C-u RET' on a completion candidate in the
-"*Completions*" buffer inserts the completion to the minibuffer,
-but doesn't exit the minibuffer.
+The nil value disables this highlighting. The default is to highlight
+using the 'completions-highlight' face.
+++
-*** You can now define abbrevs for the fundamental minibuffer modes.
+*** You can now define abbrevs for the minibuffer modes.
'minibuffer-mode-abbrev-table' and
'minibuffer-inactive-mode-abbrev-table' are now defined.
@@ -1944,7 +2035,7 @@ This is in addition to the old keybindings 'C-c C-n' and
'C-c C-p'.
---
*** New command 'vc-pull-and-push'.
This commands first does a "pull" command, and if that is successful,
-do a "push" command afterwards.
+does a "push" command afterwards.
+++
*** 'C-x v b' prefix key is used now for branch commands.
@@ -1983,7 +2074,7 @@ in the Git repository in "~/foo/bar". This makes this
command
consistent with 'vc-responsible-backend'.
---
-*** Log Edit now font locks long Git commit summary lines.
+*** Log Edit now fontifies long Git commit summary lines.
Writing shorter summary lines avoids truncation in contexts in which
Git commands display summary lines. See the two new user options
'vc-git-log-edit-summary-target-len' and 'vc-git-log-edit-summary-max-len'.
@@ -2192,13 +2283,13 @@ All other 'gnus-header-*' faces inherit from this face
now.
+++
*** New user option 'gnus-treat-emojize-symbols'.
-If non-nil, symbols that have an emoji representation will be
+If non-nil, symbols that have an Emoji representation will be
displayed as emojis. The default is nil.
+++
*** New command 'gnus-article-emojize-symbols'.
-This is bound to 'W D e' and will display symbols that have emoji
-representation as emojis.
+This is bound to 'W D e' and will display symbols that have Emoji
+representation as Emoji.
+++
*** New mu backend for gnus-search.
@@ -2310,6 +2401,11 @@ or projects outside of VCS repositories.
As a consequence, the 'VC project backend' is formally renamed to
'VC-aware project backend'.
++++
+*** New user option 'project-vc-include-untracked'.
+If non-nil, files untracked by a VCS are considered to be part of
+the project by a VC project based on that VCS.
+
** Xref
+++
@@ -2494,7 +2590,7 @@ PDF file in the thumbnail buffer to visit the
corresponding PDF.
---
*** Support GraphicsMagick command line tools.
Support for the GraphicsMagick command line tool ("gm") has been
-added, and is used instead of ImageMagick when it is available.
+added, and is used when it is available instead of ImageMagick.
---
*** Support Thumbnail Managing Standard v0.9.0 (Dec 2020).
@@ -2582,42 +2678,6 @@ some commands and user options are no longer needed and
are now obsolete:
'image-dired-display-window-width-correction',
'image-dired-temp-image-file'.
-** Dired
-
----
-*** New user option 'dired-omit-lines'.
-This is used by 'dired-omit-mode', and now allows you to hide based on
-other things than just the file names.
-
-+++
-*** New user option 'dired-mouse-drag-files'.
-If non-nil, dragging file names with the mouse in a Dired buffer will
-initiate a drag-and-drop session allowing them to be opened in other
-programs.
-
-+++
-*** New user option 'dired-free-space'.
-Dired will now, by default, include the free space in the first line
-instead of having it on a separate line. To get the previous behavior
-back, say:
-
- (setq dired-free-space 'separate)
-
----
-*** New user option 'dired-make-directory-clickable'.
-If non-nil (which is the default), hitting 'RET' or 'mouse-1' on
-the directory components at the directory displayed at the start of
-the buffer will take you to that directory.
-
----
-*** Search and replace in Dired/Wdired supports more regexps.
-For example, the regexp ".*" will match only characters that are part
-of the file name. Also "^.*$" can be used to match at the beginning
-of the file name and at the end of the file name. This is used only
-when searching on file names. In Wdired this can be used when the new
-user option 'wdired-search-replace-filenames' is non-nil (which is the
-default).
-
** Bookmarks
---
@@ -2772,7 +2832,11 @@ project-dedicated or global) is specified by the new
*** Support for endless methods.
---
-*** New user option 'ruby-method-params-indent'.
+*** New user options that determine indentation logic.
+'ruby-method-params-indent', 'ruby-block-indent',
+'ruby-after-operator-indent', 'ruby-method-call-indent',
+'ruby-parenless-call-arguments-indent'. See the docstrings for
+explanations and examples.
** Eshell
@@ -2830,7 +2894,7 @@ if only one line of output). Previously, this only
converted numbers
when there was a single line of output.
---
-*** Built-in Eshell commands now follow POSIX/GNU argument syntax conventions.
+*** Built-in Eshell commands now follow Posix/GNU argument syntax conventions.
Built-in commands in Eshell now accept command-line options with
values passed as a single token, such as '-oVALUE' or
'--option=VALUE'. New commands can take advantage of this with the
@@ -2944,11 +3008,6 @@ filtered out.
The list of handlers (already covering OSC 7 and 8) has been extended
with a handler for OSC 2, the command to set a window title.
-+++
-*** New user option 'project-vc-include-untracked'.
-If non-nil, files untracked by a VCS are considered to be part of
-the project by a VC project based on that VCS.
-
---
*** 'recentf-mode' now uses abbreviated file names by default.
This means that e.g. "/home/foo/bar" is now displayed as "~/bar".
@@ -3000,6 +3059,19 @@ name.
This key is now bound to 'Buffer-menu-view-other-window', which will
view this line's buffer in View mode in another window.
+** Scheme mode
+
+---
+*** Auto-detection of Scheme library files.
+Emacs now automatically enables the Scheme mode when opening R6RS
+Scheme Library Source ('.sls') files and R7RS Scheme Library
+Definition ('.sld') files.
+
+---
+*** Imenu members for R6RS and R7RS library members.
+Imenu now lists the members directly nested in R6RS Scheme libraries
+('library') and R7RS libraries ('define-library').
+
* New Modes and Packages in Emacs 29.1
@@ -3012,7 +3084,7 @@ Protocol (LSP).
+++
*** use-package: Declarative package configuration.
-use-package is shipped with Emacs. It provides the 'use-package'
+use-package is now shipped with Emacs. It provides the 'use-package'
macro, which allows you to isolate package configuration in your init
file in a way that is declarative, tidy, and performance-oriented.
See the new Info manual "(use-package) Top" for more.
@@ -3037,8 +3109,8 @@ manually if needed, using the new user options
'wallpaper-command' and
+++
** New package 'oclosure'.
-Allows the creation of "functions with slots" or "function objects"
-via the macros 'oclosure-define' and 'oclosure-lambda'.
+This allows the creation of "functions with slots" or "function
+objects" via the macros 'oclosure-define' and 'oclosure-lambda'.
+++
*** New generic function 'oclosure-interactive-form'.
@@ -3061,10 +3133,12 @@ Emacs buffers, like indentation and the like. The new
ert function
This is a lightweight variant of 'js-mode' that is used by default
when visiting JSON files.
++++
** New major mode 'csharp-mode'.
A major mode based on CC Mode for editing programs in the C# language.
This mode is auto-enabled for files with the ".cs" extension.
++++
** New major modes based on the tree-sitter library.
These new major modes are available if Emacs was built with the
tree-sitter library. They provide support for font-locking,
@@ -3095,77 +3169,94 @@ If a language grammar library required by a mode is not
found in any
of the above places, the mode will signal an error when you try to
turn it on.
++++
*** New major mode 'typescript-ts-mode'.
A major mode based on the tree-sitter library for editing programs
in the TypeScript language. This mode is auto-enabled for files with
the ".ts" extension.
++++
*** New major mode 'tsx-ts-mode'.
A major mode based on the tree-sitter library for editing programs
in the TypeScript language, with support for TSX. This mode is
auto-enabled for files with the ".tsx" extension.
++++
*** New major mode 'c-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the C language.
++++
*** New major mode 'c++-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the C++ language.
++++
*** New major mode 'java-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the Java language.
++++
*** New major mode 'python-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the Python language.
++++
*** New major mode 'css-ts-mode'.
An optional major mode based on the tree-sitter library for editing
CSS (Cascading Style Sheets).
++++
*** New major mode 'json-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the JSON language.
++++
*** New major mode 'csharp-ts-mode'.
An optional major mode based on the tree-sitter library for editing
programs in the C# language.
++++
*** New major mode 'bash-ts-mode'.
Am optional major mode based on the tree-sitter library for editing
Bash shell scripts.
++++
*** New major mode 'dockerfile-ts-mode'.
A major mode based on the tree-sitter library for editing
Dockerfiles. This mode is auto-enabled for files which are named
"Dockerfile", have the "Dockerfile." prefix, or have the ".dockerfile"
extension.
++++
*** New major mode 'cmake-ts-mode'.
A major mode based on the tree-sitter library for editing CMake files.
It is auto-enabled for files whose name is "CMakeLists.txt" or whose
extension is ".cmake".
++++
*** New major mode 'toml-ts-mode'.
A major mode based on the tree-sitter library for editing files
written in TOML, a format for writing configuration files. It is
auto-enabled for files with the ".toml" extension.
++++
*** New major mode 'go-ts-mode'.
A major mode based on the tree-sitter library for editing programs in
the Go language. It is auto-enabled for files with the ".go" extension.
++++
*** New major mode 'go-mod-ts-mode'.
A major mode based on the tree-sitter library for editing "go.mod"
files. It is auto-enabled for files which are named "go.mod".
++++
*** New major mode 'yaml-ts-mode'.
A major mode based on the tree-sitter library for editing files
written in YAML. It is auto-enabled for files with the ".yaml" or
".yml" extensions.
++++
*** New major mode 'rust-ts-mode'.
A major mode based on the tree-sitter library for editing programs in
the Rust language. It is auto-enabled for files with the ".rs" extension.
@@ -3187,15 +3278,17 @@ or user level, with the exception of better performance
and the order
of overlays returned by functions that don't promise any particular
order.
+---
*** The function 'overlay-recenter' is now a no-op.
This function does nothing, and in particular has no effect on the
value returned by 'overlay-lists'. The purpose of 'overlay-recenter'
-was to allow more efficient lookup of overlays around certain buffer
+was to allow more efficient lookup of overlays around a certain buffer
position; however with the new implementation the lookup of overlays
is efficient regardless of their position, and there's no longer any
-need to "optimize" the lookup, nor any notion of "center" of the
+need to "optimize" the lookup, nor any notion of a "center" of the
overlays.
+---
*** The function 'overlay-lists' returns one unified list of overlays.
This function used to return a cons of two lists, one with overlays
before the "center" position, the other after that "center". It now
@@ -3219,7 +3312,7 @@ auto-scaling applied. (This only makes a difference on
HiDPI
displays.)
+++
-** Changes to "raw" in-memory xbm images are specified.
+** Changes in how "raw" in-memory xbm images are specified.
Some years back Emacs gained the ability to scale images, and you
could then specify ':width' and ':height' when using 'create-image' on all
image types -- except xbm images, because this format already used the
@@ -3244,7 +3337,7 @@ signal an error in any file.)
In addition, files are scanned in a slightly different way.
Previously, ';;;###' specs inside a top-level form (i.e., something
like '(when ... ;;;### ...)' would be ignored. They are now parsed as
-normal.
+usual.
---
** Themes have special autoload cookies.
@@ -3284,7 +3377,7 @@ they will still be escaped, so the '.foo' symbol is still
printed as
"\.foo" and the '?bar' symbol is still printed as "\?bar".
+++
-** Remapping 'mode-line' no longer works as expected.
+** Remapping 'mode-line' face no longer works as expected.
'mode-line' is now the parent face of the new 'mode-line-active' face,
and remapping parent of basic faces does not work reliably.
Instead of remapping 'mode-line', you have to remap 'mode-line-active'.
@@ -3307,10 +3400,10 @@ needed.
*** Emacs now supports 'medium' fonts.
Emacs previously didn't distinguish between the 'regular'/'normal'
weight and the 'medium' weight, but it now also supports the (heavier)
-'medium' weight. However, this means that if you previously specified
-a weight of 'normal' and the font doesn't have this weight, Emacs
-won't find the font spec. In these cases, replacing ":weight 'normal"
-with ":weight 'medium" should fix the issue.
+'medium' weight. However, this means that if you specify a weight of
+'normal' and the font doesn't have this weight, Emacs won't find the
+font spec. In these cases, replacing ":weight 'normal" with ":weight
+'medium" should fix the issue.
---
** Keymap descriptions have changed.
@@ -3505,9 +3598,8 @@ but switching to 'ash' is generally much preferable.
+++
** New generic function 'function-documentation'.
-Can dynamically generate a raw docstring depending on the type of
-a function.
-Used mainly for docstrings of OClosures.
+It can dynamically generate a raw docstring depending on the type of a
+function. Used mainly for docstrings of OClosures.
+++
** Base64 encoding no longer tolerates latin-1 input.
@@ -3515,7 +3607,7 @@ The functions 'base64-encode-string',
'base64url-encode-string',
'base64-encode-region' and 'base64url-encode-region' no longer accept
characters in the range U+0080..U+00FF as substitutes for single bytes
in the range 128..255, but signal an error for all multibyte characters.
-The input must be encoded text.
+The input must be unibyte encoded text.
+++
** The 'clone-indirect-buffer-hook' is now run by 'make-indirect-buffer'.
@@ -3667,7 +3759,7 @@ These function now take an optional comparison predicate
argument.
+++
** 'completing-read' now allows a function as its REQUIRE-MATCH argument.
-This function is called to see whether what the user has typed in is a
+This function is called to see whether what the user has typed is a
match. This is also available from functions that call
'completing-read', like 'read-file-name'.
@@ -3679,10 +3771,10 @@ Previously, it reported data only based on the frame.
** 'file-expand-wildcards' can now also take a regexp as PATTERN argument.
---
-** vc-mtn (the backend for Monotone) has been made obsolete.
+** vc-mtn (the VC backend for Monotone) has been made obsolete.
+++
-** 'gui-set-selection' can now specify different values for different data
types.
+** 'gui-set-selection' can specify different values for different data types.
If DATA is a string, then its text properties are searched for values
for each specific data type while the selection is being converted.
@@ -3702,6 +3794,7 @@ things to be saved.
** New function 'string-equal-ignore-case'.
This compares strings ignoring case differences.
++++
** 'symbol-file' can now report natively-compiled ".eln" files.
If Emacs was built with native-compilation enabled, Lisp programs can
now call 'symbol-file' with the new optional 3rd argument non-nil to
@@ -3838,7 +3931,7 @@ available only when Emacs was built with glibc as the C
library.
---
** 'x-show-tip' no longer hard-codes a timeout default.
-The new 'x-show-tooltip-timeout' variable allows the user to alter
+The new variable 'x-show-tooltip-timeout' allows the user to alter
this for packages that don't use 'tooltip-show', but instead call the
lower level function directly.
@@ -3850,8 +3943,8 @@ example for benchmarking purposes.
---
** New function 'string-edit'.
This is meant to be used when the user has to edit a (potentially)
-long string. It pops you to a new buffer where you can edit the
-string, and a callback is called when the user types 'C-c C-c'.
+long string. It pops up a new buffer where you can edit the string,
+and a callback is called when the user types 'C-c C-c'.
+++
** New function 'read-string-from-buffer'.
@@ -3870,8 +3963,8 @@ putting the modes on the first line of a file).
+++
** New function 'flush-standard-output'.
-This enables you to display incomplete lines from batch-based Emacs
-scripts.
+This enables display of lines that don't end in a newline from
+batch-based Emacs scripts.
+++
** New convenience function 'buttonize-region'.
@@ -3891,7 +3984,7 @@ from which the last input event originated, and
'device-class' can be
used to determine the type of an input device.
+++
-** 'track-mouse' can be a new value 'drag-source'.
+** 'track-mouse' can have a new value 'drag-source'.
This means the same as 'dropping', but modifies the mouse position
list in reported motion events if there is no frame underneath the
mouse pointer.
@@ -3940,7 +4033,10 @@ frequently than once in a second.
---
** New function 'bidi-string-strip-control-characters'.
This utility function is meant for displaying strings when it's
-essential that there's no bidirectional context.
+essential that there's no bidirectional context. It removes all the
+bidirectional formatting control characters (such as RLM, LRO, PDF,
+etc.) from its argument string. The characters it removes are listed
+in the value of 'bidi-control-characters'.
---
** The Gnus range functions have been moved to a new library, range.el.
@@ -4037,8 +4133,8 @@ to attackers trying to confuse the users will use the
textsec library
to mark suspicious text. For instance shr/eww will mark suspicious
URLs and links, Gnus will mark suspicious From addresses, and
Message mode will query the user if the user is sending mail to a
-suspicious address. If this variable is nil, these checks aren't
-performed.
+suspicious address. If this variable is nil, these checks are
+disabled.
+++
*** New function 'textsec-suspicious-p'.
@@ -4357,7 +4453,8 @@ aren't integer multiples of the default font.
** New function 'string-glyph-split'.
This function splits a string into a list of strings representing
separate glyphs. This takes into account combining characters and
-grapheme clusters.
+grapheme clusters, by treating each sequence of characters composed on
+display as a single unit.
---
** 'lookup-key' is more permissive when searching for extended menu items.
@@ -4448,9 +4545,10 @@ temporary transition aid for Emacs 27, has served its
purpose.
'(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil))'.
+++
-** 'date-to-time' now assumes earliest values if its argument lacks
-month, day, or time. For example, (date-to-time "2021-12-04") now
-assumes a time of 00:00 instead of signaling an error.
+** 'date-to-time' now accepts arguments that lacks month, day, or time.
+The function now assumes the earliest possible values if its argument
+lacks month, day, or time. For example, (date-to-time "2021-12-04")
+now assumes a time of 00:00 instead of signaling an error.
+++
** 'format-seconds' now allows suppressing zero-value trailing elements.
@@ -4607,6 +4705,15 @@ where those APIs are available.
When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now
has built-in support for displaying BMP images.
+---
+*** GUI Yes/No dialogs now include a "Cancel" button.
+The "Cancel" button is in addition to "Yes" and "No", and is intended
+to allow users to quit the dialog, as an equivalent of C-g when Emacs
+asks a yes/no question via the echo area. This is controlled by the
+new variable 'w32-yes-no-dialog-show-cancel', by default t. Set it to
+nil to get back the old behavior of showing a modal dialog with only
+two buttons: "Yes" and "No".
+
** Cygwin
---
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 1b449b7009..1e45887b86 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -3499,6 +3499,18 @@ with development builds, since the .elc files are
pre-compiled in releases.
** Dumping
+*** temacs.exe fails to run when invoked by the build for dumping
+
+The error message might be something like
+
+ make[2]: *** [Makefile:915: bootstrap-emacs.pdmp] Error 127
+
+This happens if you try to build Emacs on versions of MS-Windows older
+than the minimum version supported by MinGW-w64. As of Dec 2022, the
+minimum supported Windows version is 8.1, and the computer hardware
+(CPU, memory, disk) should also match the minimum Windows 8.1
+requirements.
+
*** Segfault during 'make'
If Emacs segfaults when 'make' executes one of these commands:
diff --git a/etc/emacsclient-mail.desktop b/etc/emacsclient-mail.desktop
index b575a41758..91df122c59 100644
--- a/etc/emacsclient-mail.desktop
+++ b/etc/emacsclient-mail.desktop
@@ -1,7 +1,7 @@
[Desktop Entry]
Categories=Network;Email;
Comment=GNU Emacs is an extensible, customizable text editor - and more
-Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\\\(message-mailto\\\\ \\\\\\"%u\\\\\\"\\\\)"
+Exec=sh -c "exec emacsclient --alternate-editor= --display=\\"\\$DISPLAY\\"
--eval \\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
Icon=emacs
Name=Emacs (Mail, Client)
MimeType=x-scheme-handler/mailto;
@@ -13,7 +13,7 @@ Actions=new-window;new-instance;
[Desktop Action new-window]
Name=New Window
-Exec=emacsclient --alternate-editor= --create-frame --eval "(message-mailto
\\"%u\\")"
+Exec=sh -c "exec emacsclient --alternate-editor= --create-frame --eval
\\"(message-mailto \\\\\\"\\$1\\\\\\")\\"" sh %u
[Desktop Action new-instance]
Name=New Instance
diff --git a/etc/emacsclient.desktop b/etc/emacsclient.desktop
index 1ecdecffaf..a9f840c703 100644
--- a/etc/emacsclient.desktop
+++ b/etc/emacsclient.desktop
@@ -3,7 +3,7 @@ Name=Emacs (Client)
GenericName=Text Editor
Comment=Edit text
MimeType=text/english;text/plain;text/x-makefile;text/x-c++hdr;text/x-c++src;text/x-chdr;text/x-csrc;text/x-java;text/x-moc;text/x-pascal;text/x-tcl;text/x-tex;application/x-shellscript;text/x-c;text/x-c++;
-Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient
--alternate-editor= --create-frame; fi" placeholder %F
+Exec=sh -c "if [ -n \\"\\$*\\" ]; then exec emacsclient --alternate-editor=
--display=\\"\\$DISPLAY\\" \\"\\$@\\"; else exec emacsclient
--alternate-editor= --create-frame; fi" sh %F
Icon=emacs
Type=Application
Terminal=false
diff --git a/etc/package-keyring.gpg b/etc/package-keyring.gpg
index 490dee41a9..563acbb16b 100644
Binary files a/etc/package-keyring.gpg and b/etc/package-keyring.gpg differ
diff --git a/etc/tutorials/TUTORIAL.fr b/etc/tutorials/TUTORIAL.fr
index 5b080645e4..70d60fcae7 100644
--- a/etc/tutorials/TUTORIAL.fr
+++ b/etc/tutorials/TUTORIAL.fr
@@ -1219,7 +1219,7 @@ Les conditions de copie d'Emacs lui-même sont plus
complexes, mais
dans le même esprit. Lisez le fichier COPYING et donnez ensuite des
copies de GNU Emacs à vos amis. Participez à l'éradication de
l'obstructionnisme du logiciel (sa « propriétarisation ») en
-utilisant, écrivant et partagent des logiciels libres !
+utilisant, écrivant et partageant des logiciels libres !
Cette traduction française a été effectuée par Éric Jacoboni
<jaco@teaser.fr> et complétée par Bastien Guerry <bzg@gnu.org>.
diff --git a/lib/file-has-acl.c b/lib/file-has-acl.c
index e02f0626ad..676523ba82 100644
--- a/lib/file-has-acl.c
+++ b/lib/file-has-acl.c
@@ -29,9 +29,97 @@
#include "acl-internal.h"
-#if GETXATTR_WITH_POSIX_ACLS
+#if USE_ACL && GETXATTR_WITH_POSIX_ACLS
+# include <string.h>
+# include <arpa/inet.h>
# include <sys/xattr.h>
# include <linux/xattr.h>
+# ifndef XATTR_NAME_NFSV4_ACL
+# define XATTR_NAME_NFSV4_ACL "system.nfs4_acl"
+# endif
+
+enum {
+ /* ACE4_ACCESS_ALLOWED_ACE_TYPE = 0x00000000, */
+ ACE4_ACCESS_DENIED_ACE_TYPE = 0x00000001,
+ ACE4_IDENTIFIER_GROUP = 0x00000040
+};
+
+/* Return 1 if given ACL in XDR format is non-trivial, 0 if it is trivial.
+ -1 upon failure to determine it. Possibly change errno. Assume that
+ the ACL is valid, except avoid undefined behavior even if invalid.
+
+ See <https://linux.die.net/man/5/nfs4_acl>. The NFSv4 acls are
+ defined in Internet RFC 7530 and as such, every NFSv4 server
+ supporting ACLs should support NFSv4 ACLs (they differ from from
+ POSIX draft ACLs). The ACLs can be obtained via the
+ nfsv4-acl-tools, e.g., the nfs4_getfacl command. Gnulib provides
+ only basic support of NFSv4 ACLs, i.e., recognize trivial vs
+ nontrivial ACLs. */
+
+static int
+acl_nfs4_nontrivial (uint32_t *xattr, ssize_t nbytes)
+{
+ enum { BYTES_PER_NETWORK_UINT = 4};
+
+ /* Grab the number of aces in the acl. */
+ nbytes -= BYTES_PER_NETWORK_UINT;
+ if (nbytes < 0)
+ return -1;
+ uint32_t num_aces = ntohl (*xattr++);
+ if (6 < num_aces)
+ return 1;
+ int ace_found = 0;
+
+ for (int ace_n = 0; ace_n < num_aces; ace_n++)
+ {
+ /* Get the acl type and flag. Skip the mask; it's too risky to
+ test it and it does not seem to be needed. Get the wholen. */
+ nbytes -= 4 * BYTES_PER_NETWORK_UINT;
+ if (nbytes < 0)
+ return -1;
+ uint32_t type = ntohl (xattr[0]);
+ uint32_t flag = ntohl (xattr[1]);
+ uint32_t wholen = ntohl (xattr[3]);
+ xattr += 4;
+ int64_t wholen4 = wholen;
+ wholen4 = ((wholen4 + (BYTES_PER_NETWORK_UINT))
+ & ~ (BYTES_PER_NETWORK_UINT - 1));
+
+ /* Trivial ACLs have only ACE4_ACCESS_ALLOWED_ACE_TYPE or
+ ACE4_ACCESS_DENIED_ACE_TYPE. */
+ if (ACE4_ACCESS_DENIED_ACE_TYPE < type)
+ return 1;
+
+ /* RFC 7530 says FLAG should be 0, but be generous to NetApp and
+ also accept the group flag. */
+ if (flag & ~ACE4_IDENTIFIER_GROUP)
+ return 1;
+
+ /* Get the who string. Check NBYTES - WHOLEN4 before storing
+ into NBYTES, to avoid truncation on conversion. */
+ if (nbytes - wholen4 < 0)
+ return -1;
+ nbytes -= wholen4;
+
+ /* For a trivial ACL, max 6 (typically 3) ACEs, 3 allow, 3 deny.
+ Check that there is at most one ACE of each TYPE and WHO. */
+ int who2
+ = (wholen == 6 && memcmp (xattr, "OWNER@", 6) == 0 ? 0
+ : wholen == 6 && memcmp (xattr, "GROUP@", 6) == 0 ? 2
+ : wholen == 9 && memcmp (xattr, "EVERYONE@", 9) == 0 ? 4
+ : -1);
+ if (who2 < 0)
+ return 1;
+ int ace_found_bit = 1 << (who2 | type);
+ if (ace_found & ace_found_bit)
+ return 1;
+ ace_found |= ace_found_bit;
+
+ xattr = (uint32_t *) ((char *) xattr + wholen4);
+ }
+
+ return 0;
+}
#endif
/* Return 1 if NAME has a nontrivial access control list,
@@ -51,6 +139,7 @@ file_has_acl (char const *name, struct stat const *sb)
# if GETXATTR_WITH_POSIX_ACLS
ssize_t ret;
+ int initial_errno = errno;
ret = getxattr (name, XATTR_NAME_POSIX_ACL_ACCESS, NULL, 0);
if (ret < 0 && errno == ENODATA)
@@ -67,6 +156,35 @@ file_has_acl (char const *name, struct stat const *sb)
return 1;
}
+ if (ret < 0)
+ {
+ /* Check for NFSv4 ACLs. The max length of a trivial
+ ACL is 6 words for owner, 6 for group, 7 for everyone,
+ all times 2 because there are both allow and deny ACEs.
+ There are 6 words for owner because of type, flag, mask,
+ wholen, "OWNER@"+pad and similarly for group; everyone is
+ another word to hold "EVERYONE@". */
+ uint32_t xattr[2 * (6 + 6 + 7)];
+
+ ret = getxattr (name, XATTR_NAME_NFSV4_ACL, xattr, sizeof xattr);
+ if (ret < 0)
+ switch (errno)
+ {
+ case ENODATA: return 0;
+ case ERANGE : return 1; /* ACL must be nontrivial. */
+ }
+ else
+ {
+ /* It looks like a trivial ACL, but investigate further. */
+ ret = acl_nfs4_nontrivial (xattr, ret);
+ if (ret < 0)
+ {
+ errno = EINVAL;
+ return ret;
+ }
+ errno = initial_errno;
+ }
+ }
if (ret < 0)
return - acl_errno_valid (errno);
return ret;
diff --git a/lib/time.in.h b/lib/time.in.h
index 6aa67498f5..aba2eda875 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -315,6 +315,7 @@ _GL_CXXALIASWARN (strptime);
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define ctime rpl_ctime
# endif
+_GL_ATTRIBUTE_DEPRECATED
_GL_FUNCDECL_RPL (ctime, char *, (time_t const *__tp)
_GL_ARG_NONNULL ((1)));
_GL_CXXALIAS_RPL (ctime, char *, (time_t const *__tp));
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 2ca8e25dac..26c2b09792 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -501,7 +501,7 @@ PROPS is a list of properties."
(defun abbrev-table-p (object)
"Return non-nil if OBJECT is an abbrev table."
(and (obarrayp object)
- (numberp (ignore-error 'wrong-type-argument
+ (numberp (ignore-error wrong-type-argument
(abbrev-table-get object :abbrev-table-modiff)))))
(defun abbrev-table-empty-p (object &optional ignore-system)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 5f601f24d2..c8a65126a4 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -354,10 +354,10 @@ If the locale never uses daylight saving time, set this
to 0."
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (car calendar-current-time-zone-cache)))
- "+0000")
- (or (nth 2 calendar-current-time-zone-cache) "EST"))
+ "-0000")
+ (or (nth 2 calendar-current-time-zone-cache) "UTC"))
"Abbreviated name of standard time zone at `calendar-location-name'.
-For example, \"EST\" in New York City, \"PST\" for Los Angeles."
+For example, \"-0500\" or \"EST\" in New York City."
:type 'string
:version "28.1"
:set-after '(calendar-time-zone-style)
@@ -368,10 +368,10 @@ For example, \"EST\" in New York City, \"PST\" for Los
Angeles."
(if calendar-current-time-zone-cache
(format-time-string
"%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
- "+0000")
- (or (nth 3 calendar-current-time-zone-cache) "EDT"))
+ "-0000")
+ (or (nth 3 calendar-current-time-zone-cache) "UTC"))
"Abbreviated name of daylight saving time zone at `calendar-location-name'.
-For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
+For example, \"-0400\" or \"EDT\" in New York City."
:type 'string
:version "28.1"
:set-after '(calendar-time-zone-style)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 9a2baf1e43..cc1e7ec5f7 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -339,7 +339,7 @@ Returns a string using match elements 1-5, where:
(t "\\1 \\2 \\3"))) ; MDY
"\n \\4 %s, \\5")))
;; TODO Sometimes the time is in a different time-zone to the one you
-;; are in. Eg in PST, you might still get an email referring to:
+;; are in. E.g., in Los Angeles, you might still get an email referring to:
;; "7:00 PM-8:00 PM. Greenwich Standard Time".
;; Note that it doesn't use a standard abbreviation for the timezone,
;; or anything helpful like that.
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 8f501824bb..0b5bc16653 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -839,12 +839,10 @@ This function is suitable for execution in an init file."
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
- (cond ((zerop calendar-time-zone)
- (if (eq calendar-time-zone-style 'numeric)
- "+0000" "UTC"))
- ((< calendar-time-zone 0)
- (format "UTC%dmin" calendar-time-zone))
- (t (format "UTC+%dmin" calendar-time-zone)))))
+ (if (and (zerop calendar-time-zone)
+ (not (eq calendar-time-zone-style 'numeric)))
+ "UTC"
+ (format-time-string "%z" 0 (* 60 calendar-time-zone)))))
(calendar-daylight-savings-starts
(if (< arg 16) calendar-daylight-savings-starts))
(calendar-daylight-savings-ends
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 390c13ec98..f3704f9a4d 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -1243,7 +1243,7 @@ Finds the header file belonging to NAME, gets the macros
from that file, and then merge the macros with our current
symbol table."
(when semantic-lex-spp-use-headers-flag
- ;; @todo - do this someday, ok?
+ nil ; @todo - do this someday, ok?
))
(defmacro define-lex-spp-include-analyzer (name doc regexp tokidx
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index 264b202771..e4bce67c6f 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -1108,7 +1108,7 @@ This can be done by using `semantic-lex-push-token'."
(semantic-lex-analysis-bounds (cons (point) (point-max)))
(semantic-lex-current-depth 0)
(semantic-lex-maximum-depth semantic-lex-depth))
- (when ,condition ,@forms)
+ (when ,condition nil ,@forms) ; `nil' avoids an empty-body warning.
semantic-lex-token-stream))))
(defmacro define-lex-regex-analyzer (name doc regexp &rest forms)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index ef73bc596d..d55739bb6f 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -828,7 +828,7 @@ is nil, ask the user where to save the desktop."
;; If we own it, we don't anymore.
(when (eq (emacs-pid) (desktop-owner))
;; Allow exiting Emacs even if we can't delete the desktop file.
- (ignore-error 'file-error
+ (ignore-error file-error
(desktop-release-lock))))
;; ----------------------------------------------------------------------------
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 75a3612df9..8a95082c15 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -50,24 +50,41 @@
:group 'tools)
(defcustom elide-head-headers-to-hide
- `(;; GNU GPL
- ("is free software[:;] you can redistribute it" .
- ,(rx (or (seq "If not, see " (? "<")
- "http" (? "s") "://www.gnu.org/licenses"
- (? "/") (? ">") (? " "))
- (seq "Boston, MA " (? " ")
- "0211" (or "1-1307" "0-1301")
- (or " " ", ") "USA")
- "675 Mass Ave, Cambridge, MA 02139, USA")
- (? ".")))
- ;; FreeBSD license / Modified BSD license (3-clause)
- (,(rx (or "The Regents of the University of California. All rights
reserved."
- "Redistribution and use in source and binary"))
- . "POSSIBILITY OF SUCH DAMAGE\\.")
- ;; X11 and Expat
- ("Permission is hereby granted, free of charge" .
- ,(rx (or "authorization from the X Consortium." ; X11
- "THE USE OR OTHER DEALINGS IN THE SOFTWARE.")))) ; Expat
+ (rx-let ((delim
+ ;; A line break could be in a non-standard place, and the
+ ;; license could be in a comment.
+ (or
+ ;; Either just some spaces:
+ (+ " ")
+ ;; Or a newline and some comment starter:
+ (: (* (in " \t"))
+ "\n"
+ (* (in " \t"))
+ (* (or (syntax comment-start) (in ";#*-")))
+ (* (in " \t"))))))
+ `(;; GNU GPL
+ ("is free software[:;] you can redistribute it" .
+ ,(rx (or (seq "If not, see " (? "<")
+ "http" (? "s") "://www.gnu.org/licenses"
+ (? "/") (? ">") (? " "))
+ (seq "Boston," delim "MA" delim
+ (or "02111-1307" "02110-1301" "02111-1301")
+ (? ",") delim
+ "USA")
+ "675 Mass Ave, Cambridge, MA 02139, USA")
+ (? ".")))
+ ;; FreeBSD license / Modified BSD license (3-clause)
+ (,(rx (or "The Regents of the University of California. All rights
reserved."
+ "Redistribution and use in source and binary"))
+ . "POSSIBILITY OF SUCH DAMAGE\\.")
+ ;; X11 and Expat
+ ("Permission is hereby granted, free of charge" .
+ ,(rx (or "authorization from the X Consortium." ; X11
+ "THE USE OR OTHER DEALINGS IN THE SOFTWARE."))) ; Expat
+ ;; Apache
+ ("Licensed under the Apache License, Version 2.0" .
+ "limitations under the License.")
+ ))
"Alist of regexps defining start and end of text to elide.
The cars of elements of the list are searched for in order. Text is
@@ -78,7 +95,7 @@ cdr.
This affects `elide-head-mode'."
:type '(alist :key-type (regexp :tag "Start regexp")
:value-type (regexp :tag "End regexp"))
- :version "29.1")
+ :version "30.1")
(defvar-local elide-head-overlay nil)
@@ -147,10 +164,11 @@ mode hooks."
(defun elide-head (&optional arg)
"Hide header material in buffer according to `elide-head-headers-to-hide'.
-The header is made invisible with an overlay. With a prefix arg, show
-an elided material again.
+The header is made invisible with an overlay. With a prefix
+argument ARG, show an elided material again.
-This is suitable as an entry on `find-file-hook' or appropriate mode hooks."
+This is suitable as an entry on `find-file-hook' or appropriate
+mode hooks."
(declare (obsolete elide-head-mode "29.1"))
(interactive "P")
(if arg
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 898dfffef6..ab35b0dde8 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -410,7 +410,10 @@ for speeding up processing.")
(`(condition-case ,var ,exp . ,clauses)
`(,fn ,var ;Not evaluated.
- ,(byte-optimize-form exp for-effect)
+ ,(byte-optimize-form exp
+ (if (assq :success clauses)
+ (null var)
+ for-effect))
,@(mapcar (lambda (clause)
(let ((byte-optimize--lexvars
(and lexical-binding
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index b5e887db83..697d1d3ee7 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -649,12 +649,11 @@ in `byte-compile-warning-types'; see the variable
`byte-compile-warnings' for a fuller explanation of the warning
types. The types that can be suppressed with this macro are
`free-vars', `callargs', `redefine', `obsolete',
-`interactive-only', `lexical', `mapcar', `constants' and
-`suspicious'.
+`interactive-only', `lexical', `mapcar', `constants',
+`suspicious' and `empty-body'.
For the `mapcar' case, only the `mapcar' function can be used in
-the symbol list. For `suspicious', only `set-buffer', `lsh' and `eq'
-can be used."
+the symbol list."
;; Note: during compilation, this definition is overridden by the one in
;; byte-compile-initial-macro-environment.
(declare (debug (sexp body)) (indent 1))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 7571b4d409..e314976fc1 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -295,7 +295,8 @@ The information is logged to `byte-compile-log-buffer'."
'(redefine callargs free-vars unresolved
obsolete noruntime interactive-only
make-local mapcar constants suspicious lexical lexical-dynamic
- docstrings docstrings-non-ascii-quotes not-unused)
+ docstrings docstrings-non-ascii-quotes not-unused
+ empty-body)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for almost all).
@@ -326,6 +327,7 @@ Elements of the list may be:
docstrings-non-ascii-quotes docstrings that have non-ASCII quotes.
This depends on the `docstrings' warning type.
suspicious constructs that usually don't do what the coder wanted.
+ empty-body body argument to a special form or macro is empty.
If the list begins with `not', then the remaining elements specify warnings to
suppress. For example, (not mapcar) will suppress warnings about mapcar.
@@ -541,15 +543,19 @@ Return the compile-time value of FORM."
;; Later `internal--with-suppressed-warnings' binds it again, this
;; time in order to affect warnings emitted during the
;; compilation itself.
- (let ((byte-compile--suppressed-warnings
- (append warnings byte-compile--suppressed-warnings)))
- ;; This function doesn't exist, but is just a placeholder
- ;; symbol to hook up with the
- ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery.
- `(internal--with-suppressed-warnings
- ',warnings
- ,(macroexpand-all `(progn ,@body)
- macroexpand-all-environment))))))
+ (if body
+ (let ((byte-compile--suppressed-warnings
+ (append warnings byte-compile--suppressed-warnings)))
+ ;; This function doesn't exist, but is just a placeholder
+ ;; symbol to hook up with the
+ ;; `byte-hunk-handler'/`byte-defop-compiler-1' machinery.
+ `(internal--with-suppressed-warnings
+ ',warnings
+ ,(macroexpand-all `(progn ,@body)
+ macroexpand-all-environment)))
+ (macroexp-warn-and-return
+ "`with-suppressed-warnings' with empty body"
+ nil '(empty-body with-suppressed-warnings) t warnings)))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
@@ -4835,6 +4841,11 @@ binding slots have been popped."
(dolist (clause (reverse clauses))
(let ((condition (nth 1 clause)))
+ (when (and (eq (car-safe condition) 'quote)
+ (cdr condition) (null (cddr condition)))
+ (byte-compile-warn-x
+ condition "`condition-case' condition should not be quoted: %S"
+ condition))
(unless (consp condition) (setq condition (list condition)))
(dolist (c condition)
(unless (and c (symbolp c))
@@ -5515,7 +5526,7 @@ and corresponding effects."
(macroexp-warn-and-return
(format "`%s' called with literal %s that may never match (%s)"
(car form) type parenthesis)
- form '(suspicious eq) t))
+ form (list 'suspicious (car form)) t))
(defun bytecomp--check-eq-args (form &optional a b &rest _ignore)
(let* ((number-ok (eq (car form) 'eql))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 67704bdb51..9e792889c8 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -92,9 +92,9 @@ using, but only when you also use Edebug."
;;;###autoload
(defcustom edebug-all-defs nil
"If non-nil, evaluating defining forms instruments for Edebug.
-This applies to `eval-defun', `eval-region', `eval-buffer', and
-`eval-current-buffer'. `eval-region' is also called by
-`eval-last-sexp', and `eval-print-last-sexp'.
+This applies to `eval-defun', `eval-region' and `eval-buffer'.
+`eval-region' is also called by `eval-last-sexp', and
+`eval-print-last-sexp'.
You can use the command `edebug-all-defs' to toggle the value of this
variable. You may wish to make it local to each buffer with
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 49f2a1d696..0614313809 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -102,42 +102,35 @@ the name of the test and the result of NAME-FORM."
(indent 1))
`(ert--call-with-test-buffer ,name-form (lambda () ,@body)))
-(cl-defmacro ert-with-test-buffer-selected ((&key name)
- &body body)
- "Create a test buffer, switch to it, and run BODY.
+(cl-defmacro ert-with-buffer-selected (buffer-or-name &body body)
+ "Display a buffer in a temporary selected window and run BODY.
+
+If BUFFER-OR-NAME is nil, the current buffer is used.
-This extends `ert-with-test-buffer' by displaying the test
-buffer (whose name is derived from NAME) in a temporary window.
-The temporary window becomes the `selected-window' before BODY is
-evaluated. The modification hooks `before-change-functions' and
+The buffer is made the current buffer, and the temporary window
+becomes the `selected-window', before BODY is evaluated. The
+modification hooks `before-change-functions' and
`after-change-functions' are not inhibited during the evaluation
of BODY, which makes it easier to use `execute-kbd-macro' to
simulate user interaction. The window configuration is restored
before returning, even if BODY exits nonlocally. The return
value is the last form in BODY."
- (declare (debug ((":name" form) def-body))
- (indent 1))
- (let ((ret (make-symbol "ert--with-test-buffer-selected-ret")))
- `(save-window-excursion
- (let (,ret)
- (ert-with-test-buffer (:name ,name)
- (with-current-buffer-window (current-buffer)
- `(display-buffer-below-selected
- (body-function
- . ,(lambda (window)
- (select-window window t)
- ;; body-function is intended to initialize the
- ;; contents of a temporary read-only buffer, so
- ;; it is executed with some convenience
- ;; changes. Undo those changes so that the
- ;; test buffer behaves more like an ordinary
- ;; buffer while the body executes.
- (let ((inhibit-modification-hooks nil)
- (inhibit-read-only nil)
- (buffer-read-only nil))
- (setq ,ret (progn ,@body))))))
- nil))
- ,ret))))
+ (declare (debug (form body)) (indent 1))
+ `(save-window-excursion
+ (with-current-buffer (or ,buffer-or-name (current-buffer))
+ (with-selected-window (display-buffer (current-buffer))
+ ,@body))))
+
+(cl-defmacro ert-with-test-buffer-selected ((&key name) &body body)
+ "Create a test buffer, switch to it, and run BODY.
+
+This combines `ert-with-test-buffer' and
+`ert-with-buffer-selected'. The return value is the last form in
+BODY."
+ (declare (debug ((":name" form) body)) (indent 1))
+ `(ert-with-test-buffer (:name ,name)
+ (ert-with-buffer-selected (current-buffer)
+ ,@body)))
;;;###autoload
(defun ert-kill-all-test-buffers ()
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 2dd04174f5..460d8eca58 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -608,7 +608,8 @@ instead of just updating them with the new/changed
autoloads."
(write-region (point-min) (point-max) output-file nil 'silent))
;; We have some data, so generate the loaddef files. First
;; group per output file.
- (dolist (fdefs (seq-group-by #'car defs))
+ (dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x)))
+ defs))
(let ((loaddefs-file (car fdefs))
hash)
(with-temp-buffer
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 8953e5fd01..d8c0cd5c7b 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -367,8 +367,8 @@ Assumes the caller has bound `macroexpand-all-environment'."
(if (null body)
(macroexp-unprogn
(macroexp-warn-and-return
- (format "Empty %s body" fun)
- nil nil 'compile-only fun))
+ (format "`%s' with empty body" fun)
+ nil (list 'empty-body fun) 'compile-only fun))
(macroexp--all-forms body))
(cdr form))
form)))
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index 8f0eedd2f8..a9fbdfea21 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -131,7 +131,7 @@ the `clone' function."
((null spec)
(package-vc-install name))
((stringp spec)
- (package-vc-install name nil spec))
+ (package-vc-install name spec))
((listp spec)
(package-vc--archives-initialize)
(package-vc--unpack (cadr pkg-descs) spec)))))))
@@ -306,7 +306,9 @@ asynchronously."
(directory (file-name-concat
(or (package-desc-dir pkg-desc)
(expand-file-name name package-user-dir))
- (plist-get pkg-spec :lisp-dir)))
+ (plist-get pkg-spec :lisp-dir)
+ (and-let* ((extras (package-desc-extras pkg-desc)))
+ (alist-get :lisp-dir extras))))
(file (or (plist-get pkg-spec :main-file)
(expand-file-name
(concat name ".el")
@@ -406,99 +408,156 @@ otherwise it's assumed to be an Info file."
(when clean-up
(delete-file file))))
+(defun package-vc-install-dependencies (requirements)
+ "Install missing dependencies, and return missing ones.
+The return value will be nil if everything was found, or a list
+of (NAME VERSION) pairs of all packages that couldn't be found.
+
+REQUIREMENTS should be a list of additional requirements; each
+element in this list should have the form (PACKAGE VERSION-LIST),
+where PACKAGE is a package name and VERSION-LIST is the required
+version of that package."
+ (let ((to-install '()) (missing '()))
+ (cl-labels ((search (pkg)
+ "Attempt to find all dependencies for PKG."
+ (cond
+ ((assq (car pkg) to-install)) ;inhibit cycles
+ ((package-installed-p (car pkg)))
+ ((let* ((pac package-archive-contents)
+ (desc (cadr (assoc (car pkg) pac))))
+ (if desc
+ (let ((reqs (package-desc-reqs pkg)))
+ (push pkg to-install)
+ (mapc #'search reqs))
+ (push pkg missing))))))
+ (version-order (a b)
+ "Predicate to sort packages in order."
+ (version-list-< (cadr b) (cadr a)))
+ (duplicate-p (a b)
+ "Are A and B the same package?"
+ (eq (car a) (car b)))
+ (depends-on-p (target package)
+ "Does PACKAGE depend on TARGET?"
+ (or (eq target package)
+ (let* ((pac package-archive-contents)
+ (desc (cadr (assoc package pac))))
+ (seq-some
+ (apply-partially #'depends-on-p target)
+ (package-desc-reqs desc)))))
+ (dependent-order (a b)
+ (or (not (depends-on-p (car b) (car a)))
+ (depends-on-p (car a) (car b)))))
+ (mapc #'search requirements)
+ (cl-callf sort to-install #'version-order)
+ (cl-callf seq-uniq to-install #'duplicate-p)
+ (cl-callf sort to-install #'dependent-order))
+ (mapc #'package-install-from-archive to-install)
+ missing))
+
(defun package-vc--unpack-1 (pkg-desc pkg-dir)
"Prepare PKG-DESC that is already checked-out in PKG-DIR.
This includes downloading missing dependencies, generating
autoloads, generating a package description file (used to
identify a package as a VC package later on), building
documentation and marking the package as installed."
- ;; Remove any previous instance of PKG-DESC from `package-alist'
- (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
- (when pkgs
- (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
-
- ;; In case the package was installed directly from source, the
- ;; dependency list wasn't know beforehand, and they might have
- ;; to be installed explicitly.
- (let ((deps '()))
- (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
- (with-temp-buffer
- (insert-file-contents file)
- (when-let* ((require-lines (lm-header-multiline "package-requires")))
- (thread-last
- (mapconcat #'identity require-lines " ")
- package-read-from-string
- package--prepare-dependencies
- (nconc deps)
- (setq deps)))))
- (dolist (dep deps)
- (cl-callf version-to-list (cadr dep)))
- (package-download-transaction
- (package-compute-transaction nil (delete-dups deps))))
-
- (let ((default-directory (file-name-as-directory pkg-dir))
- (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
- ;; Generate autoloads
- (let* ((name (package-desc-name pkg-desc))
- (auto-name (format "%s-autoloads.el" name))
- (extras (package-desc-extras pkg-desc))
- (lisp-dir (alist-get :lisp-dir extras)))
- (package-generate-autoloads
- name (file-name-concat pkg-dir lisp-dir))
- (when lisp-dir
- (write-region
- (with-temp-buffer
- (insert ";; Autoload indirection for package-vc\n\n")
- (prin1 `(load (expand-file-name
- ,(file-name-concat lisp-dir auto-name)
- (or (and load-file-name
- (file-name-directory load-file-name))
- (car load-path))))
- (current-buffer))
- (buffer-string))
- nil (expand-file-name auto-name pkg-dir))))
-
- ;; Generate package file
- (package-vc--generate-description-file pkg-desc pkg-file)
-
- ;; Detect a manual
- (when-let ((pkg-spec (package-vc--desc->spec pkg-desc))
- ((executable-find "install-info")))
- (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
- (package-vc--build-documentation pkg-desc doc-file))))
-
- ;; Update package-alist.
- (let ((new-desc (package-load-descriptor pkg-dir)))
- ;; Activation has to be done before compilation, so that if we're
- ;; upgrading and macros have changed we load the new definitions
- ;; before compiling.
- (when (package-activate-1 new-desc :reload :deps)
- ;; FIXME: Compilation should be done as a separate, optional, step.
- ;; E.g. for multi-package installs, we should first install all packages
- ;; and then compile them.
- (package--compile new-desc)
- (when package-native-compile
- (package--native-compile-async new-desc))
- ;; After compilation, load again any files loaded by
- ;; `activate-1', so that we use the byte-compiled definitions.
- (package--reload-previously-loaded new-desc)))
-
- ;; Mark package as selected
- (package--save-selected-packages
- (cons (package-desc-name pkg-desc)
- package-selected-packages))
- (package--quickstart-maybe-refresh)
-
- ;; Confirm that the installation was successful
- (let ((main-file (package-vc--main-file pkg-desc)))
- (message "VC package `%s' installed (Version %s, Revision %S)."
- (package-desc-name pkg-desc)
- (lm-with-file main-file
- (package-strip-rcs-id
- (or (lm-header "package-version")
- (lm-header "version"))))
- (vc-working-revision main-file)))
- t)
+ (let (missing)
+ ;; Remove any previous instance of PKG-DESC from `package-alist'
+ (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
+ (when pkgs
+ (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
+
+ ;; In case the package was installed directly from source, the
+ ;; dependency list wasn't know beforehand, and they might have
+ ;; to be installed explicitly.
+ (let ((deps '()))
+ (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when-let* ((require-lines (lm-header-multiline "package-requires")))
+ (thread-last
+ (mapconcat #'identity require-lines " ")
+ package-read-from-string
+ package--prepare-dependencies
+ (nconc deps)
+ (setq deps)))))
+ (dolist (dep deps)
+ (cl-callf version-to-list (cadr dep)))
+ (setf missing (package-vc-install-dependencies (delete-dups deps)))
+ (setf missing (delq (assq (package-desc-name pkg-desc)
+ missing)
+ missing)))
+
+ (let ((default-directory (file-name-as-directory pkg-dir))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
+ ;; Generate autoloads
+ (let* ((name (package-desc-name pkg-desc))
+ (auto-name (format "%s-autoloads.el" name))
+ (extras (package-desc-extras pkg-desc))
+ (lisp-dir (alist-get :lisp-dir extras)))
+ (package-generate-autoloads
+ name (file-name-concat pkg-dir lisp-dir))
+ (when lisp-dir
+ (write-region
+ (with-temp-buffer
+ (insert ";; Autoload indirection for package-vc\n\n")
+ (prin1 `(load (expand-file-name
+ ,(file-name-concat lisp-dir auto-name)
+ (or (and load-file-name
+ (file-name-directory load-file-name))
+ (car load-path))))
+ (current-buffer))
+ (buffer-string))
+ nil (expand-file-name auto-name pkg-dir))))
+
+ ;; Generate package file
+ (package-vc--generate-description-file pkg-desc pkg-file)
+
+ ;; Detect a manual
+ (when-let ((pkg-spec (package-vc--desc->spec pkg-desc))
+ ((executable-find "install-info")))
+ (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
+ (package-vc--build-documentation pkg-desc doc-file))))
+
+ ;; Update package-alist.
+ (let ((new-desc (package-load-descriptor pkg-dir)))
+ ;; Activation has to be done before compilation, so that if we're
+ ;; upgrading and macros have changed we load the new definitions
+ ;; before compiling.
+ (when (package-activate-1 new-desc :reload :deps)
+ ;; FIXME: Compilation should be done as a separate, optional, step.
+ ;; E.g. for multi-package installs, we should first install all
packages
+ ;; and then compile them.
+ (package--compile new-desc)
+ (when package-native-compile
+ (package--native-compile-async new-desc))
+ ;; After compilation, load again any files loaded by
+ ;; `activate-1', so that we use the byte-compiled definitions.
+ (package--reload-previously-loaded new-desc)))
+
+ ;; Mark package as selected
+ (package--save-selected-packages
+ (cons (package-desc-name pkg-desc)
+ package-selected-packages))
+ (package--quickstart-maybe-refresh)
+
+ ;; Confirm that the installation was successful
+ (let ((main-file (package-vc--main-file pkg-desc)))
+ (message "VC package `%s' installed (Version %s, Revision %S).%s"
+ (package-desc-name pkg-desc)
+ (lm-with-file main-file
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ (vc-working-revision main-file)
+ (if missing
+ (format
+ " Failed to install the following dependencies: %s"
+ (mapconcat
+ (lambda (p)
+ (format "%s (%s)" (car p) (cadr p)))
+ missing ", "))
+ "")))
+ t))
(defun package-vc--guess-backend (url)
"Guess the VC backend for URL.
@@ -552,6 +611,23 @@ checkout. This overrides the `:branch' attribute in
PKG-SPEC."
(error "There already exists a checkout for %s" name)))
(package-vc--clone pkg-desc pkg-spec pkg-dir rev)
+ ;; When nothing is specified about a `lisp-dir', then should
+ ;; heuristically check if there is a sub-directory with lisp
+ ;; files. These are conventionally just called "lisp" or "src".
+ ;; If this directory exists and contains non-zero number of lisp
+ ;; files, we will use that instead of `pkg-dir'.
+ (catch 'done
+ (dolist (name '("lisp" "src"))
+ (when-let* (((null lisp-dir))
+ (dir (expand-file-name name pkg-dir))
+ ((file-directory-p dir))
+ ((directory-files dir nil "\\`[^.].+\\.el\\'" t 1)))
+ ;; We won't use `dir', since dir is an absolute path and we
+ ;; don't want `lisp-dir' to depend on the current location of
+ ;; the package installation, ie. to break if moved around the
+ ;; file system or between installations.
+ (throw 'done (setq lisp-dir name)))))
+
(when lisp-dir
(push (cons :lisp-dir lisp-dir)
(package-desc-extras pkg-desc)))
@@ -661,7 +737,7 @@ If no such revision can be found, return nil."
(line-number-at-pos nil t))))))))
;;;###autoload
-(defun package-vc-install (package &optional name rev backend)
+(defun package-vc-install (package &optional rev backend name)
"Fetch a PACKAGE and set it up for using with Emacs.
If PACKAGE is a string containing an URL, download the package
@@ -685,7 +761,9 @@ the package's repository; this is only possible if
NAME-OR-URL is a URL,
a string. If BACKEND is omitted or nil, the function
uses `package-vc-heuristic-alist' to guess the backend.
Note that by default, a VC package will be prioritized over a
-regular package, but it will not remove a VC package."
+regular package, but it will not remove a VC package.
+
+\(fn PACKAGE &optional REV BACKEND)"
(interactive
(progn
;; Initialize the package system to get the list of package
@@ -694,8 +772,10 @@ regular package, but it will not remove a VC package."
(let* ((name-or-url (package-vc--read-package-name
"Fetch and install package: " t))
(name (file-name-base name-or-url)))
- (list name-or-url (intern (string-remove-prefix "emacs-" name))
- (and current-prefix-arg :last-release)))))
+ (list name-or-url
+ (and current-prefix-arg :last-release)
+ nil
+ (intern (string-remove-prefix "emacs-" name))))))
(package-vc--archives-initialize)
(cond
((null package)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 1cc978923e..1ab70eb2fe 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2094,7 +2094,7 @@ if all the in-between dependencies are also in
PACKAGE-LIST."
(defun package-install-from-archive (pkg-desc)
"Download and install a package defined by PKG-DESC."
;; This won't happen, unless the archive is doing something wrong.
- (when (package-vc-p pkg-desc)
+ (when (eq (package-desc-kind pkg-desc) 'dir)
(error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 6704db3cc5..90f81d740f 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -263,6 +263,12 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (stringp "a")
:eval (stringp 'a)
:eval "(stringp ?a)")
+ (string-or-null-p
+ :eval (string-or-null-p "a")
+ :eval (string-or-null-p nil))
+ (char-or-string-p
+ :eval "(char-or-string-p ?a)"
+ :eval (char-or-string-p "a"))
(string-empty-p
:no-manual t
:eval (string-empty-p ""))
@@ -300,6 +306,9 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (string-to-number "2.5e+03"))
(number-to-string
:eval (number-to-string 42))
+ (char-uppercase-p
+ :eval "(char-uppercase-p ?A)"
+ :eval "(char-uppercase-p ?a)")
"Data About Strings"
(length
:eval (length "foo")
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 4896f4c293..415f8db52c 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -333,7 +333,10 @@ as the new values of the bound variables in the recursive
invocation."
;;;###autoload
(defun string-glyph-split (string)
"Split STRING into a list of strings representing separate glyphs.
-This takes into account combining characters and grapheme clusters."
+This takes into account combining characters and grapheme clusters:
+if compositions are enbaled, each sequence of characters composed
+on display into a single grapheme cluster is treated as a single
+indivisible unit."
(let ((result nil)
(start 0)
comp)
diff --git a/lisp/epa-ks.el b/lisp/epa-ks.el
index bb64b61b8f..668cdf9a61 100644
--- a/lisp/epa-ks.el
+++ b/lisp/epa-ks.el
@@ -135,9 +135,9 @@ Keys are marked using `epa-ks-mark-key-to-fetch'."
keys))
(forward-line))
(when (yes-or-no-p (format "Proceed with fetching all %d key(s)? "
- (length keys))))
- (dolist (id keys)
- (epa-ks--fetch-key id))))
+ (length keys)))
+ (dolist (id keys)
+ (epa-ks--fetch-key id)))))
(tabulated-list-clear-all-tags))
(defun epa-ks--query-url (query exact)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 43c5faad63..6820bf0d1a 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -320,6 +320,15 @@ session when reconnecting. Once `erc-reuse-buffers' is
retired
and fully removed, modules can switch to leveraging the
`permanent-local' property instead.")
+(defvar erc--server-post-connect-hook '(erc-networks--warn-on-connect)
+ "Functions to run when a network connection is successfully opened.
+Though internal, this complements `erc-connect-pre-hook' in that
+it bookends the process rather than the logical connection, which
+is the domain of `erc-before-connect' and `erc-after-connect'.
+Note that unlike `erc-connect-pre-hook', this only runs in server
+buffers, and it does so immediately before the first protocol
+exchange.")
+
(defvar-local erc-server-timed-out nil
"Non-nil if the IRC server failed to respond to a ping.")
@@ -646,6 +655,7 @@ The current buffer is given by BUFFER."
(cl-defmethod erc--register-connection ()
"Perform opening IRC protocol exchange with server."
+ (run-hooks 'erc--server-post-connect-hook)
(erc-login))
(defvar erc--server-connect-dumb-ipv6-regexp
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index fdcb146d42..864c5882cf 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -261,7 +261,7 @@ If START or END is negative, it counts from the end."
(when-let* ((s (plist-get e :secret))
(v (auth-source--obfuscate s)))
(setf (plist-get e :secret)
- (byte-compile (lambda () (auth-source--deobfuscate v)))))
+ (apply-partially #'auth-source--deobfuscate v)))
(push e out)))
rv)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 2e2d093011..f05a98be16 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1472,14 +1472,16 @@ to be a false alarm. If `erc-reuse-buffers' is nil, let
(t (rename-buffer (generate-new-buffer-name name)))))
nil)
-;; Soju v0.4.0 only sends ISUPPORT on upstream reconnect, so this
-;; doesn't apply. ZNC 1.8.2, however, still sends the entire burst.
-(defconst erc-networks--bouncer-targets '(*status bouncerserv)
- "Case-mapped symbols matching known bouncer service-bot targets.")
+;; Soju v0.4.0 sends ISUPPORT and nothing else on upstream reconnect,
+;; so this actually doesn't apply. ZNC 1.8.2, however, still sends
+;; the entire burst.
+(defvar erc-networks--bouncer-targets '(*status bouncerserv)
+ "Symbols matching proxy-bot targets.")
(defun erc-networks-on-MOTD-end (proc parsed)
- "Call on-connect functions with server PROC and PARSED message.
-This must run before `erc-server-connected' is set."
+ "Call on-connect functions with server PROC and PARSED message."
+ ;; This should normally run before `erc-server-connected' is set.
+ ;; However, bouncers and other proxies may interfere with that.
(when erc-server-connected
(unless (erc-buffer-filter (lambda ()
(and erc--target
@@ -1502,6 +1504,18 @@ This must run before `erc-server-connected' is set."
((remove-hook 'erc-server-376-functions #'erc-networks-on-MOTD-end)
(remove-hook 'erc-server-422-functions #'erc-networks-on-MOTD-end)))
+(defun erc-networks--warn-on-connect ()
+ "Emit warning when the `networks' module hasn't been loaded.
+Ideally, do so upon opening the network process."
+ (unless (or erc--target erc-networks-mode)
+ (require 'info nil t)
+ (let ((m (concat "Required module `networks' not loaded. If this "
+ " was unexpected, please add it to `erc-modules'.")))
+ ;; Assume the server buffer has been marked as active.
+ (erc-display-error-notice
+ nil (concat m " See Info:\"(erc) Required Modules\" for more."))
+ (lwarn 'erc :warning m))))
+
(defun erc-ports-list (ports)
"Return a list of PORTS.
diff --git a/lisp/erc/erc-sasl.el b/lisp/erc/erc-sasl.el
index 78d02a4638..23110d74b5 100644
--- a/lisp/erc/erc-sasl.el
+++ b/lisp/erc/erc-sasl.el
@@ -435,7 +435,7 @@ Otherwise, expect it to disappear in subsequent versions.")
(if (eq :user (alist-get 'user erc-sasl--options))
(erc-current-nick)
erc-session-username)))
- (erc-login))
+ (cl-call-next-method))
(when erc-sasl--send-cap-ls
(erc-server-send "CAP REQ :sasl"))
(erc-server-send (format "AUTHENTICATE %s" m)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6a5e001896..16a0aba77b 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -1607,7 +1607,8 @@ same manner."
(when target ; compat
(setq tgt-info (erc--target-from-string target)))
(if tgt-info
- (let* ((esid (erc-networks--id-symbol erc-networks--id))
+ (let* ((esid (and erc-networks--id
+ (erc-networks--id-symbol erc-networks--id)))
(name (if esid
(erc-networks--reconcile-buffer-names tgt-info
erc-networks--id)
@@ -6760,7 +6761,8 @@ This should be a string with substitution variables
recognized by
If the name of the network is not available, then use the
shortened server name instead."
(if-let ((erc--target)
- (name (if-let ((esid (erc-networks--id-symbol erc-networks--id)))
+ (name (if-let ((erc-networks--id)
+ (esid (erc-networks--id-symbol erc-networks--id)))
(symbol-name esid)
(erc-shorten-server-name (or erc-server-announced-name
erc-session-server)))))
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index 499deaa7fc..2453af1bac 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -30,8 +30,9 @@
(eval-when-compile
(require 'esh-mode)
- (require 'eshell)
- (require 'tramp))
+ (require 'eshell))
+
+(require 'tramp)
;; There are no items in this custom group, but eshell modules (ab)use
;; custom groups.
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 79957aeb41..39579335cf 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -419,11 +419,10 @@ hooks should be run before and after the command."
(let ((cmd commands))
(while cmd
;; Copy I/O handles so each full statement can manipulate them
- ;; if they like. As a small optimization, skip this for the
- ;; last top-level one; we won't use these handles again
- ;; anyway.
- (when (or (not toplevel) (cdr cmd))
- (setcar cmd `(eshell-with-copied-handles ,(car cmd))))
+ ;; if they like. Steal the handles for the last command in
+ ;; the list; we won't use the originals again anyway.
+ (setcar cmd `(eshell-with-copied-handles
+ ,(car cmd) ,(not (cdr cmd))))
(setq cmd (cdr cmd))))
(if toplevel
`(eshell-commands (progn
@@ -792,10 +791,12 @@ this grossness will be made to disappear by using
`call/cc'..."
(defvar eshell-output-handle) ;Defined in esh-io.el.
(defvar eshell-error-handle) ;Defined in esh-io.el.
-(defmacro eshell-with-copied-handles (object)
- "Duplicate current I/O handles, so OBJECT works with its own copy."
+(defmacro eshell-with-copied-handles (object &optional steal-p)
+ "Duplicate current I/O handles, so OBJECT works with its own copy.
+If STEAL-P is non-nil, these new handles will be stolen from the
+current ones (see `eshell-duplicate-handles')."
`(let ((eshell-current-handles
- (eshell-duplicate-handles eshell-current-handles)))
+ (eshell-duplicate-handles eshell-current-handles ,steal-p)))
,object))
(define-obsolete-function-alias 'eshell-copy-handles
@@ -836,7 +837,9 @@ This macro calls itself recursively, with NOTFIRST non-nil."
(let ((proc ,(car pipeline)))
(set headproc (or proc (symbol-value headproc)))
(set tailproc (or (symbol-value tailproc) proc))
- proc))))))
+ proc)))
+ ;; Steal handles if this is the last item in the pipeline.
+ ,(null (cdr pipeline)))))
(defmacro eshell-do-pipelines-synchronously (pipeline)
"Execute the commands in PIPELINE in sequence synchronously.
@@ -1024,7 +1027,9 @@ produced by `eshell-parse-command'."
;; We can just stick the new command at the end of the current
;; one, and everything will happen as it should.
(setcdr (last (cdr eshell-current-command))
- (list `(let ((here (and (eobp) (point))))
+ (list `(let ((here (and (eobp) (point)))
+ (eshell-command-body '(nil))
+ (eshell-test-body '(nil)))
,(and input
`(insert-and-inherit ,(concat input "\n")))
(if here
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index f2bc87374c..90826a312b 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -302,35 +302,51 @@ value of mode defaults to `insert'.
The result is a vector of file handles. Each handle is of the form:
- (TARGETS DEFAULT REF-COUNT)
+ ((TARGETS . REF-COUNT) DEFAULT)
-TARGETS is a list of destinations for output. DEFAULT is non-nil
-if handle has its initial default value (always t after calling
-this function). REF-COUNT is the number of references to this
-handle (initially 1); see `eshell-protect-handles' and
-`eshell-close-handles'."
+TARGETS is a list of destinations for output. REF-COUNT is the
+number of references to this handle (initially 1); see
+`eshell-protect-handles' and `eshell-close-handles'. DEFAULT is
+non-nil if handle has its initial default value (always t after
+calling this function)."
(let* ((handles (make-vector eshell-number-of-handles nil))
- (output-target (eshell-get-targets stdout output-mode))
- (error-target (if stderr
- (eshell-get-targets stderr error-mode)
- output-target)))
- (aset handles eshell-output-handle (list output-target t 1))
- (aset handles eshell-error-handle (list error-target t 1))
+ (output-target
+ (let ((target (eshell-get-target stdout output-mode)))
+ (cons (when target (list target)) 1)))
+ (error-target
+ (if stderr
+ (let ((target (eshell-get-target stderr error-mode)))
+ (cons (when target (list target)) 1))
+ (cl-incf (cdr output-target))
+ output-target)))
+ (aset handles eshell-output-handle (list output-target t))
+ (aset handles eshell-error-handle (list error-target t))
handles))
-(defun eshell-duplicate-handles (handles)
+(defun eshell-duplicate-handles (handles &optional steal-p)
"Create a duplicate of the file handles in HANDLES.
-This will copy the targets of each handle in HANDLES, setting the
-DEFAULT field to t (see `eshell-create-handles')."
- (eshell-create-handles
- (car (aref handles eshell-output-handle)) nil
- (car (aref handles eshell-error-handle)) nil))
+This uses the targets of each handle in HANDLES, incrementing its
+reference count by one (unless STEAL-P is non-nil). These
+targets are shared between the original set of handles and the
+new one, so the targets are only closed when the reference count
+drops to 0 (see `eshell-close-handles').
+
+This function also sets the DEFAULT field for each handle to
+t (see `eshell-create-handles'). Unlike the targets, this value
+is not shared with the original handles."
+ (let ((dup-handles (make-vector eshell-number-of-handles nil)))
+ (dotimes (idx eshell-number-of-handles)
+ (when-let ((handle (aref handles idx)))
+ (unless steal-p
+ (cl-incf (cdar handle)))
+ (aset dup-handles idx (list (car handle) t))))
+ dup-handles))
(defun eshell-protect-handles (handles)
"Protect the handles in HANDLES from a being closed."
(dotimes (idx eshell-number-of-handles)
(when-let ((handle (aref handles idx)))
- (setcar (nthcdr 2 handle) (1+ (nth 2 handle)))))
+ (cl-incf (cdar handle))))
handles)
(defun eshell-close-handles (&optional exit-code result handles)
@@ -348,29 +364,45 @@ the value already set in `eshell-last-command-result'."
(when result
(cl-assert (eq (car result) 'quote))
(setq eshell-last-command-result (cadr result)))
- (let ((handles (or handles eshell-current-handles)))
+ (let ((handles (or handles eshell-current-handles))
+ (succeeded (= eshell-last-command-status 0)))
(dotimes (idx eshell-number-of-handles)
- (when-let ((handle (aref handles idx)))
- (setcar (nthcdr 2 handle) (1- (nth 2 handle)))
- (when (= (nth 2 handle) 0)
- (dolist (target (ensure-list (car (aref handles idx))))
- (eshell-close-target target (= eshell-last-command-status 0)))
- (setcar handle nil))))))
+ (eshell-close-handle (aref handles idx) succeeded))))
+
+(defun eshell-close-handle (handle status)
+ "Close a single HANDLE, taking refcounts into account.
+This will pass STATUS to each target for the handle, which should
+be a non-nil value on successful termination."
+ (when handle
+ (cl-assert (> (cdar handle) 0)
+ "Attempted to close a handle with 0 references")
+ (when (and (> (cdar handle) 0)
+ (= (cl-decf (cdar handle)) 0))
+ (dolist (target (caar handle))
+ (eshell-close-target target status))
+ (setcar (car handle) nil))))
(defun eshell-set-output-handle (index mode &optional target handles)
"Set handle INDEX for the current HANDLES to point to TARGET using MODE.
-If HANDLES is nil, use `eshell-current-handles'."
+If HANDLES is nil, use `eshell-current-handles'.
+
+If the handle is currently set to its default value (see
+`eshell-create-handles'), this will overwrite the targets with
+the new target. Otherwise, it will append the new target to the
+current list of targets."
(when target
(let* ((handles (or handles eshell-current-handles))
(handle (or (aref handles index)
- (aset handles index (list nil nil 1))))
- (defaultp (cadr handle))
- (current (unless defaultp (car handle))))
+ (aset handles index (list (cons nil 1) nil))))
+ (defaultp (cadr handle)))
+ (when defaultp
+ (cl-decf (cdar handle))
+ (setcar handle (cons nil 1)))
(catch 'eshell-null-device
- (let ((where (eshell-get-target target mode)))
+ (let ((current (caar handle))
+ (where (eshell-get-target target mode)))
(unless (member where current)
- (setq current (append current (list where))))))
- (setcar handle current)
+ (setcar (car handle) (append current (list where))))))
(setcar (cdr handle) nil))))
(defun eshell-copy-output-handle (index index-to-copy &optional handles)
@@ -378,10 +410,10 @@ If HANDLES is nil, use `eshell-current-handles'."
If HANDLES is nil, use `eshell-current-handles'."
(let* ((handles (or handles eshell-current-handles))
(handle-to-copy (car (aref handles index-to-copy))))
- (setcar (aref handles index)
- (if (listp handle-to-copy)
- (copy-sequence handle-to-copy)
- handle-to-copy))))
+ (when handle-to-copy
+ (cl-incf (cdr handle-to-copy)))
+ (eshell-close-handle (aref handles index) nil)
+ (setcar (aref handles index) handle-to-copy)))
(defun eshell-set-all-output-handles (mode &optional target handles)
"Set output and error HANDLES to point to TARGET using MODE.
@@ -501,13 +533,6 @@ it defaults to `insert'."
(error "Invalid redirection target: %s"
(eshell-stringify target)))))
-(defun eshell-get-targets (targets &optional mode)
- "Convert TARGETS into valid output targets.
-TARGETS can be a single raw target or a list thereof. MODE is either
-`overwrite', `append' or `insert'; if it is omitted or nil, it
-defaults to `insert'."
- (mapcar (lambda (i) (eshell-get-target i mode)) (ensure-list targets)))
-
(defun eshell-interactive-output-p (&optional index handles)
"Return non-nil if the specified handle is bound for interactive display.
HANDLES is the set of handles to check; if nil, use
@@ -519,9 +544,9 @@ INDEX is the handle index to check. If nil, check
(let ((handles (or handles eshell-current-handles))
(index (or index eshell-output-handle)))
(if (eq index 'all)
- (and (equal (car (aref handles eshell-output-handle)) '(t))
- (equal (car (aref handles eshell-error-handle)) '(t)))
- (equal (car (aref handles index)) '(t)))))
+ (and (equal (caar (aref handles eshell-output-handle)) '(t))
+ (equal (caar (aref handles eshell-error-handle)) '(t)))
+ (equal (caar (aref handles index)) '(t)))))
(defvar eshell-print-queue nil)
(defvar eshell-print-queue-count -1)
@@ -628,8 +653,8 @@ Returns what was actually sent, or nil if nothing was sent."
If HANDLE-INDEX is nil, output to `eshell-output-handle'.
HANDLES is the set of file handles to use; if nil, use
`eshell-current-handles'."
- (let ((targets (car (aref (or handles eshell-current-handles)
- (or handle-index eshell-output-handle)))))
+ (let ((targets (caar (aref (or handles eshell-current-handles)
+ (or handle-index eshell-output-handle)))))
(dolist (target targets)
(eshell-output-object-to-target object target))))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 950922ea7f..c56278aad0 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -467,7 +467,7 @@ PROC is the process that's exiting. STRING is the exit
message."
(if (process-get proc :eshell-busy)
(run-at-time 0 nil finish-io)
(when data
- (ignore-error 'eshell-pipe-broken
+ (ignore-error eshell-pipe-broken
(eshell-output-object
data index handles)))
(eshell-close-handles
diff --git a/lisp/faces.el b/lisp/faces.el
index c69339e2fd..0dd89be473 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -47,7 +47,8 @@ the terminal-initialization file to be loaded."
("vt400" . "vt200")
("vt420" . "vt200")
("alacritty" . "xterm")
- ("foot" . "xterm"))
+ ("foot" . "xterm")
+ ("contour" . "xterm"))
"Alist of terminal type aliases.
Entries are of the form (TYPE . ALIAS), where both elements are strings.
This means to treat a terminal of type TYPE as if it were of type ALIAS."
@@ -689,6 +690,10 @@ be reset to `unspecified' when creating new frames,
disregarding
what the FACE's face spec says, call this function with FRAME set to
t and the ATTRIBUTE's value set to `unspecified'.
+Note that the ATTRIBUTE VALUE pairs are evaluated in the order
+they are specified, except that the `:family' and `:foundry'
+attributes are evaluated first.
+
The following attributes are recognized:
`:family'
diff --git a/lisp/files.el b/lisp/files.el
index f352d3a9a7..e729c00782 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2850,7 +2850,7 @@ since only a single case-insensitive search through the
alist is made."
("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
- ("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
+ ("\\.\\(scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
("\\.l\\'" . lisp-mode)
("\\.li?sp\\'" . lisp-mode)
("\\.[fF]\\'" . fortran-mode)
@@ -6193,11 +6193,11 @@ instance of such commands."
(rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
-(defun files--ensure-directory (mkdir dir)
- "Use function MKDIR to make directory DIR if it is not already a directory.
+(defun files--ensure-directory (dir)
+ "Make directory DIR if it is not already a directory.
Return non-nil if DIR is already a directory."
(condition-case err
- (funcall mkdir dir)
+ (make-directory-internal dir)
(error
(or (file-directory-p dir)
(signal (car err) (cdr err))))))
@@ -6223,32 +6223,27 @@ Signal an error if unsuccessful."
;; If default-directory is a remote directory,
;; make sure we find its make-directory handler.
(setq dir (expand-file-name dir))
- (let ((mkdir (if-let ((handler (find-file-name-handler dir 'make-directory)))
- #'(lambda (dir)
- ;; Use 'ignore' since the handler might be designed for
- ;; Emacs 28-, so it might return an (undocumented)
- ;; non-nil value, whereas the Emacs 29+ convention is
- ;; to return nil here.
- (ignore (funcall handler 'make-directory dir)))
- #'make-directory-internal)))
- (if (not parents)
- (funcall mkdir dir)
- (let ((dir (directory-file-name (expand-file-name dir)))
- already-dir create-list parent)
- (while (progn
- (setq parent (directory-file-name
- (file-name-directory dir)))
- (condition-case ()
- (ignore (setq already-dir
- (files--ensure-directory mkdir dir)))
- (error
- ;; Do not loop if root does not exist (Bug#2309).
- (not (string= dir parent)))))
- (setq create-list (cons dir create-list)
- dir parent))
- (dolist (dir create-list)
- (setq already-dir (files--ensure-directory mkdir dir)))
- already-dir))))
+ (let ((handler (find-file-name-handler dir 'make-directory)))
+ (if handler
+ (funcall handler 'make-directory dir parents)
+ (if (not parents)
+ (make-directory-internal dir)
+ (let ((dir (directory-file-name (expand-file-name dir)))
+ already-dir create-list parent)
+ (while (progn
+ (setq parent (directory-file-name
+ (file-name-directory dir)))
+ (condition-case ()
+ (ignore (setq already-dir
+ (files--ensure-directory dir)))
+ (error
+ ;; Do not loop if root does not exist (Bug#2309).
+ (not (string= dir parent)))))
+ (setq create-list (cons dir create-list)
+ dir parent))
+ (dolist (dir create-list)
+ (setq already-dir (files--ensure-directory dir)))
+ already-dir)))))
(defun make-empty-file (filename &optional parents)
"Create an empty file FILENAME.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 2dfbe3ad23..831e603239 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -2110,7 +2110,7 @@ For example, the declaration and use of fields in a
struct."
(defface font-lock-punctuation-face
'((t nil))
- "Font Lock mode face used to highlight punctuation."
+ "Font Lock mode face used to highlight punctuation characters."
:group 'font-lock-faces
:version "29.1")
@@ -2122,7 +2122,9 @@ For example, the declaration and use of fields in a
struct."
(defface font-lock-delimiter-face
'((t :inherit font-lock-punctuation-face))
- "Font Lock mode face used to highlight delimiters."
+ "Font Lock mode face used to highlight delimiters.
+What exactly is a delimiter depends on the major mode, but usually
+these are characters like comma, colon, and semi-colon."
:group 'font-lock-faces
:version "29.1")
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index cf5ca628cf..c5cd4d7d6b 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -394,7 +394,7 @@ This is not required after changing
`gnus-registry-cache-file'."
(with-no-warnings
(eieio-persistent-read file 'registry-db))
;; Older EIEIO versions do not check the class name.
- ('wrong-number-of-arguments
+ (wrong-number-of-arguments
(eieio-persistent-read file)))))
(gnus-message 5 "Reading Gnus registry from %s...done" file))
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index ab9c6dd74f..e3fb5d8f87 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -339,8 +339,15 @@ all. This may very well take some time.")
;; for this header) or one list (specifying all the possible values for this
;; header). In the latter case, the list does NOT include the unspecified
;; spec (*).
+
;; For time zone values, we have symbolic time zone names associated with
;; the (relative) number of seconds ahead GMT.
+ ;; The list of time zone values is obsolescent, and new code should
+ ;; not rely on it. Many of the time zone abbreviations are wrong;
+ ;; in particular, all single-letter abbreviations other than "Z" have
+ ;; been wrong since Internet RFC 2822 (2001). However, the
+ ;; abbreviations have not been changed due to backward compatibility
+ ;; concerns.
)
(defsubst nndiary-schedule ()
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e29f763dab..3307771ef6 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -2004,8 +2004,8 @@ variable with value KEYMAP."
(mapatoms (lambda (symb)
(when (and (boundp symb)
(eq (symbol-value symb) keymap)
- (not (eq symb 'keymap))
- (throw 'found-keymap symb)))))
+ (not (eq symb 'keymap)))
+ (throw 'found-keymap symb))))
nil)))
;; Follow aliasing.
(or (ignore-errors (indirect-variable name)) name))))
diff --git a/lisp/help.el b/lisp/help.el
index b709062cb2..d7fd4d555e 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -76,6 +76,7 @@ buffer.")
"C-n" #'view-emacs-news
"C-o" #'describe-distribution
"C-p" #'view-emacs-problems
+ "C-q" #'help-quick-toggle
"C-s" #'search-forward-help-for-help
"C-t" #'view-emacs-todo
"C-w" #'describe-no-warranty
@@ -116,7 +117,7 @@ buffer.")
"v" #'describe-variable
"w" #'where-is
"x" #'describe-command
- "q" #'help-quit-or-quick)
+ "q" #'help-quit)
(define-key global-map (char-to-string help-char) 'help-command)
(define-key global-map [help] 'help-command)
@@ -243,7 +244,17 @@ buffer.")
;; ... and shrink it immediately.
(fit-window-to-buffer))
(message
- (substitute-command-keys "Toggle the quick help buffer using
\\[help-quit-or-quick]."))))
+ (substitute-command-keys "Toggle the quick help buffer using
\\[help-quick-toggle]."))))
+
+(defun help-quick-toggle ()
+ "Toggle the quick-help window."
+ (interactive)
+ (if (and-let* ((window (get-buffer-window "*Quick Help*")))
+ (quit-window t window))
+ ;; Clear the message we may have gotten from `C-h' and then
+ ;; waiting before hitting `q'.
+ (message "")
+ (help-quick)))
(defalias 'cheat-sheet #'help-quick)
@@ -252,21 +263,6 @@ buffer.")
(interactive)
nil)
-(defun help-quit-or-quick ()
- "Call `help-quit' or `help-quick' depending on the context."
- (interactive)
- (cond
- (help-buffer-under-preparation
- ;; FIXME: There should be a better way to detect if we are in the
- ;; help command loop.
- (help-quit))
- ((and-let* ((window (get-buffer-window "*Quick Help*")))
- (quit-window t window)
- ;; Clear the message we may have gotten from `C-h' and then
- ;; waiting before hitting `q'.
- (message "")))
- ((help-quick))))
-
(defvar help-return-method nil
"What to do to \"exit\" the help buffer.
This is a list
@@ -416,7 +412,7 @@ Do not call this in the scope of `with-help-window'."
("describe-package" "Describe a specific Emacs package")
""
("help-with-tutorial" "Start the Emacs tutorial")
- ("help-quick-or-quit" "Display the quick help buffer.")
+ ("help-quick-toggle" "Display the quick help buffer.")
("view-echo-area-messages"
"Show recent messages (from echo area)")
("view-lossage" ,(format "Show last %d input keystrokes (lossage)"
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index a45e74eca2..bc631747e6 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -569,24 +569,29 @@ the major mode specifies support for Font Lock."
(when (and face-before face-after (not (eq face-before face-after)))
(setq face-before nil))
(when (or face-after face-before)
- (let* ((hi-text
- (buffer-substring-no-properties
- (if face-before
- (or (previous-single-property-change (point) 'face)
- (point-min))
- (point))
- (if face-after
- (or (next-single-property-change (point) 'face)
- (point-max))
- (point)))))
+ (let* ((beg (if face-before
+ (or (previous-single-property-change (point) 'face)
+ (point-min))
+ (point)))
+ (end (if face-after
+ (or (next-single-property-change (point) 'face)
+ (point-max))
+ (point))))
;; Compute hi-lock patterns that match the
;; highlighted text at point. Use this later in
;; during completing-read.
(dolist (hi-lock-pattern hi-lock-interactive-patterns)
- (let ((regexp (or (car (rassq hi-lock-pattern
hi-lock-interactive-lighters))
- (car hi-lock-pattern))))
- (if (string-match regexp hi-text)
- (push regexp regexps)))))))
+ (let ((pattern (or (rassq hi-lock-pattern
hi-lock-interactive-lighters)
+ (car hi-lock-pattern))))
+ (cond
+ ((stringp pattern)
+ (when (string-match pattern (buffer-substring-no-properties
beg end))
+ (push pattern regexps)))
+ ((functionp (cadr pattern))
+ (save-excursion
+ (goto-char beg)
+ (when (funcall (cadr pattern) end)
+ (push (car pattern) regexps))))))))))
regexps))
(defvar-local hi-lock--unused-faces nil
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index df4c6ab079..32bf0bf4d4 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1850,8 +1850,9 @@ Hardly bombproof, but good enough in the context in which
it is being used."
(defun hfy-text-p (srcdir file)
"Is SRCDIR/FILE text? Use `hfy-istext-command' to determine this."
- (let* ((cmd (format hfy-istext-command (expand-file-name file srcdir)))
- (rsp (shell-command-to-string cmd)))
+ (let* ((cmd (format hfy-istext-command
+ (shell-quote-argument (expand-file-name file srcdir))))
+ (rsp (shell-command-to-string cmd)))
(string-match "text" rsp)))
;; open a file, check fontification, if fontified, write a fontified copy
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index bd208fbad4..10af8c6cab 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -1086,7 +1086,7 @@ Otherwise, display the image by calling `image-mode'."
(unwind-protect
(progn
(setq-local image-fit-to-window-lock t)
- (ignore-error 'remote-file-error
+ (ignore-error remote-file-error
(image-toggle-display-image)))
(setq image-fit-to-window-lock nil)))))))))))
diff --git a/lisp/indent.el b/lisp/indent.el
index c7ec5c9a3e..6b575a86b5 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -784,7 +784,8 @@ If PREV is non-nil, return the previous one instead."
(defun tab-to-tab-stop ()
"Insert spaces or tabs to next defined tab-stop column.
The variable `tab-stop-list' is a list of columns at which there are tab stops.
-Use \\[edit-tab-stops] to edit them interactively."
+Use \\[edit-tab-stops] to edit them interactively.
+Whether this inserts tabs or spaces depends on `indent-tabs-mode'."
(interactive)
(and abbrev-mode (= (char-syntax (preceding-char)) ?w)
(expand-abbrev))
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 9dcae187f2..42344d499c 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -184,7 +184,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(dolist (c '(chinese-cns11643-1 chinese-cns11643-2 chinese-cns11643-3
chinese-cns11643-4 chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7))
+ chinese-cns11643-7 chinese-cns11643-15))
(map-charset-chars #'modify-category-entry c ?c)
(if (eq c 'chinese-cns11643-1)
(map-charset-chars #'modify-category-entry c ?C #x4421 #x7E7E)
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 3f3ac6064a..65ba2370fc 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -1268,7 +1268,7 @@
:short-name "CNS11643-15"
:long-name "CNS11643-15 (Chinese traditional)"
:code-space [33 126 33 126]
- :code-offset #x27A000
+ :code-offset #x28083A ; Right after 'big5-hkscs.
:unify-map "CNS-F")
(unify-charset 'chinese-gb2312)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 6a17d18c45..ba67cce841 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -181,7 +181,9 @@ When t (by default), signal an error when no more matches
are found.
Then after repeating the search, wrap with `isearch-wrap-function'.
When `no', wrap immediately after reaching the last match.
When `no-ding', wrap immediately without flashing the screen.
-When nil, never wrap, just stop at the last match."
+When nil, never wrap, just stop at the last match.
+With the values `no' and `no-ding' the search will try
+to wrap around also on typing a character."
:type '(choice (const :tag "Pause before wrapping" t)
(const :tag "No pause before wrapping" no)
(const :tag "No pause and no flashing" no-ding)
@@ -880,6 +882,7 @@ matches literally, against one space. You can toggle the
value of this
variable by the command `isearch-toggle-lax-whitespace', usually bound to
`M-s SPC' during isearch."
:type 'boolean
+ :group 'isearch
:version "25.1")
(defvar isearch-regexp-lax-whitespace nil
@@ -1179,6 +1182,7 @@ Each element of the list should be one of the symbols
supported by
`isearch-forward-thing-at-point' to yank the initial \"thing\"
as text to the search string."
:type '(repeat (symbol :tag "Thing symbol"))
+ :group 'isearch
:version "28.1")
(defun isearch-forward-thing-at-point ()
@@ -2525,10 +2529,11 @@ If no input items have been entered yet, just beep."
(ding)
(isearch-pop-state))
;; When going back to the hidden match, reopen it and close other overlays.
- (when (and (eq search-invisible 'open) isearch-hide-immediately)
+ (when (and (eq isearch-invisible 'open) isearch-hide-immediately)
(if isearch-other-end
- (isearch-range-invisible (min (point) isearch-other-end)
- (max (point) isearch-other-end))
+ (let ((search-invisible isearch-invisible))
+ (isearch-range-invisible (min (point) isearch-other-end)
+ (max (point) isearch-other-end)))
(isearch-close-unnecessary-overlays (point) (point))))
(isearch-update))
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index c1371308d4..18f980df97 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -327,15 +327,14 @@ Replaces the From line with a \"Mail-from\" header. Adds
\"Date\" and
"Date: \\2, \\4 \\3 \\9 \\5 "
;; The timezone could be matched by group 7 or group 10.
- ;; If neither of them matched, assume EST, since only
- ;; Easterners would be so sloppy.
+ ;; If neither matched, use "-0000" for an unknown zone.
;; It's a shame the substitution can't use "\\10".
(cond
((/= (match-beginning 7) (match-end 7)) "\\7")
((/= (match-beginning 10) (match-end 10))
(buffer-substring (match-beginning 10)
(match-end 10)))
- (t "EST"))
+ (t "-0000"))
"\n"))
;; Keep and reformat the sender if we don't
;; have a From: field.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 6e42296e7b..7a720cf2c0 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1474,7 +1474,10 @@ when the buffer's text is already an exact match."
(if (and (eq this-command last-command) completion-auto-help)
(minibuffer-completion-help beg end))
(completion--done completion 'exact
- (unless expect-exact
+ (unless (or expect-exact
+ (and completion-auto-select
+ (eq this-command last-command)
+ completion-auto-help))
"Complete, but not unique"))))
(minibuffer--bitset completed t exact))))))))
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 6e3845aec1..f828ccfc1b 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -128,10 +128,7 @@ key exchange is against man-in-the-middle attacks.)
A value of nil says to use the default GnuTLS value.
-The default value of this variable is such that virtually any
-connection can be established, whether this connection can be
-considered cryptographically \"safe\" or not. However, Emacs
-network security is handled at a higher level via
+Emacs network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
@@ -265,6 +262,7 @@ For the meaning of the rest of the parameters, see
`gnutls-boot-parameters'."
&key type hostname priority-string
trustfiles crlfiles keylist min-prime-bits
verify-flags verify-error verify-hostname-error
+ pass flags
&allow-other-keys)
"Return a keyword list of parameters suitable for passing to `gnutls-boot'.
@@ -281,6 +279,13 @@ default.
VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
putting `:hostname' in VERIFY-ERROR.
+PASS is a string, the password of the key. It may also be nil,
+for a NULL password.
+
+FLAGS is a list of symbols corresponding to the equivalent ORed
+bitflag of the gnutls_pkcs_encrypt_flags_t enum of GnuTLS. The
+empty list corresponds to the bitflag with value 0.
+
When VERIFY-ERROR is t or a list containing `:trustfiles', an
error will be raised when the peer certificate verification fails
as per GnuTLS' gnutls_certificate_verify_peers2. Otherwise, only
@@ -358,6 +363,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:keylist ,keylist
:verify-flags ,verify-flags
:verify-error ,verify-error
+ :pass ,pass
+ :flags ,flags
:callbacks nil)))
(defun gnutls--get-files (files)
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index af196ccecf..2a87742fdf 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1623,7 +1623,7 @@ Sat, 07 Sep 2002 00:00:01 GMT
":\\([0-9]\\{2\\}\\)"
;; second
"\\(:\\([0-9]\\{2\\}\\)\\)?"
- ;; zone -- fixme
+ ;; zone
"\\(\\s-+\\("
"UT\\|GMT\\|EST\\|EDT\\|CST\\|CDT\\|MST\\|MDT\\|PST\\|PDT"
"\\|\\([-+]\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)"
@@ -1642,16 +1642,26 @@ Sat, 07 Sep 2002 00:00:01 GMT
(offset-hour (read (or (match-string 14 rfc822-string)
"0")))
(offset-minute (read (or (match-string 15 rfc822-string)
- "0")))
- ;;FIXME
- )
+ "0"))))
(when zone
(cond ((string= sign "+")
(setq hour (- hour offset-hour))
(setq minute (- minute offset-minute)))
((string= sign "-")
(setq hour (+ hour offset-hour))
- (setq minute (+ minute offset-minute)))))
+ (setq minute (+ minute offset-minute)))
+ ((or (string= zone "UT") (string= zone "GMT"))
+ nil)
+ ((string= zone "EDT")
+ (setq hour (+ hour 4)))
+ ((or (string= zone "EST") (string= zone "CDT"))
+ (setq hour (+ hour 5)))
+ ((or (string= zone "CST") (string= zone "MDT"))
+ (setq hour (+ hour 6)))
+ ((or (string= zone "MST") (string= zone "PDT"))
+ (setq hour (+ hour 7)))
+ ((string= zone "PST")
+ (setq hour (+ hour 8)))))
(condition-case error-data
(let ((i 1))
(dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e39c9ccc31..acbd50dc0f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5439,7 +5439,7 @@ Wait, until the connection buffer changes."
;; Hide message in buffer.
(narrow-to-region (point-max) (point-max))
;; Wait for new output.
- (while (not (tramp-compat-ignore-error 'file-error
+ (while (not (tramp-compat-ignore-error file-error
(tramp-wait-for-regexp
proc 0.1 tramp-security-key-confirmed-regexp)))
(when (tramp-check-for-regexp proc tramp-security-key-timeout-regexp)
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index f69538f78c..c2a3673752 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -2464,7 +2464,11 @@ INFO may provide the values of these header arguments
(in the
(cons 'unordered
(mapcar
(lambda (e)
- (list (if (stringp e) e (format "%S" e))))
+ (cond
+ ((stringp e) (list e))
+ ((listp e)
+ (mapcar (lambda (x) (format "%S" x)) e))
+ (t (list (format "%S" e)))))
(if (listp result) result
(split-string result "\n" t))))
'(:splicep nil :istart "- " :iend "\n")))
@@ -3183,8 +3187,8 @@ situations in which is it not appropriate."
(if (and (memq (string-to-char cell) '(?\( ?`))
(not (org-babel-confirm-evaluate
;; See `org-babel-get-src-block-info'.
- (list "emacs-lisp" (format "%S" cell)
- '((:eval . yes)) nil (format "%S" cell)
+ (list "emacs-lisp" cell
+ '((:eval . yes)) nil (format "%s" cell)
nil nil))))
;; Not allowed.
(user-error "Evaluation of elisp code %S aborted." cell)
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index bd17bda32b..fd6b6f3b94 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -500,7 +500,8 @@ The PARAMS are the 3rd element of the info for the same src
block."
(cl-letf (((symbol-function 'org-store-link-functions)
(lambda () nil)))
(org-store-link nil))))
- (bare (and (string-match org-link-bracket-re l)
+ (bare (and l
+ (string-match org-link-bracket-re l)
(match-string 1 l))))
(when bare
(if (and org-babel-tangle-use-relative-file-links
diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el
index 3ef7a37e3b..01e314bfdb 100644
--- a/lisp/org/oc-basic.el
+++ b/lisp/org/oc-basic.el
@@ -162,17 +162,17 @@ Return a hash table with citation references as keys and
fields alist as values.
(puthash (cdr (assq 'id item))
(mapcar (pcase-lambda (`(,field . ,value))
(pcase field
- ('author
- ;; Author is an array of objects, each
- ;; of them designing a person. These
- ;; objects may contain multiple
- ;; properties, but for this basic
- ;; processor, we'll focus on `given' and
- ;; `family'.
+ ((or 'author 'editors)
+ ;; Author and editors are arrays of
+ ;; objects, each of them designing a
+ ;; person. These objects may contain
+ ;; multiple properties, but for this
+ ;; basic processor, we'll focus on
+ ;; `given' and `family'.
;;
;; For compatibility with BibTeX, add
- ;; "and" between authors.
- (cons 'author
+ ;; "and" between authors and editors.
+ (cons field
(mapconcat
(lambda (alist)
(concat (alist-get 'family alist)
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 230937c4e6..ace1cc1a98 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -1365,7 +1365,16 @@ Assume point is at beginning of the inline task."
(priority (and (looking-at "\\[#.\\][ \t]*")
(progn (goto-char (match-end 0))
(aref (match-string 0) 2))))
- (title-start (point))
+ (commentedp
+ (and (let ((case-fold-search nil))
+ (looking-at org-element-comment-string))
+ (goto-char (match-end 0))
+ (when (looking-at-p "\\(?:[ \t]\\|$\\)")
+ (point))))
+ (title-start (prog1 (point)
+ (unless (or todo priority commentedp)
+ ;; Headline like "* :tag:"
+ (skip-chars-backward " \t"))))
(tags (when (re-search-forward
"[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
@@ -1375,6 +1384,7 @@ Assume point is at beginning of the inline task."
(title-end (point))
(raw-value (org-trim
(buffer-substring-no-properties title-start title-end)))
+ (archivedp (member org-element-archive-tag tags))
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-element-headline-re limit t)
@@ -1410,7 +1420,9 @@ Assume point is at beginning of the inline task."
:todo-keyword todo
:todo-type todo-type
:post-blank (1- (count-lines (or task-end begin) end))
- :post-affiliated begin)
+ :post-affiliated begin
+ :archivedp archivedp
+ :commentedp commentedp)
time-props
standard-props))))
(org-element-put-property
diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el
index 6ccf357784..60291e5187 100644
--- a/lisp/org/org-persist.el
+++ b/lisp/org/org-persist.el
@@ -874,15 +874,21 @@ When IGNORE-RETURN is non-nil, just return t on success
without calling
When ASSOCIATED is non-nil, only save the matching data."
(unless org-persist--index (org-persist--load-index))
(setq associated (org-persist--normalize-associated associated))
- (unless
+ (if
(and (equal 1 (length org-persist--index))
;; The single collection only contains a single container
;; in the container list.
(equal 1 (length (plist-get (car org-persist--index) :container)))
;; The container is an `index' container.
(eq 'index (caar (plist-get (car org-persist--index) :container)))
- ;; No `org-persist-directory' exists yet.
- (not (file-exists-p org-persist-directory)))
+ (or (not (file-exists-p org-persist-directory))
+ (org-directory-empty-p org-persist-directory)))
+ ;; Do not write anything, and clear up `org-persist-directory' to reduce
+ ;; clutter.
+ (when (and (file-exists-p org-persist-directory)
+ (org-directory-empty-p org-persist-directory))
+ (delete-directory org-persist-directory))
+ ;; Write the data.
(let (all-containers)
(dolist (collection org-persist--index)
(if associated
@@ -963,6 +969,30 @@ Also, remove containers associated with non-existing
files."
(push collection new-index)))))
(setq org-persist--index (nreverse new-index))))
+(defun org-persist-clear-storage-maybe ()
+ "Clear `org-persist-directory' according to
`org-persist--disable-when-emacs-Q'.
+
+When `org-persist--disable-when-emacs-Q' is non-nil and Emacs is called with -Q
+command line argument, `org-persist-directory' is created in potentially public
+system temporary directory. Remove everything upon existing Emacs in
+such scenario."
+ (when (and org-persist--disable-when-emacs-Q
+ ;; FIXME: This is relying on undocumented fact that
+ ;; Emacs sets `user-init-file' to nil when loaded with
+ ;; "-Q" argument.
+ (not user-init-file)
+ (file-exists-p org-persist-directory))
+ (delete-directory org-persist-directory 'recursive)))
+
+;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set.
+(when (and org-persist--disable-when-emacs-Q
+ ;; FIXME: This is relying on undocumented fact that
+ ;; Emacs sets `user-init-file' to nil when loaded with
+ ;; "-Q" argument.
+ (not user-init-file))
+ (setq org-persist-directory
+ (make-temp-file "org-persist-" 'dir)))
+
;; Automatically write the data, but only when we have write access.
(let ((dir (directory-file-name
(file-name-as-directory org-persist-directory))))
@@ -972,20 +1002,12 @@ Also, remove containers associated with non-existing
files."
(if (not (file-writable-p dir))
(message "Missing write access rights to org-persist-directory: %S"
org-persist-directory)
+ (add-hook 'kill-emacs-hook #'org-persist-clear-storage-maybe) ; Run last.
(add-hook 'kill-emacs-hook #'org-persist-write-all)
;; `org-persist-gc' should run before `org-persist-write-all'.
;; So we are adding the hook after `org-persist-write-all'.
(add-hook 'kill-emacs-hook #'org-persist-gc)))
-;; Point to temp directory when `org-persist--disable-when-emacs-Q' is set.
-(if (and org-persist--disable-when-emacs-Q
- ;; FIXME: This is relying on undocumented fact that
- ;; Emacs sets `user-init-file' to nil when loaded with
- ;; "-Q" argument.
- (not user-init-file))
- (setq org-persist-directory
- (make-temp-file "org-persist-" 'dir)))
-
(add-hook 'after-init-hook #'org-persist-load-all)
(provide 'org-persist)
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index 8de0d1a4a9..a0016265f0 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -11,7 +11,7 @@ Inserted by installing Org mode or when a release is made."
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.6-49-g47d129"))
+ (let ((org-git-version "release_9.6-61-g63e073f"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 6aa2a16219..ab8b76b926 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -20213,7 +20213,10 @@ interactive command with similar behavior."
(defun org-back-to-heading (&optional invisible-ok)
"Go back to beginning of heading."
(beginning-of-line)
- (or (org-at-heading-p (not invisible-ok))
+ (or (and (org-at-heading-p (not invisible-ok))
+ (not (and (featurep 'org-inlinetask)
+ (fboundp 'org-inlinetask-end-p)
+ (org-inlinetask-end-p))))
(if (org-element--cache-active-p)
(let ((heading (org-element-lineage (org-element-at-point)
'(headline inlinetask)
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index 86b10cbf78..19cdf4c5a2 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -3337,7 +3337,7 @@ INFO is a plist holding contextual information. See
((org-html-standalone-image-p destination info)
(org-export-get-ordinal
(org-element-map destination 'link #'identity info t)
- info 'link 'org-html-standalone-image-p))
+ info '(link) 'org-html-standalone-image-p))
(t (org-export-get-ordinal
destination info nil counter-predicate))))
(desc
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 4e3a88bbda..2d3730e294 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -645,13 +645,26 @@ parts of the list.
The OFFSET argument is added to/taken away from the index that will be
used. This is really only useful with `first' and `last', for
-accessing absolute argument positions."
- (nth (+ (pcase index
- ('first 0)
- ('last pcomplete-last)
- (_ (- pcomplete-index (or index 0))))
- (or offset 0))
- pcomplete-args))
+accessing absolute argument positions.
+
+When the argument has been transformed into something that is not
+a string by `pcomplete-parse-arguments-function', the text
+representation of the argument, namely what the user actually
+typed in, is returned, and the value of the argument is stored in
+the pcomplete-arg-value text property of that string."
+ (let ((arg
+ (nth (+ (pcase index
+ ('first 0)
+ ('last pcomplete-last)
+ (_ (- pcomplete-index (or index 0))))
+ (or offset 0))
+ pcomplete-args)))
+ (if (stringp arg)
+ arg
+ (propertize
+ (buffer-substring (pcomplete-begin index offset)
+ (pcomplete-begin (1- (or index 0)) offset))
+ 'pcomplete-arg-value arg))))
(defun pcomplete-begin (&optional index offset)
"Return the beginning position of the INDEXth argument.
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index 6f7056864f..972a4d5aa5 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -39,6 +39,8 @@
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-type "treesit.c")
+;;; Custom variables
+
(defcustom c-ts-mode-indent-offset 2
"Number of spaces for each indentation step in `c-ts-mode'."
:version "29.1"
@@ -61,6 +63,8 @@ follows the form of `treesit-simple-indent-rules'."
(function :tag "A function for user customized style" ignore))
:group 'c)
+;;; Syntax table
+
(defvar c-ts-mode--syntax-table
(let ((table (make-syntax-table)))
;; Taken from the cc-langs version
@@ -83,13 +87,29 @@ follows the form of `treesit-simple-indent-rules'."
table)
"Syntax table for `c-ts-mode'.")
-(defvar c++-ts-mode--syntax-table
- (let ((table (make-syntax-table c-ts-mode--syntax-table)))
- ;; Template delimiters.
- (modify-syntax-entry ?< "(" table)
- (modify-syntax-entry ?> ")" table)
- table)
- "Syntax table for `c++-ts-mode'.")
+(defun c-ts-mode--syntax-propertize (beg end)
+ "Apply syntax text property to template delimiters between BEG and END.
+
+< and > are usually punctuation, e.g., in ->. But when used for
+templates, they should be considered pairs.
+
+This function checks for < and > in the changed RANGES and apply
+appropriate text property to alter the syntax of template
+delimiters < and >'s."
+ (goto-char beg)
+ (while (re-search-forward (rx (or "<" ">")) end t)
+ (pcase (treesit-node-type
+ (treesit-node-parent
+ (treesit-node-at (match-beginning 0))))
+ ("template_argument_list"
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'syntax-table
+ (pcase (char-before)
+ (?< '(4 . ?>))
+ (?> '(5 . ?<))))))))
+
+;;; Indent
(defun c-ts-mode--indent-styles (mode)
"Indent rules supported by `c-ts-mode'.
@@ -98,11 +118,13 @@ MODE is either `c' or `cpp'."
`(((parent-is "translation_unit") parent-bol 0)
((node-is ")") parent 1)
((node-is "]") parent-bol 0)
- ((node-is "}") (and parent parent-bol) 0)
+ ((node-is "}") c-ts-mode--bracket-children-anchor 0)
((node-is "else") parent-bol 0)
((node-is "case") parent-bol 0)
((node-is "preproc_arg") no-indent)
- ((and (parent-is "comment") comment-end) comment-start -1)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((node-is "labeled_statement") parent-bol 0)
((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset)
((match "preproc_ifdef" "compound_statement") point-min 0)
@@ -111,7 +133,8 @@ MODE is either `c' or `cpp'."
((match "#endif" "preproc_if") point-min 0)
((match "preproc_function_def" "compound_statement") point-min 0)
((match "preproc_call" "compound_statement") point-min 0)
- ((parent-is "compound_statement") (and parent parent-bol)
c-ts-mode-indent-offset)
+ ((parent-is "compound_statement")
+ c-ts-mode--bracket-children-anchor c-ts-mode-indent-offset)
((parent-is "function_definition") parent-bol 0)
((parent-is "conditional_expression") first-sibling 0)
((parent-is "assignment_expression") parent-bol
c-ts-mode-indent-offset)
@@ -167,6 +190,39 @@ MODE is either `c' or `cpp'."
('linux (alist-get 'linux (c-ts-mode--indent-styles mode)))))))
`((,mode ,@style))))
+(defun c-ts-mode--bracket-children-anchor (_n parent &rest _)
+ "This anchor is used for children of a compound_statement.
+So anything inside a {} block. PARENT should be the
+compound_statement. This anchor looks at the {, if itson its own
+line, anchor at it, if it has stuff before it, anchor at the
+beginning of grandparent."
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (let ((bol (line-beginning-position)))
+ (skip-chars-backward " \t")
+ (treesit-node-start
+ (if (< bol (point))
+ (treesit-node-parent parent)
+ parent)))))
+
+(defun c-ts-mode--looking-at-star (&rest _)
+ "A tree-sitter simple indent matcher.
+Matches if there is a \"*\" after point (ignoring whitespace in
+between)."
+ (looking-at (rx (* (syntax whitespace)) "*")))
+
+(defun c-ts-mode--comment-start-after-first-star (_n parent &rest _)
+ "A tree-sitter simple indent anchor.
+Finds the \"/*\" and returns the point after the \"*\".
+Assumes PARENT is a comment node."
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (if (looking-at (rx "/*"))
+ (match-end 0)
+ (point))))
+
+;;; Font-lock
+
(defvar c-ts-mode--preproc-keywords
'("#define" "#if" "#ifdef" "#ifndef"
"#else" "#elif" "#endif" "#include")
@@ -361,28 +417,34 @@ MODE is either `c' or `cpp'."
@c-ts-mode--fontify-defun)
(:match "^DEFUN$" @fn)))))
-(defun c-ts-mode--fontify-declarator (node override start end &rest args)
- "Fontify a declarator (whatever under the \"declarator\" field).
-For NODE, OVERRIDE, START, END, and ARGS, see
-`treesit-font-lock-rules'."
+;;; Font-lock helpers
+
+(defun c-ts-mode--declarator-identifier (node)
+ "Return the identifier of the declarator node NODE."
(pcase (treesit-node-type node)
+ ;; Recurse.
((or "attributed_declarator" "parenthesized_declarator")
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child node 0 t) override start end args))
+ (c-ts-mode--declarator-identifier (treesit-node-child node 0 t)))
("pointer_declarator"
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child node -1) override start end args))
+ (c-ts-mode--declarator-identifier (treesit-node-child node -1)))
((or "function_declarator" "array_declarator" "init_declarator")
- (apply #'c-ts-mode--fontify-declarator
- (treesit-node-child-by-field-name node "declarator")
- override start end args))
+ (c-ts-mode--declarator-identifier
+ (treesit-node-child-by-field-name node "declarator")))
+ ;; Terminal case.
((or "identifier" "field_identifier")
- (treesit-fontify-with-override
- (treesit-node-start node) (treesit-node-end node)
- (pcase (treesit-node-type (treesit-node-parent node))
- ("function_declarator" 'font-lock-function-name-face)
- (_ 'font-lock-variable-name-face))
- override start end))))
+ node)))
+
+(defun c-ts-mode--fontify-declarator (node override start end &rest _args)
+ "Fontify a declarator (whatever under the \"declarator\" field).
+For NODE, OVERRIDE, START, END, and ARGS, see
+`treesit-font-lock-rules'."
+ (let* ((identifier (c-ts-mode--declarator-identifier node))
+ (face (pcase (treesit-node-type (treesit-node-parent identifier))
+ ("function_declarator" 'font-lock-function-name-face)
+ (_ 'font-lock-variable-name-face))))
+ (treesit-fontify-with-override
+ (treesit-node-start identifier) (treesit-node-end identifier)
+ face override start end)))
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
@@ -453,94 +515,48 @@ For NODE, OVERRIDE, START, and END, see
(t 'font-lock-warning-face))
override start end)))
-(defun c-ts-mode--imenu-1 (node)
- "Helper for `c-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'c-ts-mode--imenu-1 (cdr node)))
- (name (when ts-node
- (treesit-node-text
- (pcase (treesit-node-type ts-node)
- ("function_definition"
- (treesit-node-child-by-field-name
- (treesit-node-child-by-field-name
- ts-node "declarator")
- "declarator"))
- ("declaration"
- (let ((child (treesit-node-child ts-node -1 t)))
- (pcase (treesit-node-type child)
- ("identifier" child)
- (_ (treesit-node-child-by-field-name
- child "declarator")))))
- ("struct_specifier"
- (treesit-node-child-by-field-name
- ts-node "name"))))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ;; A struct_specifier could be inside a parameter list, another
- ;; struct definition, a variable declaration, a function
- ;; declaration. In those cases we don't include it.
- ((string-match-p
- (rx (or "parameter_declaration" "field_declaration"
- "declaration" "function_definition"))
- (or (treesit-node-type (treesit-node-parent ts-node))
- ""))
- nil)
- ;; Ignore function local variable declarations.
- ((and (equal (treesit-node-type ts-node) "declaration")
- (not (equal (treesit-node-type (treesit-node-parent ts-node))
- "translation_unit")))
- nil)
- ((or (null ts-node) (null name)) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun c-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (func-tree (treesit-induce-sparse-tree
- node "^function_definition$" nil 1000))
- (var-tree (treesit-induce-sparse-tree
- node "^declaration$" nil 1000))
- (struct-tree (treesit-induce-sparse-tree
- node "^struct_specifier$" nil 1000))
- (func-index (c-ts-mode--imenu-1 func-tree))
- (var-index (c-ts-mode--imenu-1 var-tree))
- (struct-index (c-ts-mode--imenu-1 struct-tree)))
- (append
- (when struct-index `(("Struct" . ,struct-index)))
- (when var-index `(("Variable" . ,var-index)))
- (when func-index `(("Function" . ,func-index))))))
-
-(defun c-ts-mode--end-of-defun ()
- "`end-of-defun-function' of `c-ts-mode'."
- ;; A struct/enum/union_specifier node doesn't include the ; at the
- ;; end, so we manually skip it.
- (treesit-end-of-defun)
- (when (looking-at (rx (* " ") ";"))
- (goto-char (match-end 0))
- ;; This part is copied from `end-of-defun'.
- (unless (bolp)
- (skip-chars-forward " \t")
- (if (looking-at "\\s<\\|\n")
- (forward-line 1)))))
+;;; Imenu
+
+(defun c-ts-mode--defun-name (node)
+ "Return the name of the defun NODE.
+Return nil if NODE is not a defun node or doesn't have a name."
+ (treesit-node-text
+ (pcase (treesit-node-type node)
+ ((or "function_definition" "declaration")
+ (c-ts-mode--declarator-identifier
+ (treesit-node-child-by-field-name node "declarator")))
+ ((or "struct_specifier" "enum_specifier"
+ "union_specifier" "class_specifier")
+ (treesit-node-child-by-field-name node "name")))
+ t))
+
+;;; Defun navigation
(defun c-ts-mode--defun-valid-p (node)
- (if (string-match-p
- (rx (or "struct_specifier"
- "enum_specifier"
- "union_specifier"))
- (treesit-node-type node))
- (null
- (treesit-node-top-level
- node (rx (or "function_definition"
- "type_definition"))))
- t))
+ "Return non-nil if NODE is a valid defun node.
+Ie, NODE is not nested."
+ (not (or (and (member (treesit-node-type node)
+ '("struct_specifier"
+ "enum_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"
+ "union_specifier"
+ "declaration"))))
+
+ (and (equal (treesit-node-type node) "declaration")
+ ;; If NODE is a declaration, make sure it is not a
+ ;; function declaration.
+ (equal (treesit-node-type
+ (treesit-node-child-by-field-name
+ node "declarator"))
+ "function_declarator")))))
(defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends.
@@ -562,6 +578,140 @@ the semicolon. This function skips the semicolon."
(treesit-node-end node))
(goto-char orig-point)))
+;;; Filling
+
+(defun c-ts-mode--fill-paragraph (&optional arg)
+ "Fillling function for `c-ts-mode'.
+ARG is passed to `fill-paragraph'."
+ (interactive "*P")
+ (save-restriction
+ (widen)
+ (let* ((node (treesit-node-at (point)))
+ (start (treesit-node-start node))
+ (end (treesit-node-end node))
+ ;; Bind to nil to avoid infinite recursion.
+ (fill-paragraph-function nil)
+ (orig-point (point-marker))
+ (start-marker nil)
+ (end-marker nil)
+ (end-len 0))
+ ;; These covers C/C++, Java, JavaScript, TypeScript, Rust, C#.
+ (when (member (treesit-node-type node)
+ '("comment" "line_comment" "block_comment"))
+ ;; We mask "/*" and the space before "*/" like
+ ;; `c-fill-paragraph' does.
+ (atomic-change-group
+ ;; Mask "/*".
+ (goto-char start)
+ (when (looking-at (rx (* (syntax whitespace))
+ (group "/") "*"))
+ (goto-char (match-beginning 1))
+ (setq start-marker (point-marker))
+ (replace-match " " nil nil nil 1))
+ ;; Include whitespaces before /*.
+ (goto-char start)
+ (beginning-of-line)
+ (setq start (point))
+ ;; Mask spaces before "*/" if it is attached at the end
+ ;; of a sentence rather than on its own line.
+ (goto-char end)
+ (when (looking-back (rx (not (syntax whitespace))
+ (group (+ (syntax whitespace)))
+ "*/")
+ (line-beginning-position))
+ (goto-char (match-beginning 1))
+ (setq end-marker (point-marker))
+ (setq end-len (- (match-end 1) (match-beginning 1)))
+ (replace-match (make-string end-len ?x)
+ nil nil nil 1))
+ ;; If "*/" is on its own line, don't included it in the
+ ;; filling region.
+ (when (not end-marker)
+ (goto-char end)
+ (when (looking-back (rx "*/") 2)
+ (backward-char 2)
+ (skip-syntax-backward "-")
+ (setq end (point))))
+ ;; Let `fill-paragraph' do its thing.
+ (goto-char orig-point)
+ (narrow-to-region start end)
+ (funcall #'fill-paragraph arg)
+ ;; Unmask.
+ (when start-marker
+ (goto-char start-marker)
+ (delete-char 1)
+ (insert "/"))
+ (when end-marker
+ (goto-char end-marker)
+ (delete-region (point) (+ end-len (point)))
+ (insert (make-string end-len ?\s))))
+ (goto-char orig-point))
+ ;; Return t so `fill-paragraph' doesn't attempt to fill by
+ ;; itself.
+ t)))
+
+(defun c-ts-mode-comment-setup ()
+ "Set up local variables for C-like comment.
+
+Set up:
+ - `comment-start'
+ - `comment-end'
+ - `comment-start-skip'
+ - `comment-end-skip'
+ - `adaptive-fill-mode'
+ - `adaptive-fill-first-line-regexp'
+ - `paragraph-start'
+ - `paragraph-separate'
+ - `fill-paragraph-function'"
+ (setq-local comment-start "// ")
+ (setq-local comment-end "")
+ (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
+ (seq "/" (+ "*")))
+ (* (syntax whitespace))))
+ (setq-local comment-end-skip
+ (rx (* (syntax whitespace))
+ (group (or (syntax comment-end)
+ (seq (+ "*") "/")))))
+ (setq-local adaptive-fill-mode t)
+ ;; This matches (1) empty spaces (the default), (2) "//", (3) "*",
+ ;; but do not match "/*", because we don't want to use "/*" as
+ ;; prefix when filling. (Actually, it doesn't matter, because
+ ;; `comment-start-skip' matches "/*" which will cause
+ ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's
+ ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.)
+ (setq-local adaptive-fill-regexp
+ (concat (rx (* (syntax whitespace))
+ (group (or (seq "/" (+ "/")) (* "*"))))
+ adaptive-fill-regexp))
+ ;; Note the missing * comparing to `adaptive-fill-regexp'. The
+ ;; reason for its absence is a bit convoluted to explain. Suffice
+ ;; to say that without it, filling a single line paragraph that
+ ;; starts with /* doesn't insert * at the beginning of each
+ ;; following line, and filling a multi-line paragraph whose first
+ ;; two lines start with * does insert * at the beginning of each
+ ;; following line. If you know how does adaptive filling works, you
+ ;; know what I mean.
+ (setq-local adaptive-fill-first-line-regexp
+ (rx bos
+ (seq (* (syntax whitespace))
+ (group (seq "/" (+ "/")))
+ (* (syntax whitespace)))
+ eos))
+ ;; Same as `adaptive-fill-regexp'.
+ (setq-local paragraph-start
+ (rx (or (seq (* (syntax whitespace))
+ (group (or (seq "/" (+ "/")) (* "*")))
+ (* (syntax whitespace))
+ ;; Add this eol so that in
+ ;; `fill-context-prefix', `paragraph-start'
+ ;; doesn't match the prefix.
+ eol)
+ "\f")))
+ (setq-local paragraph-separate paragraph-start)
+ (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph))
+
+;;; Modes
+
(defvar-keymap c-ts-mode-map
:doc "Keymap for the C language with tree-sitter"
:parent prog-mode-map
@@ -584,6 +734,7 @@ the semicolon. This function skips the semicolon."
"class_specifier"))
#'c-ts-mode--defun-valid-p))
(setq-local treesit-defun-skipper #'c-ts-mode--defun-skipper)
+ (setq-local treesit-defun-name-function #'c-ts-mode--defun-name)
;; Nodes like struct/enum/union_specifier can appear in
;; function_definitions, so we need to find the top-level node.
@@ -593,13 +744,25 @@ the semicolon. This function skips the semicolon."
(when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t))
+ ;; Comment
+ (c-ts-mode-comment-setup)
+
;; Electric
(setq-local electric-indent-chars
(append "{}():;," electric-indent-chars))
;; Imenu.
- (setq-local imenu-create-index-function #'c-ts-mode--imenu)
- (setq-local which-func-functions nil)
+ (setq-local treesit-simple-imenu-settings
+ (let ((pred #'c-ts-mode--defun-valid-p))
+ `(("Struct" ,(rx bos (or "struct" "enum" "union")
+ "_specifier" eos)
+ ,pred nil)
+ ("Variable" ,(rx bos "declaration" eos) ,pred nil)
+ ("Function" "\\`function_definition\\'" ,pred nil)
+ ("Class" ,(rx bos (or "class_specifier"
+ "function_definition")
+ eos)
+ ,pred nil))))
(setq-local treesit-font-lock-feature-list
'(( comment definition)
@@ -620,13 +783,6 @@ the semicolon. This function skips the semicolon."
;; Comments.
(setq-local comment-start "/* ")
(setq-local comment-end " */")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
(setq-local treesit-simple-indent-rules
(c-ts-mode--set-indent-style 'c))
@@ -634,37 +790,23 @@ the semicolon. This function skips the semicolon."
;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
- (treesit-major-mode-setup)
-
- ;; Override default value of end-of-defun-function set by
- ;; `treesit-major-mode-setup'.
- (setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
+ (treesit-major-mode-setup))
;;;###autoload
(define-derived-mode c++-ts-mode c-ts-base-mode "C++"
"Major mode for editing C++, powered by tree-sitter."
:group 'c++
- :syntax-table c++-ts-mode--syntax-table
(unless (treesit-ready-p 'cpp)
(error "Tree-sitter for C++ isn't available"))
- ;; Comments.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
-
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
"raw_string_literal")))
(treesit-parser-create 'cpp)
+ (setq-local syntax-propertize-function
+ #'c-ts-mode--syntax-propertize)
(setq-local treesit-simple-indent-rules
(c-ts-mode--set-indent-style 'cpp))
@@ -672,11 +814,7 @@ the semicolon. This function skips the semicolon."
;; Font-lock.
(setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp))
- (treesit-major-mode-setup)
-
- ;; Override default value of end-of-defun-function set by
- ;; `treesit-major-mode-setup'.
- (setq-local end-of-defun-function #'c-ts-mode--end-of-defun))
+ (treesit-major-mode-setup))
(provide 'c-ts-mode)
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 9e8b22c6ab..33a5f7046f 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -34,6 +34,7 @@
(require 'cc-mode)
(require 'cc-langs)
(require 'treesit)
+(require 'c-ts-mode) ; For comment indenting and filling.
(eval-when-compile
(require 'cc-fonts)
@@ -42,6 +43,7 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defgroup csharp nil
@@ -632,6 +634,9 @@ compilation and evaluation time conflicts."
((node-is "}") parent-bol 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "namespace_declaration") parent-bol 0)
((parent-is "class_declaration") parent-bol 0)
((parent-is "constructor_declaration") parent-bol 0)
@@ -837,56 +842,21 @@ compilation and evaluation time conflicts."
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
-(defun csharp-ts-mode--imenu-1 (node)
- "Helper for `csharp-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'csharp-ts-mode--imenu-1 (cdr node)))
- (name (when ts-node
- (or (treesit-node-text
- (or (treesit-node-child-by-field-name
- ts-node "name"))
- t)
- "Unnamed node")))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((null ts-node) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun csharp-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (class-tree (treesit-induce-sparse-tree
- node "^class_declaration$" nil 1000))
- (interface-tree (treesit-induce-sparse-tree
- node "^interface_declaration$" nil 1000))
- (enum-tree (treesit-induce-sparse-tree
- node "^enum_declaration$" nil 1000))
- (struct-tree (treesit-induce-sparse-tree
- node "^struct_declaration$" nil 1000))
- (record-tree (treesit-induce-sparse-tree
- node "^record_declaration$" nil 1000))
- (method-tree (treesit-induce-sparse-tree
- node "^method_declaration$" nil 1000))
- (class-index (csharp-ts-mode--imenu-1 class-tree))
- (interface-index (csharp-ts-mode--imenu-1 interface-tree))
- (enum-index (csharp-ts-mode--imenu-1 enum-tree))
- (record-index (csharp-ts-mode--imenu-1 record-tree))
- (struct-index (csharp-ts-mode--imenu-1 struct-tree))
- (method-index (csharp-ts-mode--imenu-1 method-tree)))
- (append
- (when class-index `(("Class" . ,class-index)))
- (when interface-index `(("Interface" . ,interface-index)))
- (when enum-index `(("Enum" . ,enum-index)))
- (when record-index `(("Record" . ,record-index)))
- (when struct-index `(("Struct" . ,struct-index)))
- (when method-index `(("Method" . ,method-index))))))
+(defun csharp-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "method_declaration"
+ "record_declaration"
+ "struct_declaration"
+ "enum_declaration"
+ "interface_declaration"
+ "class_declaration"
+ "class_declaration")
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "name")
+ t))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
@@ -916,15 +886,7 @@ Key bindings:
(treesit-parser-create 'c-sharp)
;; Comments.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
+ (c-ts-mode-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
@@ -940,6 +902,7 @@ Key bindings:
;; Navigation.
(setq-local treesit-defun-type-regexp "declaration")
+ (setq-local treesit-defun-name-function #'csharp-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings csharp-ts-mode--font-lock-settings)
@@ -950,8 +913,14 @@ Key bindings:
( bracket delimiter)))
;; Imenu.
- (setq-local imenu-create-index-function #'csharp-ts-mode--imenu)
- (setq-local which-func-functions nil) ;; Piggyback on imenu
+ (setq-local treesit-simple-imenu-settings
+ '(("Class" "\\`class_declaration\\'" nil nil)
+ ("Interface" "\\`interface_declaration\\'" nil nil)
+ ("Enum" "\\`enum_declaration\\'" nil nil)
+ ("Record" "\\`record_declaration\\'" nil nil)
+ ("Struct" "\\`struct_declaration\\'" nil nil)
+ ("Method" "\\`method_declaration\\'" nil nil)))
+
(treesit-major-mode-setup))
(provide 'csharp-mode)
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index bd6a8aa474..215b5c1638 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -29,10 +29,12 @@
(require 'treesit)
(eval-when-compile (require 'rx))
+(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom java-ts-mode-indent-offset 4
@@ -71,8 +73,9 @@
((node-is "}") (and parent parent-bol) 0)
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
- ((and (parent-is "comment") comment-end) comment-start -1)
- ((parent-is "comment") comment-start-skip 0)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "text_block") no-indent)
((parent-is "class_body") parent-bol java-ts-mode-indent-offset)
((parent-is "interface_body") parent-bol java-ts-mode-indent-offset)
@@ -248,52 +251,21 @@
'((["," ":" ";"]) @font-lock-delimiter-face))
"Tree-sitter font-lock settings for `java-ts-mode'.")
-(defun java-ts-mode--imenu-1 (node)
- "Helper for `java-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'java-ts-mode--imenu-1 (cdr node)))
- (name (when ts-node
- (or (treesit-node-text
- (or (treesit-node-child-by-field-name
- ts-node "name"))
- t)
- "Unnamed node")))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((null ts-node) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun java-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (class-tree (treesit-induce-sparse-tree
- node "^class_declaration$" nil 1000))
- (interface-tree (treesit-induce-sparse-tree
- node "^interface_declaration$" nil 1000))
- (enum-tree (treesit-induce-sparse-tree
- node "^enum_declaration$" nil 1000))
- (record-tree (treesit-induce-sparse-tree
- node "^record_declaration$" nil 1000))
- (method-tree (treesit-induce-sparse-tree
- node "^method_declaration$" nil 1000))
- (class-index (java-ts-mode--imenu-1 class-tree))
- (interface-index (java-ts-mode--imenu-1 interface-tree))
- (enum-index (java-ts-mode--imenu-1 enum-tree))
- (record-index (java-ts-mode--imenu-1 record-tree))
- (method-index (java-ts-mode--imenu-1 method-tree)))
- (append
- (when class-index `(("Class" . ,class-index)))
- (when interface-index `(("Interface" . ,interface-index)))
- (when enum-index `(("Enum" . ,enum-index)))
- (when record-index `(("Record" . ,record-index)))
- (when method-index `(("Method" . ,method-index))))))
+(defun java-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "method_declaration"
+ "class_declaration"
+ "record_declaration"
+ "interface_declaration"
+ "enum_declaration"
+ "import_declaration"
+ "package_declaration"
+ "module_declaration")
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name")
+ t))))
;;;###autoload
(define-derived-mode java-ts-mode prog-mode "Java"
@@ -307,15 +279,7 @@ the subtrees."
(treesit-parser-create 'java)
;; Comments.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
+ (c-ts-mode-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("line_comment"
@@ -339,6 +303,7 @@ the subtrees."
"import_declaration"
"package_declaration"
"module_declaration")))
+ (setq-local treesit-defun-name-function #'java-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings)
@@ -349,8 +314,11 @@ the subtrees."
( bracket delimiter operator)))
;; Imenu.
- (setq-local imenu-create-index-function #'java-ts-mode--imenu)
- (setq-local which-func-functions nil) ;; Piggyback on imenu
+ (setq-local treesit-simple-imenu-settings
+ '(("Class" "\\`class_declaration\\'" nil nil)
+ ("Interface" "\\`interface_declaration\\'" nil nil)
+ ("Enum" "\\`record_declaration\\'" nil nil)
+ ("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
(provide 'java-ts-mode)
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 15272dcc00..9c26c52df9 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -54,6 +54,7 @@
(require 'json)
(require 'prog-mode)
(require 'treesit)
+(require 'c-ts-mode) ; For comment indent and filling.
(eval-when-compile
(require 'cl-lib)
@@ -73,6 +74,8 @@
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-query-compile "treesit.c")
+(declare-function treesit-query-capture "treesit.c")
;;; Constants
@@ -3425,9 +3428,9 @@ This function is intended for use in
`after-change-functions'."
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is ">") parent-bol 0)
- ((parent-is "comment") comment-start 0)
- ((and (parent-is "comment") comment-end) comment-start -1)
- ((parent-is "comment") comment-start-skip 0)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "ternary_expression") parent-bol js-indent-level)
((parent-is "member_expression") parent-bol js-indent-level)
((node-is ,switch-case) parent-bol 0)
@@ -3478,36 +3481,35 @@ This function is intended for use in
`after-change-functions'."
(treesit-font-lock-rules
:language 'javascript
- :override t
:feature 'comment
- `((comment) @font-lock-comment-face)
+ '((comment) @font-lock-comment-face)
:language 'javascript
- :override t
:feature 'constant
- `(((identifier) @font-lock-constant-face
+ '(((identifier) @font-lock-constant-face
(:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face))
[(true) (false) (null)] @font-lock-constant-face)
:language 'javascript
- :override t
:feature 'keyword
`([,@js--treesit-keywords] @font-lock-keyword-face
[(this) (super)] @font-lock-keyword-face)
:language 'javascript
- :override t
:feature 'string
- `((regex pattern: (regex_pattern)) @font-lock-string-face
- (string) @font-lock-string-face
- (template_string) @js--fontify-template-string
- (template_substitution ["${" "}"] @font-lock-builtin-face))
+ '((regex pattern: (regex_pattern)) @font-lock-string-face
+ (string) @font-lock-string-face)
:language 'javascript
+ :feature 'string-interpolation
:override t
- :feature 'declaration
- `((function
+ '((template_string) @js--fontify-template-string
+ (template_substitution ["${" "}"] @font-lock-delimiter-face))
+
+ :language 'javascript
+ :feature 'definition
+ '((function
name: (identifier) @font-lock-function-name-face)
(class_declaration
@@ -3534,24 +3536,10 @@ This function is intended for use in
`after-change-functions'."
value: (array (number) (function))))
:language 'javascript
- :override t
- :feature 'identifier
- `((new_expression
- constructor: (identifier) @font-lock-type-face)
-
- (for_in_statement
- left: (identifier) @font-lock-variable-name-face)
-
- (arrow_function
- parameter: (identifier) @font-lock-variable-name-face))
-
- :language 'javascript
- :override t
:feature 'property
- ;; This needs to be before function-name feature, because methods
- ;; can be both property and function-name, and we want them in
- ;; function-name face.
- `((property_identifier) @font-lock-property-face
+ '(((property_identifier) @font-lock-property-face
+ (:pred js--treesit-property-not-function-p
+ @font-lock-property-face))
(pair value: (identifier) @font-lock-variable-name-face)
@@ -3560,36 +3548,27 @@ This function is intended for use in
`after-change-functions'."
((shorthand_property_identifier_pattern) @font-lock-property-face))
:language 'javascript
- :override t
- :feature 'expression
- `((assignment_expression
- left: [(identifier) @font-lock-function-name-face
- (member_expression property: (property_identifier)
- @font-lock-function-name-face)]
- right: [(function) (arrow_function)])
-
- (call_expression
+ :feature 'assignment
+ '((assignment_expression
+ left: (_) @js--treesit-fontify-assignment-lhs))
+
+ :language 'javascript
+ :feature 'function
+ '((call_expression
function: [(identifier) @font-lock-function-name-face
(member_expression
property:
(property_identifier) @font-lock-function-name-face)])
-
- (assignment_expression
- left: [(identifier) @font-lock-variable-name-face
- (member_expression
- property: (property_identifier) @font-lock-variable-name-face)]))
-
- :language 'javascript
- :override t
- :feature 'pattern
- `((pair_pattern key: (property_identifier) @font-lock-variable-name-face)
- (array_pattern (identifier) @font-lock-variable-name-face))
+ (method_definition
+ name: (property_identifier) @font-lock-function-name-face)
+ (function_declaration
+ name: (identifier) @font-lock-function-name-face)
+ (function
+ name: (identifier) @font-lock-function-name-face))
:language 'javascript
- :override t
:feature 'jsx
- `(
- (jsx_opening_element
+ '((jsx_opening_element
[(nested_identifier (identifier)) (identifier)]
@font-lock-function-name-face)
@@ -3607,7 +3586,7 @@ This function is intended for use in
`after-change-functions'."
:language 'javascript
:feature 'number
- `((number) @font-lock-number-face
+ '((number) @font-lock-number-face
((identifier) @font-lock-number-face
(:match "^\\(:?NaN\\|Infinity\\)$" @font-lock-number-face)))
@@ -3656,96 +3635,50 @@ OVERRIDE is the override flag described in
(setq font-beg (treesit-node-end child)
child (treesit-node-next-sibling child)))))
-(defun js-treesit-current-defun ()
- "Return name of surrounding function.
-This function can be used as a value in `which-func-functions'"
- (let ((node (treesit-node-at (point)))
- (name-list ()))
- (cl-loop while node
- if (pcase (treesit-node-type node)
- ("function_declaration" t)
- ("method_definition" t)
- ("class_declaration" t)
- ("variable_declarator" t)
- (_ nil))
- do (push (treesit-node-text
- (treesit-node-child-by-field-name node "name")
- t)
- name-list)
- do (setq node (treesit-node-parent node))
- finally return (string-join name-list "."))))
-
-(defun js--treesit-imenu-1 (node)
- "Given a sparse tree, create an imenu alist.
-
-NODE is the root node of the tree returned by
-`treesit-induce-sparse-tree' (not a tree-sitter node, its car is
-a tree-sitter node). Walk that tree and return an imenu alist.
-
-Return a list of ENTRY where
-
-ENTRY := (NAME . MARKER)
- | (NAME . ((JUMP-LABEL . MARKER)
- ENTRY
- ...)
-
-NAME is the function/class's name, JUMP-LABEL is like \"*function
-definition*\"."
- (let* ((ts-node (car node))
- (children (cdr node))
- (subtrees (mapcan #'js--treesit-imenu-1
- children))
- (type (pcase (treesit-node-type ts-node)
- ("lexical_declaration" 'variable)
- ("class_declaration" 'class)
- ("method_definition" 'method)
- ("function_declaration" 'function)))
- ;; The root of the tree could have a nil ts-node.
- (name (when ts-node
- (let ((ts-node-1
- (if (eq type 'variable)
- (treesit-search-subtree
- ts-node "variable_declarator" nil nil 1)
- ts-node)))
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node-1 "name")
- t))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((null ts-node)
- subtrees)
- ;; Don't included non-top-level variable declarations.
- ((and (eq type 'variable)
- (treesit-node-top-level ts-node))
- nil)
- (subtrees
- `((,name
- ,(cons "" marker)
- ,@subtrees)))
- (t (list (cons name marker))))))
-
-(defun js--treesit-imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (class-tree (treesit-induce-sparse-tree
- node (rx (or "class_declaration"
- "method_definition"))
- nil 1000))
- (func-tree (treesit-induce-sparse-tree
- node "function_declaration" nil 1000))
- (var-tree (treesit-induce-sparse-tree
- node "lexical_declaration" nil 1000)))
- ;; When a sub-tree is empty, we should not return that pair at all.
- (append
- (and func-tree
- `(("Function" . ,(js--treesit-imenu-1 func-tree))))
- (and var-tree
- `(("Variable" . ,(js--treesit-imenu-1 var-tree))))
- (and class-tree
- `(("Class" . ,(js--treesit-imenu-1 class-tree)))))))
+(defun js--treesit-property-not-function-p (node)
+ "Check that NODE, a property_identifier, is not used as a function."
+ (not (equal (treesit-node-type
+ (treesit-node-parent ; Maybe call_expression.
+ (treesit-node-parent ; Maybe member_expression.
+ node)))
+ "call_expression")))
+
+(defvar js--treesit-lhs-identifier-query
+ (when (treesit-available-p)
+ (treesit-query-compile 'javascript '((identifier) @id
+ (property_identifier) @id)))
+ "Query that captures identifier and query_identifier.")
+
+(defun js--treesit-fontify-assignment-lhs (node override start end &rest _)
+ "Fontify the lhs NODE of an assignment_expression.
+For OVERRIDE, START, END, see `treesit-font-lock-rules'."
+ (dolist (node (treesit-query-capture
+ node js--treesit-lhs-identifier-query nil nil t))
+ (treesit-fontify-with-override
+ (treesit-node-start node) (treesit-node-end node)
+ (pcase (treesit-node-type node)
+ ("identifier" 'font-lock-variable-name-face)
+ ("property_identifier" 'font-lock-property-face))
+ override start end)))
+
+(defun js--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ (pcase (treesit-node-type node)
+ ("lexical_declaration"
+ (treesit-search-subtree node "variable_declarator" nil nil 1))
+ ((or "function_declaration" "method_definition" "class_declaration")
+ node))
+ "name")
+ t))
+
+(defun js--treesit-valid-imenu-entry (node)
+ "Return nil if NODE is a non-top-level \"lexical_declaration\"."
+ (pcase (treesit-node-type node)
+ ("lexical_declaration" (treesit-node-top-level node))
+ (_ t)))
;;; Main Function
@@ -3858,15 +3791,7 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Which-func.
(setq-local which-func-imenu-joiner-function #'js--which-func-joiner)
;; Comment.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
+ (c-ts-mode-comment-setup)
(setq-local comment-multi-line t)
(setq-local treesit-text-type-regexp
@@ -3890,19 +3815,25 @@ Currently there are `js-mode' and `js-ts-mode'."
"method_definition"
"function_declaration"
"lexical_declaration")))
+ (setq-local treesit-defun-name-function #'js--treesit-defun-name)
;; Fontification.
(setq-local treesit-font-lock-settings js--treesit-font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( comment declaration)
+ '(( comment definition)
( keyword string)
- ( constant escape-sequence expression
- identifier jsx number pattern property)
- ( bracket delimiter operator)))
+ ( assignment constant escape-sequence jsx number
+ pattern)
+ ( bracket delimiter function operator property
+ string-interpolation)))
;; Imenu
- (setq-local imenu-create-index-function
- #'js--treesit-imenu)
- ;; Which-func (use imenu).
- (setq-local which-func-functions nil)
+ (setq-local treesit-simple-imenu-settings
+ `(("Function" "\\`function_declaration\\'" nil nil)
+ ("Variable" "\\`lexical_declaration\\'"
+ js--treesit-valid-imenu-entry nil)
+ ("Class" ,(rx bos (or "class_declaration"
+ "method_definition")
+ eos)
+ nil nil)))
(treesit-major-mode-setup)))
;;;###autoload
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index 6c2f380587..adba2f820f 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -33,6 +33,7 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-type "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
@@ -107,33 +108,16 @@
'((ERROR) @font-lock-warning-face))
"Font-lock settings for JSON.")
-(defun json-ts-mode--imenu-1 (node)
- "Helper for `json-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'json-ts-mode--imenu-1 (cdr node)))
- (name (when ts-node
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node "key")
- t)))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((null ts-node) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun json-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (tree (treesit-induce-sparse-tree
- node "pair" nil 1000)))
- (json-ts-mode--imenu-1 tree)))
+(defun json-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "pair" "object")
+ (string-trim (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "key")
+ t)
+ "\"" "\""))))
;;;###autoload
(define-derived-mode json-ts-mode prog-mode "JSON"
@@ -161,6 +145,7 @@ the subtrees."
;; Navigation.
(setq-local treesit-defun-type-regexp
(rx (or "pair" "object")))
+ (setq-local treesit-defun-name-function #'json-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings)
@@ -170,8 +155,8 @@ the subtrees."
(bracket delimiter error)))
;; Imenu.
- (setq-local imenu-create-index-function #'json-ts-mode--imenu)
- (setq-local which-func-functions nil) ;; Piggyback on imenu
+ (setq-local treesit-simple-imenu-settings
+ '((nil "\\`pair\\'" nil nil)))
(treesit-major-mode-setup))
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index aa37a4ac86..2e0cb6cd25 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -164,10 +164,8 @@ or follows point."
(treesit-node-type (treesit-node-at (point)))))))
(if (or treesit-text-node
(nth 8 (syntax-ppss))
- (re-search-forward comment-start-skip (line-end-position) t))
- (if (memq fill-paragraph-function '(t nil))
- (lisp-fill-paragraph argument)
- (funcall fill-paragraph-function argument))
+ (re-search-forward "\\s-*\\s<" (line-end-position) t))
+ (fill-paragraph argument (region-active-p))
(beginning-of-defun)
(let ((start (point)))
(end-of-defun)
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 86bfafe271..07f86d3155 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1080,7 +1080,6 @@ fontified."
:feature 'string
:language 'python
- :override t
'((string) @python--treesit-fontify-string)
:feature 'string-interpolation
@@ -1097,9 +1096,7 @@ fontified."
:feature 'function
:language 'python
- '((function_definition
- name: (identifier) @font-lock-function-name-face)
- (call function: (identifier) @font-lock-function-name-face)
+ '((call function: (identifier) @font-lock-function-name-face)
(call function: (attribute
attribute: (identifier) @font-lock-function-name-face)))
@@ -1130,7 +1127,7 @@ fontified."
@font-lock-variable-name-face)
(assignment left: (attribute
attribute: (identifier)
- @font-lock-variable-name-face))
+ @font-lock-property-face))
(pattern_list (identifier)
@font-lock-variable-name-face)
(tuple_pattern (identifier)
@@ -1162,12 +1159,10 @@ fontified."
:feature 'number
:language 'python
- :override t
'([(integer) (float)] @font-lock-number-face)
:feature 'property
:language 'python
- :override t
'((attribute
attribute: (identifier) @font-lock-property-face)
(class_definition
@@ -1178,20 +1173,44 @@ fontified."
:feature 'operator
:language 'python
- :override t
`([,@python--treesit-operators] @font-lock-operator-face)
:feature 'bracket
:language 'python
- :override t
'(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face)
:feature 'delimiter
:language 'python
- :override t
- '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face))
+ '(["," "." ":" ";" (ellipsis)] @font-lock-delimiter-face)
+
+ :feature 'variable
+ :language 'python
+ '((identifier) @python--treesit-fontify-variable))
"Tree-sitter font-lock settings.")
+(defun python--treesit-variable-p (node)
+ "Check whether NODE is a variable.
+NODE's type should be \"identifier\"."
+ ;; An identifier can be a function/class name, a property, or a
+ ;; variables. This funtion filters out function/class names and
+ ;; properties.
+ (pcase (treesit-node-type (treesit-node-parent node))
+ ((or "function_definition" "class_definition") nil)
+ ("attribute"
+ (pcase (treesit-node-field-name node)
+ ("object" t)
+ (_ nil)))
+ (_ t)))
+
+(defun python--treesit-fontify-variable (node override start end &rest _)
+ "Fontify an identifier node if it is a variable.
+For NODE, OVERRIDE, START, END, and ARGS, see
+`treesit-font-lock-rules'."
+ (when (python--treesit-variable-p node)
+ (treesit-fontify-with-override
+ (treesit-node-start node) (treesit-node-end node)
+ 'font-lock-variable-name-face override start end)))
+
;;; Indentation
@@ -5448,6 +5467,16 @@ To this:
;;; Tree-sitter imenu
+(defun python--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "function_definition" "class_definition")
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "name")
+ t))))
+
(defun python--imenu-treesit-create-index-1 (node)
"Given a sparse tree, create an imenu alist.
@@ -5473,9 +5502,8 @@ definition*\"."
("class_definition" 'class)))
;; The root of the tree could have a nil ts-node.
(name (when ts-node
- (treesit-node-text
- (treesit-node-child-by-field-name
- ts-node "name") t)))
+ (or (treesit-defun-name ts-node)
+ "Anonymous")))
(marker (when ts-node
(set-marker (make-marker)
(treesit-node-start ts-node)))))
@@ -6637,12 +6665,14 @@ implementations: `python-mode' and `python-ts-mode'."
( keyword string type)
( assignment builtin constant decorator
escape-sequence number property string-interpolation )
- ( function bracket delimiter operator)))
+ ( bracket delimiter function operator variable)))
(setq-local treesit-font-lock-settings python--treesit-settings)
(setq-local imenu-create-index-function
#'python-imenu-treesit-create-index)
(setq-local treesit-defun-type-regexp (rx (or "function" "class")
"_definition"))
+ (setq-local treesit-defun-name-function
+ #'python--treesit-defun-name)
(treesit-major-mode-setup)
(when python-indent-guess-indent-offset
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index a4aa61905e..3a86093941 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -285,6 +285,96 @@ Only has effect when `ruby-use-smie' is t."
:safe (lambda (val) (or (memq val '(t nil)) (numberp val)))
:version "29.1")
+(defcustom ruby-block-indent t
+ "Non-nil to align the body of a block to the statement's start.
+
+The body and the closer will be aligned to the column where the
+statement containing the block starts. Example:
+
+ foo.bar
+ .each do
+ baz
+ end
+
+If nil, it will be aligned instead to the beginning of the line
+containing the block's opener:
+
+ foo.bar
+ .each do
+ baz
+ end
+
+Only has effect when `ruby-use-smie' is t."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom ruby-after-operator-indent t
+ "Non-nil to use structural indentation after binary operators.
+
+The code will be aligned to the implicit parent expression,
+according to the operator precedence:
+
+ qux = 4 + 5 *
+ 6 +
+ 7
+
+Set it to nil to align to the beginning of the statement:
+
+ qux = 4 + 5 *
+ 6 +
+ 7
+
+Only has effect when `ruby-use-smie' is t."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom ruby-method-call-indent t
+ "Non-nil to use the structural indentation algorithm.
+
+The method call will be aligned to the implicit parent
+expression, according to the operator precedence:
+
+ foo = subject
+ .update(
+ 1
+ )
+
+Set it to nil to align to the beginning of the statement:
+
+ foo = subject
+ .update(
+ 1
+ )
+
+Only has effect when `ruby-use-smie' is t."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
+(defcustom ruby-parenless-call-arguments-indent t
+ "Non-nil to align arguments in a parenless call vertically.
+
+Example:
+
+ qux :+,
+ bar,
+ :[]=,
+ bar
+
+Set it to nil to align to the beginning of the statement:
+
+ qux :+,
+ bar,
+ :[]=,
+ bar
+
+Only has effect when `ruby-use-smie' is t."
+ :type 'boolean
+ :safe 'booleanp
+ :version "29.1")
+
(defcustom ruby-deep-arglist t
"Deep indent lists in parenthesis when non-nil.
Also ignores spaces after parenthesis when `space'.
@@ -416,6 +506,7 @@ This only affects the output of the command
`ruby-toggle-block'."
'((right "=")
(right "+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^="
"<<=" ">>=" "&&=" "||=")
+ (right "?")
(nonassoc ".." "...")
(left "&&" "||")
(nonassoc "<=>")
@@ -608,10 +699,10 @@ This only affects the output of the command
`ruby-toggle-block'."
"def=")
(t tok)))))))
-(defun ruby-smie--indent-to-stmt ()
+(defun ruby-smie--indent-to-stmt (&optional offset)
(save-excursion
(smie-backward-sexp ";")
- (cons 'column (smie-indent-virtual))))
+ (cons 'column (+ (smie-indent-virtual) (or offset 0)))))
(defun ruby-smie--indent-to-stmt-p (keyword)
(or (eq t ruby-align-to-stmt-keywords)
@@ -642,7 +733,9 @@ This only affects the output of the command
`ruby-toggle-block'."
(forward-comment -1)
(not (eq (preceding-char) ?:))))
;; Curly block opener.
- (ruby-smie--indent-to-stmt))
+ (if ruby-block-indent
+ (ruby-smie--indent-to-stmt)
+ (cons 'column (current-indentation))))
((smie-rule-hanging-p)
;; Treat purely syntactic block-constructs as being part of their
parent,
;; when the opening token is hanging and the parent is not an
@@ -677,13 +770,20 @@ This only affects the output of the command
`ruby-toggle-block'."
(unless (or (eolp) (forward-comment 1))
(cons 'column (current-column)))))
('(:before . " @ ")
- (if (or (eq ruby-method-params-indent t)
- (not (smie-rule-parent-p "def" "def=")))
- (save-excursion
- (skip-chars-forward " \t")
- (cons 'column (current-column)))
- (smie-rule-parent (or ruby-method-params-indent 0))))
- ('(:before . "do") (ruby-smie--indent-to-stmt))
+ (cond
+ ((and (not ruby-parenless-call-arguments-indent)
+ (not (smie-rule-parent-p "def" "def=")))
+ (ruby-smie--indent-to-stmt ruby-indent-level))
+ ((or (eq ruby-method-params-indent t)
+ (not (smie-rule-parent-p "def" "def=")))
+ (save-excursion
+ (skip-chars-forward " \t")
+ (cons 'column (current-column))))
+ (t (smie-rule-parent (or ruby-method-params-indent 0)))))
+ ('(:before . "do")
+ (if ruby-block-indent
+ (ruby-smie--indent-to-stmt)
+ (cons 'column (current-indentation))))
('(:before . ".")
(if (smie-rule-sibling-p)
(when ruby-align-chained-calls
@@ -696,8 +796,10 @@ This only affects the output of the command
`ruby-toggle-block'."
(not (smie-rule-bolp)))))
(cons 'column (current-column)))
(smie-backward-sexp ".")
- (cons 'column (+ (current-column)
- ruby-indent-level))))
+ (if ruby-method-call-indent
+ (cons 'column (+ (current-column)
+ ruby-indent-level))
+ (ruby-smie--indent-to-stmt ruby-indent-level))))
(`(:before . ,(or "else" "then" "elsif" "rescue" "ensure"))
(smie-rule-parent))
(`(:before . ,(or "when" "in"))
@@ -708,16 +810,22 @@ This only affects the output of the command
`ruby-toggle-block'."
"<=>" ">" "<" ">=" "<=" "==" "===" "!=" "<<" ">>"
"+=" "-=" "*=" "/=" "%=" "**=" "&=" "|=" "^=" "|"
"<<=" ">>=" "&&=" "||=" "and" "or"))
- (and (smie-rule-parent-p ";" nil)
- (smie-indent--hanging-p)
- ruby-indent-level))
+ (cond
+ ((not ruby-after-operator-indent)
+ (ruby-smie--indent-to-stmt ruby-indent-level))
+ ((and (smie-rule-parent-p ";" nil)
+ (smie-indent--hanging-p))
+ ruby-indent-level)))
(`(:before . "=")
(save-excursion
(and (smie-rule-parent-p " @ ")
(goto-char (nth 1 (smie-indent--parent)))
(smie-rule-prev-p "def=")
(cons 'column (+ (current-column) ruby-indent-level -3)))))
- (`(:after . ,(or "?" ":")) ruby-indent-level)
+ (`(:after . ,(or "?" ":"))
+ (if ruby-after-operator-indent
+ ruby-indent-level
+ (ruby-smie--indent-to-stmt ruby-indent-level)))
(`(:before . ,(guard (memq (intern-soft token) ruby-alignable-keywords)))
(when (not (ruby--at-indentation-p))
(if (ruby-smie--indent-to-stmt-p token)
@@ -725,7 +833,10 @@ This only affects the output of the command
`ruby-toggle-block'."
(cons 'column (current-column)))))
('(:before . "iuwu-mod")
(smie-rule-parent ruby-indent-level))
- ))
+ (`(:before . ",")
+ (and (not ruby-parenless-call-arguments-indent)
+ (smie-rule-parent-p " @ ")
+ (ruby-smie--indent-to-stmt ruby-indent-level)))))
(defun ruby--at-indentation-p (&optional point)
(save-excursion
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index 8b2ed19101..d03dffe628 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -29,6 +29,7 @@
(require 'treesit)
(eval-when-compile (require 'rx))
+(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
@@ -70,6 +71,9 @@
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is "}") (and parent parent-bol) 0)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "arguments") parent-bol rust-ts-mode-indent-offset)
((parent-is "await_expression") parent-bol rust-ts-mode-indent-offset)
((parent-is "array_expression") parent-bol rust-ts-mode-indent-offset)
@@ -244,78 +248,32 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `rust-ts-mode'.")
-(defun rust-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (enum-tree (treesit-induce-sparse-tree
- node "enum_item" nil))
- (enum-index (rust-ts-mode--imenu-1 enum-tree))
- (func-tree (treesit-induce-sparse-tree
- node "function_item" nil))
- (func-index (rust-ts-mode--imenu-1 func-tree))
- (impl-tree (treesit-induce-sparse-tree
- node "impl_item" nil))
- (impl-index (rust-ts-mode--imenu-1 impl-tree))
- (mod-tree (treesit-induce-sparse-tree
- node "mod_item" nil))
- (mod-index (rust-ts-mode--imenu-1 mod-tree))
- (struct-tree (treesit-induce-sparse-tree
- node "struct_item" nil))
- (struct-index (rust-ts-mode--imenu-1 struct-tree))
- (type-tree (treesit-induce-sparse-tree
- node "type_item" nil))
- (type-index (rust-ts-mode--imenu-1 type-tree)))
- (append
- (when mod-index `(("Module" . ,mod-index)))
- (when enum-index `(("Enum" . ,enum-index)))
- (when impl-index `(("Impl" . ,impl-index)))
- (when type-index `(("Type" . ,type-index)))
- (when struct-index `(("Struct" . ,struct-index)))
- (when func-index `(("Fn" . ,func-index))))))
-
-(defun rust-ts-mode--imenu-1 (node)
- "Helper for `rust-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (children (cdr node))
- (subtrees (mapcan #'rust-ts-mode--imenu-1
- children))
- (name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("enum_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("function_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("impl_item"
- (let ((trait-node (treesit-node-child-by-field-name
ts-node "trait")))
- (concat
- (treesit-node-text
- trait-node t)
- (when trait-node
- " for ")
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "type") t))))
- ("mod_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("struct_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t))
- ("type_item"
- (treesit-node-text
- (treesit-node-child-by-field-name ts-node "name") t)))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((or (null ts-node) (null name)) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
+(defun rust-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ("enum_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("function_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("impl_item"
+ (let ((trait-node (treesit-node-child-by-field-name node "trait")))
+ (concat
+ (treesit-node-text trait-node t)
+ (when trait-node " for ")
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "type") t))))
+ ("mod_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("struct_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))
+ ("type_item"
+ (treesit-node-text
+ (treesit-node-child-by-field-name node "name") t))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))
@@ -330,15 +288,7 @@ the subtrees."
(treesit-parser-create 'rust)
;; Comments.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
+ (c-ts-mode-comment-setup)
;; Font-lock.
(setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings)
@@ -350,8 +300,13 @@ the subtrees."
( bracket delimiter error operator)))
;; Imenu.
- (setq-local imenu-create-index-function #'rust-ts-mode--imenu)
- (setq-local which-func-functions nil)
+ (setq-local treesit-simple-imenu-settings
+ `(("Module" "\\`mod_item\\'" nil nil)
+ ("Enum" "\\`enum_item\\'" nil nil)
+ ("Impl" "\\`impl_item\\'" nil nil)
+ ("Type" "\\`type_item\\'" nil nil)
+ ("Struct" "\\`struct_item\\'" nil nil)
+ ("Fn" "\\`function_item\\'" nil nil)))
;; Indent.
(setq-local indent-tabs-mode nil
@@ -363,6 +318,7 @@ the subtrees."
"function_item"
"impl_item"
"struct_item")))
+ (setq-local treesit-defun-name-function #'rust-ts-mode--defun-name)
(treesit-major-mode-setup)))
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 8454f24356..f45d799252 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -115,7 +115,8 @@
(defvar scheme-imenu-generic-expression
`((nil
- ,(rx bol "(define"
+ ,(rx bol (zero-or-more space)
+ "(define"
(zero-or-one "*")
(zero-or-one "-public")
(one-or-more space)
@@ -123,36 +124,41 @@
(group (one-or-more (or word (syntax symbol)))))
1)
("Methods"
- ,(rx bol "(define-"
+ ,(rx bol (zero-or-more space)
+ "(define-"
(or "generic" "method" "accessor")
(one-or-more space)
(zero-or-one "(")
(group (one-or-more (or word (syntax symbol)))))
1)
("Classes"
- ,(rx bol "(define-class"
+ ,(rx bol (zero-or-more space)
+ "(define-class"
(one-or-more space)
(zero-or-one "(")
(group (one-or-more (or word (syntax symbol)))))
1)
("Records"
- ,(rx bol "(define-record-type"
+ ,(rx bol (zero-or-more space)
+ "(define-record-type"
(zero-or-one "*")
(one-or-more space)
(group (one-or-more (or word (syntax symbol)))))
1)
("Conditions"
- ,(rx bol "(define-condition-type"
+ ,(rx bol (zero-or-more space)
+ "(define-condition-type"
(one-or-more space)
(group (one-or-more (or word (syntax symbol)))))
1)
("Modules"
- ,(rx bol "(define-module"
+ ,(rx bol (zero-or-more space)
+ "(define-module"
(one-or-more space)
(group "(" (one-or-more any) ")"))
1)
("Macros"
- ,(rx bol "("
+ ,(rx bol (zero-or-more space) "("
(or (and "defmacro"
(zero-or-one "*")
(zero-or-one "-public"))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 3f995d17b5..d12ade36af 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -150,6 +150,8 @@
(require 'executable)
(require 'treesit)
+(declare-function treesit-parser-create "treesit.c")
+
(autoload 'comint-completion-at-point "comint")
(autoload 'comint-filename-completion "comint")
(autoload 'comint-send-string "comint")
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index 6ba1b9b12c..05ddc0e7a9 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -30,6 +30,7 @@
(require 'treesit)
(require 'js)
(eval-when-compile (require 'rx))
+(require 'c-ts-mode) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
@@ -73,8 +74,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((node-is ")") parent-bol 0)
((node-is "]") parent-bol 0)
((node-is ">") parent-bol 0)
- ((and (parent-is "comment") comment-end) comment-start -1)
- ((parent-is "comment") comment-start-skip 0)
+ ((and (parent-is "comment") c-ts-mode--looking-at-star)
+ c-ts-mode--comment-start-after-first-star -1)
+ ((parent-is "comment") prev-adaptive-prefix 0)
((parent-is "ternary_expression") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "member_expression") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset)
@@ -331,18 +333,12 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:syntax-table typescript-ts-mode--syntax-table
;; Comments.
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip "\\(?://+\\|/\\*+\\)\\s *")
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
+ (c-ts-mode-comment-setup)
+ (setq-local treesit-defun-prefer-top-level t)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
"template_string")))
- (setq-local treesit-defun-prefer-top-level t)
;; Electric
(setq-local electric-indent-chars
@@ -354,11 +350,17 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"method_definition"
"function_declaration"
"lexical_declaration")))
- ;; Imenu.
- (setq-local imenu-create-index-function #'js--treesit-imenu)
-
- ;; Which-func (use imenu).
- (setq-local which-func-functions nil))
+ (setq-local treesit-defun-name-function #'js--treesit-defun-name)
+
+ ;; Imenu (same as in `js-ts-mode').
+ (setq-local treesit-simple-imenu-settings
+ `(("Function" "\\`function_declaration\\'" nil nil)
+ ("Variable" "\\`lexical_declaration\\'"
+ js--treesit-valid-imenu-entry nil)
+ ("Class" ,(rx bos (or "class_declaration"
+ "method_definition")
+ eos)
+ nil nil))))
;;;###autoload
(define-derived-mode typescript-ts-mode typescript-ts-base-mode "TypeScript"
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 3b3a444ee2..e382239fc8 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -399,7 +399,8 @@ but the property value is `t', then check the last key."
(defcustom repeat-echo-function #'repeat-echo-message
"Function to display a hint about available keys.
Function is called after every repeatable command with one argument:
-a repeating map, or nil after deactivating the transient repeating mode."
+a repeating map, or nil after deactivating the transient repeating mode.
+You can use `add-function' for multiple functions simultaneously."
:type '(choice (const :tag "Show hints in the echo area"
repeat-echo-message)
(const :tag "Show indicator in the mode line"
diff --git a/lisp/simple.el b/lisp/simple.el
index 4551b749d5..cf0845853a 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8438,6 +8438,43 @@ are interchanged."
(interactive "*p")
(transpose-subr 'forward-word arg))
+(defvar transpose-sexps-function
+ (lambda (arg)
+ ;; Here we should try to simulate the behavior of
+ ;; (cons (progn (forward-sexp x) (point))
+ ;; (progn (forward-sexp (- x)) (point)))
+ ;; Except that we don't want to rely on the second forward-sexp
+ ;; putting us back to where we want to be, since forward-sexp-function
+ ;; might do funny things like infix-precedence.
+ (if (if (> arg 0)
+ (looking-at "\\sw\\|\\s_")
+ (and (not (bobp))
+ (save-excursion
+ (forward-char -1)
+ (looking-at "\\sw\\|\\s_"))))
+ ;; Jumping over a symbol. We might be inside it, mind you.
+ (progn (funcall (if (> arg 0)
+ #'skip-syntax-backward #'skip-syntax-forward)
+ "w_")
+ (cons (save-excursion (forward-sexp arg) (point)) (point)))
+ ;; Otherwise, we're between sexps. Take a step back before jumping
+ ;; to make sure we'll obey the same precedence no matter which
+ ;; direction we're going.
+ (funcall (if (> arg 0) #'skip-syntax-backward #'skip-syntax-forward)
+ " .")
+ (cons (save-excursion (forward-sexp arg) (point))
+ (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+ (not (zerop (funcall (if (> arg 0)
+ #'skip-syntax-forward
+ #'skip-syntax-backward)
+ ".")))))
+ (point)))))
+ "If non-nil, `transpose-sexps' delegates to this function.
+
+This function takes one argument ARG, a number. Its expected
+return value is a position pair, which is a cons (BEG . END),
+where BEG and END are buffer positions.")
+
(defun transpose-sexps (arg &optional interactive)
"Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
Unlike `transpose-words', point must be between the two sexps and not
@@ -8453,38 +8490,7 @@ report errors as appropriate for this kind of usage."
(condition-case nil
(transpose-sexps arg nil)
(scan-error (user-error "Not between two complete sexps")))
- (transpose-subr
- (lambda (arg)
- ;; Here we should try to simulate the behavior of
- ;; (cons (progn (forward-sexp x) (point))
- ;; (progn (forward-sexp (- x)) (point)))
- ;; Except that we don't want to rely on the second forward-sexp
- ;; putting us back to where we want to be, since forward-sexp-function
- ;; might do funny things like infix-precedence.
- (if (if (> arg 0)
- (looking-at "\\sw\\|\\s_")
- (and (not (bobp))
- (save-excursion
- (forward-char -1)
- (looking-at "\\sw\\|\\s_"))))
- ;; Jumping over a symbol. We might be inside it, mind you.
- (progn (funcall (if (> arg 0)
- 'skip-syntax-backward 'skip-syntax-forward)
- "w_")
- (cons (save-excursion (forward-sexp arg) (point)) (point)))
- ;; Otherwise, we're between sexps. Take a step back before jumping
- ;; to make sure we'll obey the same precedence no matter which
- ;; direction we're going.
- (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
- " .")
- (cons (save-excursion (forward-sexp arg) (point))
- (progn (while (or (forward-comment (if (> arg 0) 1 -1))
- (not (zerop (funcall (if (> arg 0)
- 'skip-syntax-forward
- 'skip-syntax-backward)
- ".")))))
- (point)))))
- arg 'special)))
+ (transpose-subr transpose-sexps-function arg 'special)))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.
@@ -8509,13 +8515,15 @@ With argument 0, interchanges line point is in with
line mark is in."
;; FIXME document SPECIAL.
(defun transpose-subr (mover arg &optional special)
"Subroutine to do the work of transposing objects.
-Works for lines, sentences, paragraphs, etc. MOVER is a function that
-moves forward by units of the given object (e.g. `forward-sentence',
-`forward-paragraph'). If ARG is zero, exchanges the current object
-with the one containing mark. If ARG is an integer, moves the
-current object past ARG following (if ARG is positive) or
-preceding (if ARG is negative) objects, leaving point after the
-current object."
+Works for lines, sentences, paragraphs, etc. MOVER is a function
+that moves forward by units of the given
+object (e.g. `forward-sentence', `forward-paragraph'), or a
+function calculating a cons of buffer positions.
+
+ If ARG is zero, exchanges the current object with the one
+containing mark. If ARG is an integer, moves the current object
+past ARG following (if ARG is positive) or preceding (if ARG is
+negative) objects, leaving point after the current object."
(let ((aux (if special mover
(lambda (x)
(cons (progn (funcall mover x) (point))
@@ -8542,6 +8550,8 @@ current object."
(goto-char (+ (car pos2) (- (cdr pos1) (car pos1))))))))
(defun transpose-subr-1 (pos1 pos2)
+ (unless (and pos1 pos2)
+ (error "Don't have two things to transpose"))
(when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
(when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
(when (> (car pos1) (car pos2))
diff --git a/lisp/startup.el b/lisp/startup.el
index 6270de2ace..5a38363077 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -2921,7 +2921,7 @@ nil default-directory" name)
(when (looking-at "#!")
(forward-line))
(let (value form)
- (while (ignore-error 'end-of-file
+ (while (ignore-error end-of-file
(setq form (read (current-buffer))))
(setq value (eval form t)))
(kill-emacs (if (numberp value)
diff --git a/lisp/subr.el b/lisp/subr.el
index fff4c88ccf..69e6198e1b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -280,14 +280,20 @@ change the list."
When COND yields non-nil, eval BODY forms sequentially and return
value of last one, or nil if there are none."
(declare (indent 1) (debug t))
- (list 'if cond (cons 'progn body)))
+ (if body
+ (list 'if cond (cons 'progn body))
+ (macroexp-warn-and-return "`when' with empty body"
+ cond '(empty-body when) t)))
(defmacro unless (cond &rest body)
"If COND yields nil, do BODY, else return nil.
When COND yields nil, eval BODY forms sequentially and return
value of last one, or nil if there are none."
(declare (indent 1) (debug t))
- (cons 'if (cons cond (cons nil body))))
+ (if body
+ (cons 'if (cons cond (cons nil body)))
+ (macroexp-warn-and-return "`unless' with empty body"
+ cond '(empty-body unless) t)))
(defsubst subr-primitive-p (object)
"Return t if OBJECT is a built-in primitive function."
@@ -380,9 +386,23 @@ without silencing all errors."
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
-CONDITION can also be a list of error conditions."
+CONDITION can also be a list of error conditions.
+The CONDITION argument is not evaluated. Do not quote it."
(declare (debug t) (indent 1))
- `(condition-case nil (progn ,@body) (,condition nil)))
+ (cond
+ ((and (eq (car-safe condition) 'quote)
+ (cdr condition) (null (cddr condition)))
+ (macroexp-warn-and-return
+ (format "`ignore-error' condition argument should not be quoted: %S"
+ condition)
+ `(condition-case nil (progn ,@body) (,(cadr condition) nil))
+ nil t condition))
+ (body
+ `(condition-case nil (progn ,@body) (,condition nil)))
+ (t
+ (macroexp-warn-and-return "`ignore-error' with empty body"
+ nil '(empty-body ignore-error) t condition))))
+
;;;; Basic Lisp functions.
@@ -4850,6 +4870,7 @@ but that should be robust in the unexpected case that an
error is signaled."
(declare (debug t) (indent 1))
(let* ((err (make-symbol "err"))
(orig-body body)
+ (orig-format format)
(format (if (and (stringp format) body) format
(prog1 "Error: %S"
(if format (push format body)))))
@@ -4860,7 +4881,9 @@ but that should be robust in the unexpected case that an
error is signaled."
(if (eq orig-body body) exp
;; The use without `format' is obsolete, let's warn when we bump
;; into any such remaining uses.
- (macroexp-warn-and-return "Missing format argument" exp nil nil
format))))
+ (macroexp-warn-and-return
+ "Missing format argument in `with-demote-errors'" exp nil nil
+ orig-format))))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
@@ -6905,11 +6928,8 @@ sentence (see Info node `(elisp) Documentation Tips')."
(defun json-available-p ()
"Return non-nil if Emacs has libjansson support."
- (and (fboundp 'json-serialize)
- (condition-case nil
- (json-serialize t)
- (:success t)
- (json-unavailable nil))))
+ (and (fboundp 'json--available-p)
+ (json--available-p)))
(defun ensure-list (object)
"Return OBJECT as a list.
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 0bab3aba80..7433f5c8e5 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1116,7 +1116,8 @@ tab bar might wrap to the second line when it shouldn't.")
(del-pos2 (if close-p -1 nil)))
(while continue
(setq name (concat (substring name 0 del-pos1)
- (substring name del-pos2)))
+ (and del-pos2
+ (substring name del-pos2))))
(setq curr-width (string-pixel-width name))
(if (and (> curr-width width)
(< curr-width prev-width))
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index c4e4a68872..30612728bd 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -572,9 +572,14 @@ For use in `tab-line-tab-face-functions'."
(defvar tab-line-auto-hscroll)
-(defun tab-line-cache-key-default (_tabs)
+(defun tab-line-cache-key-default (tabs)
"Return default list of cache keys."
(list
+ tabs
+ ;; handle buffer renames
+ (buffer-name (window-buffer))
+ ;; handle tab-line scrolling
+ (window-parameter nil 'tab-line-hscroll)
;; for setting face 'tab-line-tab-current'
(mode-line-window-selected-p)
;; for `tab-line-tab-face-modified'
@@ -591,12 +596,7 @@ of cache keys. You can use `add-function' to add more
cache keys.")
(defun tab-line-format ()
"Format for displaying the tab line of the selected window."
(let* ((tabs (funcall tab-line-tabs-function))
- (cache-key (append (list tabs
- ;; handle buffer renames
- (buffer-name (window-buffer))
- ;; handle tab-line scrolling
- (window-parameter nil 'tab-line-hscroll))
- (funcall tab-line-cache-key-function tabs)))
+ (cache-key (funcall tab-line-cache-key-function tabs))
(cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index f4b557f443..2390974288 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1822,8 +1822,9 @@ Initialized by `bibtex-set-dialect'.")
1 '(11))))
(defvar bibtex-font-lock-keywords
- ;; entry type and reference key
- `((,bibtex-any-entry-maybe-empty-head
+ `(("\\$[^$\n]+\\$" . font-lock-string-face) ; bug#50202
+ ;; entry type and reference key
+ (,bibtex-any-entry-maybe-empty-head
(,bibtex-type-in-head font-lock-function-name-face)
(,bibtex-key-in-head font-lock-constant-face nil t))
;; optional field names (treated as comments)
@@ -3631,8 +3632,11 @@ if that value is non-nil.
(setq-local fill-paragraph-function #'bibtex-fill-field)
(setq-local font-lock-defaults
'(bibtex-font-lock-keywords
- nil t ((?$ . "\"")
- ;; Mathematical expressions should be fontified as
strings
+ nil t ((?$ . ".")
+ ;; Mathematical expressions should be fontified
+ ;; as strings. Yet `$' may also appear in certain
+ ;; fields like `URL' when it does not delimit
+ ;; a math expression (bug#50202).
(?\" . ".")
;; Quotes are field delimiters and quote-delimited
;; entries should be fontified in the same way as
@@ -4079,11 +4083,19 @@ INIT is surrounded by field delimiters, unless NODELIM
is non-nil."
If inside an entry, move to the beginning of it, otherwise move to the
beginning of the previous entry. If point is ahead of all BibTeX entries
move point to the beginning of buffer. Return the new location of point."
+ ;; This command is similar to `beginning-of-defun', but with historical
+ ;; differences.
+ ;; - It does not move point to the previous entry if point is already
+ ;; at the beginning of an entry
+ ;; - It does not take an optional ARG that moves backward to the beginning
+ ;; of a defun ARG times.
+ ;; - It returns point and the code relies on this.
(interactive)
- (skip-chars-forward " \t")
- (if (looking-at "@")
- (forward-char))
- (re-search-backward "^[ \t]*@" nil 'move)
+ (beginning-of-line)
+ ;; `bibtex-any-valid-entry-type' would fail if users "disable"
+ ;; an entry by chosing an invalid entry type.
+ (or (looking-at bibtex-any-entry-maybe-empty-head)
+ (re-search-backward bibtex-any-entry-maybe-empty-head nil 'move))
(point))
(defun bibtex-end-of-entry ()
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 822097a86d..e8d9725948 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1412,39 +1412,18 @@ for determining whether point is within a selector."
'((ERROR) @error))
"Tree-sitter font-lock settings for `css-ts-mode'.")
-(defun css--treesit-imenu-1 (node)
- "Helper for `css--treesit-imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'css--treesit-imenu-1 (cdr node)))
- (name (when ts-node
- (pcase (treesit-node-type ts-node)
- ("rule_set" (treesit-node-text
- (treesit-node-child ts-node 0) t))
- ("media_statement"
- (let ((block (treesit-node-child ts-node -1)))
- (string-trim
- (buffer-substring-no-properties
- (treesit-node-start ts-node)
- (treesit-node-start block))))))))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((or (null ts-node) (null name)) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun css--treesit-imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (tree (treesit-induce-sparse-tree
- node (rx (or "rule_set" "media_statement"))
- nil 1000)))
- (css--treesit-imenu-1 tree)))
+(defun css--treesit-defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ("rule_set" (treesit-node-text
+ (treesit-node-child node 0) t))
+ ("media_statement"
+ (let ((block (treesit-node-child node -1)))
+ (string-trim
+ (buffer-substring-no-properties
+ (treesit-node-start node)
+ (treesit-node-start block)))))))
;;; Completion
@@ -1825,23 +1804,29 @@ can also be used to fill comments.
:syntax-table css-mode-syntax-table
(when (treesit-ready-p 'css)
;; Borrowed from `css-mode'.
+ (setq-local syntax-propertize-function
+ css-syntax-propertize-function)
(add-hook 'completion-at-point-functions
#'css-completion-at-point nil 'local)
(setq-local fill-paragraph-function #'css-fill-paragraph)
(setq-local adaptive-fill-function #'css-adaptive-fill)
- (setq-local add-log-current-defun-function #'css-current-defun-name)
+ ;; `css--fontify-region' first calls the default function, which
+ ;; will call tree-sitter's function, then it fontifies colors.
+ (setq-local font-lock-fontify-region-function #'css--fontify-region)
;; Tree-sitter specific setup.
(treesit-parser-create 'css)
(setq-local treesit-simple-indent-rules css--treesit-indent-rules)
(setq-local treesit-defun-type-regexp "rule_set")
+ (setq-local treesit-defun-name-function #'css--treesit-defun-name)
(setq-local treesit-font-lock-settings css--treesit-settings)
(setq-local treesit-font-lock-feature-list
'((selector comment query keyword)
(property constant string)
(error variable function operator bracket)))
- (setq-local imenu-create-index-function #'css--treesit-imenu)
- (setq-local which-func-functions nil)
+ (setq-local treesit-simple-imenu-settings
+ `(( nil ,(rx bos (or "rule_set" "media_statement") eos)
+ nil nil)))
(treesit-major-mode-setup)))
;;;###autoload
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index bca6a5e81a..cbdc758d4b 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -32,6 +32,8 @@
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-node-child "treesit.c")
(declare-function treesit-node-child-by-field-name "treesit.c")
(defcustom toml-ts-mode-indent-offset 2
@@ -107,43 +109,13 @@
'((ERROR) @font-lock-warning-face))
"Font-lock settings for TOML.")
-(defun toml-ts-mode--get-table-name (node)
- "Obtains the header-name for the associated tree-sitter `NODE'."
- (if node
- (treesit-node-text
- (car (cdr (treesit-node-children node))))
- "Root table"))
-
-(defun toml-ts-mode--imenu-1 (node)
- "Helper for `toml-ts-mode--imenu'.
-Find string representation for NODE and set marker, then recurse
-the subtrees."
- (let* ((ts-node (car node))
- (subtrees (mapcan #'toml-ts-mode--imenu-1 (cdr node)))
- (name (toml-ts-mode--get-table-name ts-node))
- (marker (when ts-node
- (set-marker (make-marker)
- (treesit-node-start ts-node)))))
- (cond
- ((null ts-node) subtrees)
- (subtrees
- `((,name ,(cons name marker) ,@subtrees)))
- (t
- `((,name . ,marker))))))
-
-(defun toml-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (table-tree (treesit-induce-sparse-tree
- node "^table$" nil 1000))
- (table-array-tree (treesit-induce-sparse-tree
- node "^table_array_element$" nil 1000))
- (table-index (toml-ts-mode--imenu-1 table-tree))
- (table-array-index (toml-ts-mode--imenu-1 table-array-tree)))
- (append
- (when table-index `(("Headers" . ,table-index)))
- (when table-array-index `(("Arrays" . ,table-array-index))))))
-
+(defun toml-ts-mode--defun-name (node)
+ "Return the defun name of NODE.
+Return nil if there is no name or if NODE is not a defun node."
+ (pcase (treesit-node-type node)
+ ((or "table" "table_array_element")
+ (or (treesit-node-text (treesit-node-child node 1) t)
+ "Root table"))))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))
@@ -167,6 +139,7 @@ the subtrees."
;; Navigation.
(setq-local treesit-defun-type-regexp
(rx (or "table" "table_array_element")))
+ (setq-local treesit-defun-name-function #'toml-ts-mode--defun-name)
;; Font-lock.
(setq-local treesit-font-lock-settings toml-ts-mode--font-lock-settings)
@@ -177,8 +150,9 @@ the subtrees."
(delimiter error)))
;; Imenu.
- (setq-local imenu-create-index-function #'toml-ts-mode--imenu)
- (setq-local which-func-functions nil) ;; Piggyback on imenu
+ (setq-local treesit-simple-imenu-settings
+ '(("Header" "\\`table\\'" nil nil)
+ ("Array" "\\`table_array_element\\'" nil nil)))
(treesit-major-mode-setup)))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 75330ac121..8f6354fde2 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2,6 +2,10 @@
;; Copyright (C) 2021-2022 Free Software Foundation, Inc.
+;; Maintainer: 付禹安 (Yuan Fu) <casouri@gmail.com>
+;; Keywords: treesit, tree-sitter, languages
+;; Package: emacs
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -32,6 +36,7 @@
(eval-when-compile (require 'subr-x)) ; For `string-join'.
(require 'cl-seq)
(require 'font-lock)
+(require 'seq)
;;; Function declarations
@@ -141,6 +146,9 @@ parser in `treesit-parser-list', or nil if there is no
parser."
;;; Node API supplement
+(define-error 'treesit-no-parser "No available parser for this buffer"
+ 'treesit-error)
+
(defun treesit-node-buffer (node)
"Return the buffer in which NODE belongs."
(treesit-parser-buffer
@@ -168,13 +176,14 @@ before POS.
Return nil if no leaf node can be returned. If NAMED is non-nil,
only look for named nodes.
-If PARSER-OR-LANG is nil, use the first parser in
-`treesit-parser-list'; if PARSER-OR-LANG is a parser, use
-that parser; if PARSER-OR-LANG is a language, find a parser using
-that language in the current buffer, and use that."
+If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG
+is a language, find the first parser for that language in the
+current buffer, or create one if none exists; If PARSER-OR-LANG
+is nil, try to guess the language at POS using `treesit-language-at'."
(let* ((root (if (treesit-parser-p parser-or-lang)
(treesit-parser-root-node parser-or-lang)
- (treesit-buffer-root-node parser-or-lang)))
+ (treesit-buffer-root-node
+ (or parser-or-lang (treesit-language-at pos)))))
(node root)
(node-before root)
(pos-1 (max (1- pos) (point-min)))
@@ -216,43 +225,51 @@ to use `treesit-node-at' instead.
Return nil if none was found. If NAMED is non-nil, only look for
named node.
-If PARSER-OR-LANG is nil, use the first parser in
-`treesit-parser-list'; if PARSER-OR-LANG is a parser, use
-that parser; if PARSER-OR-LANG is a language, find a parser using
-that language in the current buffer, and use that."
+If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG
+is a language, find the first parser for that language in the
+current buffer, or create one if none exists; If PARSER-OR-LANG
+is nil, try to guess the language at BEG using `treesit-language-at'."
(let ((root (if (treesit-parser-p parser-or-lang)
(treesit-parser-root-node parser-or-lang)
- (treesit-buffer-root-node parser-or-lang))))
+ (treesit-buffer-root-node
+ (or parser-or-lang (treesit-language-at beg))))))
(treesit-node-descendant-for-range root beg (or end beg) named)))
-(defun treesit-node-top-level (node &optional type)
+(defun treesit-node-top-level (node &optional pred include-node)
"Return the top-level equivalent of NODE.
+
Specifically, return the highest parent of NODE that has the same
type as it. If no such parent exists, return nil.
-If TYPE is non-nil, match each parent's type with TYPE as a
-regexp, rather than using NODE's type."
- (let ((type (or type (treesit-node-type node)))
+If PRED is non-nil, match each parent's type with PRED as a
+regexp, rather than using NODE's type. PRED can also be a
+function that takes the node as an argument, and return
+non-nil/nil for match/no match.
+
+If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
+ (let ((pred (or pred (treesit-node-type node)))
(result nil))
- (cl-loop for cursor = (treesit-node-parent node)
+ (cl-loop for cursor = (if include-node node
+ (treesit-node-parent node))
then (treesit-node-parent cursor)
while cursor
- if (string-match-p type (treesit-node-type cursor))
+ if (if (stringp pred)
+ (string-match-p pred (treesit-node-type cursor))
+ (funcall pred cursor))
do (setq result cursor))
result))
(defun treesit-buffer-root-node (&optional language)
"Return the root node of the current buffer.
-Use the first parser in `treesit-parser-list'.
-If optional argument LANGUAGE is non-nil, use the first parser
-for LANGUAGE."
+Use the first parser in the parser list if LANGUAGE is omitted.
+If LANGUAGE is non-nil, use the first parser for LANGUAGE in the
+parser list, or create one if none exists."
(if-let ((parser
- (or (if language
- (treesit-parser-create language)
- (or (car (treesit-parser-list))
- (signal 'treesit-error
- '("Buffer has no parser")))))))
+ (if language
+ (treesit-parser-create language)
+ (or (car (treesit-parser-list))
+ (signal 'treesit-no-parser (list (current-buffer)))))))
(treesit-parser-root-node parser)))
(defun treesit-filter-child (node pred &optional named)
@@ -282,11 +299,16 @@ properties."
(treesit-node-start node)
(treesit-node-end node))))))
-(defun treesit-parent-until (node pred)
+(defun treesit-parent-until (node pred &optional include-node)
"Return the closest parent of NODE that satisfies PRED.
+
Return nil if none was found. PRED should be a function that
-takes one argument, the parent node."
- (let ((node (treesit-node-parent node)))
+takes one argument, the parent node, and return non-nil/nil for
+match/no match.
+
+If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED."
+ (let ((node (if include-node node
+ (treesit-node-parent node))))
(while (and node (not (funcall pred node)))
(setq node (treesit-node-parent node)))
node))
@@ -301,8 +323,6 @@ takes one argument, the parent node."
node (treesit-node-parent node)))
last))
-(defalias 'treesit-traverse-parent #'treesit-parent-until)
-
(defun treesit-node-children (node &optional named)
"Return a list of NODE's children.
If NAMED is non-nil, collect named child only."
@@ -859,7 +879,7 @@ LIMIT is the recursion limit, which defaults to 100."
(push child result))
(setq child (treesit-node-next-sibling child)))
;; If NODE has no child, keep NODE.
- (or result node)))
+ (or result (list node))))
(defsubst treesit--node-length (node)
"Return the length of the text of NODE."
@@ -1107,6 +1127,22 @@ See `treesit-simple-indent-presets'.")
(re-search-forward comment-start-skip)
(skip-syntax-backward "-")
(point))))
+ (cons 'prev-adaptive-prefix
+ (lambda (_n parent &rest _)
+ (save-excursion
+ (re-search-backward
+ (rx (not (or " " "\t" "\n"))) nil t)
+ (beginning-of-line)
+ (and (>= (point) (treesit-node-start parent))
+ ;; `adaptive-fill-regexp' will not match "/*",
+ ;; so we need to also try `comment-start-skip'.
+ (or (and adaptive-fill-regexp
+ (looking-at adaptive-fill-regexp)
+ (> (- (match-end 0) (match-beginning 0)) 0)
+ (match-end 0))
+ (and comment-start-skip
+ (looking-at comment-start-skip)
+ (match-end 0)))))))
;; TODO: Document.
(cons 'grand-parent
(lambda (_n parent &rest _)
@@ -1229,7 +1265,14 @@ comment-start
Goes to the position that `comment-start-skip' would return,
skips whitespace backwards, and returns the resulting
- position. Assumes PARENT is a comment node.")
+ position. Assumes PARENT is a comment node.
+
+prev-adaptive-prefix
+
+ Goes to the beginning of previous non-empty line, and tries
+ to match `adaptive-fill-regexp'. If it matches, return the
+ end of the match, otherwise return nil. This is useful for a
+ `indent-relative'-like indent behavior for block comments.")
(defun treesit--simple-indent-eval (exp)
"Evaluate EXP.
@@ -1555,7 +1598,61 @@ BACKWARD and ALL are the same as in
`treesit-search-forward'."
(goto-char current-pos)))
node))
-;;; Navigation
+(defun treesit-transpose-sexps (&optional arg)
+ "Tree-sitter `transpose-sexps' function.
+Arg is the same as in `transpose-sexps'.
+
+Locate the node closest to POINT, and transpose that node with
+its sibling node ARG nodes away.
+
+Return a pair of positions as described by
+`transpose-sexps-function' for use in `transpose-subr' and
+friends."
+ (let* ((parent (treesit-node-parent (treesit-node-at (point))))
+ (child (treesit-node-child parent 0 t)))
+ (named-let loop ((prev child)
+ (next (treesit-node-next-sibling child t)))
+ (when (and prev next)
+ (if (< (point) (treesit-node-end next))
+ (if (= arg -1)
+ (cons (treesit-node-start prev)
+ (treesit-node-end prev))
+ (when-let ((n (treesit-node-child
+ parent (+ arg (treesit-node-index prev t)) t)))
+ (cons (treesit-node-end n)
+ (treesit-node-start n))))
+ (loop (treesit-node-next-sibling prev t)
+ (treesit-node-next-sibling next t)))))))
+
+;;; Navigation, defun, things
+;;
+;; Emacs lets you define "things" by a regexp that matches the type of
+;; a node, and here are some functions that lets you find the "things"
+;; at/around point, navigate backward/forward a "thing", etc.
+;;
+;; The most obvious "thing" is a defun, and there are thin wrappers
+;; around thing functions for defun for convenience.
+;;
+;; We have more command-like functions like:
+;; - treesit-beginning-of-thing/defun
+;; - treesit-end-of-thing/defun
+;; - treesit-thing/defun-at-point
+;;
+;; And more generic functions like:
+;; - treesit--things-around
+;; - treesit--top-level-thing
+;; - treesit--navigate-thing
+;;
+;; There are also some defun-specific functions, like
+;; treesit-defun-name, treesit-add-log-current-defun.
+;;
+;; TODO: I'm not entirely sure how would this go, so I only documented
+;; the "defun" functions and didn't document any "thing" functions.
+;; We should also document `treesit-block-type-regexp' and support it
+;; in major modes if we can meaningfully intergrate hideshow: I tried
+;; and failed, we need SomeOne that understands hideshow to look at
+;; it. (BTW, hideshow should use its own
+;; `treesit-hideshow-block-type-regexp'.)
(defvar-local treesit-defun-type-regexp nil
"A regexp that matches the node type of defun nodes.
@@ -1563,12 +1660,15 @@ For example, \"(function|class)_definition\".
Sometimes not all nodes matched by the regexp are valid defuns.
In that case, set this variable to a cons cell of the
-form (REGEXP . FILTER), where FILTER is a function that takes a
+form (REGEXP . PRED), where PRED is a function that takes a
node (the matched node) and returns t if node is valid, or nil
for invalid node.
This is used by `treesit-beginning-of-defun' and friends.")
+(defvar-local treesit-block-type-regexp nil
+ "Like `treesit-defun-type-regexp', but for blocks.")
+
(defvar-local treesit-defun-tactic 'nested
"Determines how does Emacs treat nested defuns.
If the value is `top-level', Emacs only moves across top-level
@@ -1583,6 +1683,58 @@ newline after a defun, or the beginning of a defun.
If the value is nil, no skipping is performed.")
+(defvar-local treesit-defun-name-function nil
+ "A function that is called with a node and returns its defun name or nil.
+If the node is a defun node, return the defun name, e.g., the
+function name of a function. If the node is not a defun node, or
+the defun node doesn't have a name, or the node is nil, return
+nil.")
+
+(defvar-local treesit-add-log-defun-delimiter "."
+ "The delimiter used to connect several defun names.
+This is used in `treesit-add-log-current-defun'.")
+
+(defsubst treesit--thing-unpack-pattern (pattern)
+ "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)
+ "Like `beginning-of-defun', but generalized into things.
+
+PATTERN is like `treesit-defun-type-regexp', ARG
+is the same as in `beginning-of-defun'.
+
+Return non-nil if successfully moved, nil otherwise."
+ (pcase-let* ((arg (or arg 1))
+ (`(,regexp . ,pred) (treesit--thing-unpack-pattern
+ pattern))
+ (dest (treesit--navigate-thing
+ (point) (- arg) 'beg regexp pred)))
+ (when dest
+ (goto-char dest))))
+
+(defun treesit-end-of-thing (pattern &optional arg)
+ "Like `end-of-defun', but generalized into things.
+
+PATTERN is like `treesit-defun-type-regexp', ARG is the same as
+in `end-of-defun'.
+
+Return non-nil if successfully moved, nil otherwise."
+ (pcase-let* ((arg (or arg 1))
+ (`(,regexp . ,pred) (treesit--thing-unpack-pattern
+ pattern))
+ (dest (treesit--navigate-thing
+ (point) arg 'end regexp pred)))
+ (when dest
+ (goto-char dest))))
+
(defun treesit-beginning-of-defun (&optional arg)
"Move backward to the beginning of a defun.
@@ -1595,9 +1747,7 @@ This is a tree-sitter equivalent of `beginning-of-defun'.
Behavior of this function depends on `treesit-defun-type-regexp'
and `treesit-defun-skipper'."
(interactive "^p")
- (when-let* ((arg (or arg 1))
- (dest (treesit--navigate-defun (point) (- arg) 'beg)))
- (goto-char dest)
+ (when (treesit-beginning-of-thing treesit-defun-type-regexp arg)
(when treesit-defun-skipper
(funcall treesit-defun-skipper))
t))
@@ -1612,9 +1762,7 @@ This is a tree-sitter equivalent of `end-of-defun'.
Behavior of
this function depends on `treesit-defun-type-regexp' and
`treesit-defun-skipper'."
(interactive "^p\nd")
- (when-let* ((arg (or arg 1))
- (dest (treesit--navigate-defun (point) arg 'end)))
- (goto-char dest)
+ (when (treesit-end-of-thing treesit-defun-type-regexp arg)
(when treesit-defun-skipper
(funcall treesit-defun-skipper))))
@@ -1632,13 +1780,17 @@ comments and multiline string literals. For example,
This function tries to move to the beginning of a line, either by
moving to the empty newline after a defun, or to the beginning of
the current line if the beginning of the defun is indented."
- (cond ((and (looking-at (rx (* (or " " "\\t")) "\n"))
- (not (looking-at (rx bol))))
- (goto-char (match-end 0)))
- ((save-excursion
- (skip-chars-backward " \t")
- (eq (point) (line-beginning-position)))
- (goto-char (line-beginning-position)))))
+ ;; Moving forward, point at the end of a line and not already on an
+ ;; empty line: go to BOL of the next line (which hopefully is an
+ ;; empty line).
+ (cond ((and (looking-at (rx (* (or " " "\t")) "\n"))
+ (not (bolp)))
+ (forward-line 1))
+ ;; Moving backward, but there are some whitespace (and only
+ ;; whitespace) between point and BOL: go back to BOL.
+ ((looking-back (rx (+ (or " " "\t")))
+ (line-beginning-position))
+ (beginning-of-line))))
;; prev-sibling:
;; 1. end-of-node before pos
@@ -1651,88 +1803,77 @@ the current line if the beginning of the defun is
indented."
;; parent:
;; 1. node covers pos
;; 2. smallest such node
-(defun treesit--defuns-around (pos regexp &optional pred)
- "Return the previous, next, and parent defun around POS.
+(defun treesit--things-around (pos regexp &optional pred)
+ "Return the previous, next, and parent thing around POS.
Return a list of (PREV NEXT PARENT), where PREV and NEXT are
-previous and next sibling defuns around POS, and PARENT is the
-parent defun surrounding POS. All of three could be nil if no
-sound defun exists.
+previous and next sibling things around POS, and PARENT is the
+parent thing surrounding POS. All of three could be nil if no
+sound things exists.
-REGEXP and PRED are the same as in `treesit-defun-type-regexp'."
+REGEXP and PRED are the same as in `treesit-thing-at-point'."
(let* ((node (treesit-node-at pos))
- ;; NODE-BEFORE/AFTER = NODE when POS is completely in NODE,
- ;; but if not, that means point could be in between two
- ;; defun, in that case we want to use a node that's actually
- ;; before/after point.
- (node-before (if (>= (treesit-node-start node) pos)
- (save-excursion
- (treesit-search-forward-goto node "" t t t))
- node))
- (node-after (if (<= (treesit-node-end node) pos)
- (save-excursion
- (treesit-search-forward-goto
- node "" nil nil t))
- node))
- (result (list nil nil nil))
- (pred (or pred (lambda (_) t))))
+ (result (list nil nil nil)))
;; 1. Find previous and next sibling defuns.
(cl-loop
for idx from 0 to 1
- for node in (list node-before node-after)
for backward in '(t nil)
+ ;; Make sure we go in the right direction, and the defun we find
+ ;; doesn't cover POS.
for pos-pred in (list (lambda (n) (<= (treesit-node-end n) pos))
(lambda (n) (>= (treesit-node-start n) pos)))
- ;; If point is inside a defun, our process below will never
- ;; return a next/prev sibling outside of that defun, effectively
- ;; any prev/next sibling is locked inside the smallest defun
- ;; covering point, which is the correct behavior. That's because
- ;; when there exists a defun that covers point,
- ;; `treesit-search-forward' will first reach that defun, after
- ;; that we only go upwards in the tree, so other defuns outside
- ;; of the covering defun is never reached. (Don't use
- ;; `treesit-search-forward-goto' as it breaks when NODE-AFTER is
- ;; the last token of a parent defun: it will skip the parent
- ;; defun because it wants to ensure progress.)
- do (cl-loop for cursor = (when node
- (save-excursion
- (treesit-search-forward
- node regexp backward backward)))
- then (treesit-node-parent cursor)
- while cursor
- if (and (string-match-p
- regexp (treesit-node-type cursor))
- (funcall pred cursor)
- (funcall pos-pred cursor))
- do (setf (nth idx result) cursor)))
+ ;; We repeatedly find next defun candidate with
+ ;; `treesit-search-forward', and check if it is a valid defun,
+ ;; until the node we find covers POS, meaning we've gone through
+ ;; every possible sibling defuns. But there is a catch:
+ ;; `treesit-search-forward' searches bottom-up, so for each
+ ;; candidate we need to go up the tree and find the top-most
+ ;; valid sibling, this defun will be at the same level as POS.
+ ;; Don't use `treesit-search-forward-goto', it skips nodes in
+ ;; order to enforce progress.
+ when node
+ do (let ((cursor node)
+ (iter-pred (lambda (node)
+ (and (string-match-p
+ regexp (treesit-node-type node))
+ (or (null pred) (funcall pred node))
+ (funcall pos-pred node)))))
+ ;; Find the node just before/after POS to start searching.
+ (save-excursion
+ (while (and cursor (not (funcall pos-pred cursor)))
+ (setq cursor (treesit-search-forward-goto
+ cursor "" backward backward t))))
+ ;; Keep searching until we run out of candidates.
+ (while (and cursor
+ (funcall pos-pred cursor)
+ (null (nth idx result)))
+ (setf (nth idx result)
+ (treesit-node-top-level cursor iter-pred t))
+ (setq cursor (treesit-search-forward
+ cursor regexp backward backward)))))
;; 2. Find the parent defun.
- (setf (nth 2 result)
- (cl-loop for cursor = (or (nth 0 result)
- (nth 1 result)
- node)
- then (treesit-node-parent cursor)
- while cursor
- if (and (string-match-p
- regexp (treesit-node-type cursor))
- (funcall pred cursor)
- (not (member cursor result)))
- return cursor))
+ (let ((cursor (or (nth 0 result) (nth 1 result) node))
+ (iter-pred (lambda (node)
+ (and (string-match-p
+ 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 1 result)))
+ (< (treesit-node-start node)
+ pos
+ (treesit-node-end node))))))
+ (setf (nth 2 result)
+ (treesit-parent-until cursor iter-pred)))
result))
-(defun treesit--top-level-defun (node regexp &optional pred)
- "Return the top-level parent defun of NODE.
-REGEXP and PRED are the same as in `treesit-defun-type-regexp'."
- (let* ((pred (or pred (lambda (_) t))))
- ;; `treesit-search-forward-goto' will make sure the matched node
- ;; is before POS.
- (cl-loop for cursor = node
- then (treesit-node-parent cursor)
- while cursor
- if (and (string-match-p
- regexp (treesit-node-type cursor))
- (funcall pred cursor))
- do (setq node cursor))
- node))
+(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
;; move across sibling defuns in the same level, if no more siblings
@@ -1761,25 +1902,23 @@ REGEXP and PRED are the same as in
`treesit-defun-type-regexp'."
;; -> 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
;; in the function to do that.
-(defun treesit--navigate-defun (pos arg side &optional recursing)
- "Navigate defun ARG steps from POS.
+(defun treesit--navigate-thing (pos arg side regexp &optional pred recursing)
+ "Navigate thing ARG steps from POS.
If ARG is positive, move forward that many steps, if negative,
move backward. If SIDE is `beg', stop at the beginning of a
-defun, if SIDE is `end', stop at the end.
+thing, if SIDE is `end', stop at the end.
This function doesn't actually move point, it just returns the
-position it would move to. If there aren't enough defuns to move
+position it would move to. If there aren't enough things to move
across, return nil.
+REGEXP and PRED are the same as in `treesit-thing-at-point'.
+
RECURSING is an internal parameter, if non-nil, it means this
function is called recursively."
(pcase-let*
((counter (abs arg))
- (`(,regexp . ,pred)
- (if (consp treesit-defun-type-regexp)
- treesit-defun-type-regexp
- (cons treesit-defun-type-regexp nil)))
;; Move POS to the beg/end of NODE. If NODE is nil, terminate.
;; Return the position we moved to.
(advance (lambda (node)
@@ -1793,13 +1932,13 @@ function is called recursively."
(while (> counter 0)
(pcase-let
((`(,prev ,next ,parent)
- (treesit--defuns-around pos regexp pred)))
+ (treesit--things-around pos regexp pred)))
;; When PARENT is nil, nested and top-level are the same, if
;; there is a PARENT, make PARENT to be the top-level parent
;; and pretend there is no nested PREV and NEXT.
(when (and (eq treesit-defun-tactic 'top-level)
parent)
- (setq parent (treesit--top-level-defun
+ (setq parent (treesit--top-level-thing
parent regexp pred)
prev nil
next nil))
@@ -1820,9 +1959,9 @@ function is called recursively."
;; (recursing) until we got out of the parents until
;; (1) there is a next sibling defun, or (2) no more
;; parents [2].
- (setq pos (or (treesit--navigate-defun
+ (setq pos (or (treesit--navigate-thing
(treesit-node-end (or next parent))
- 1 'beg t)
+ 1 'beg regexp pred t)
(throw 'term nil)))
;; Normal case.
(setq pos (funcall advance (or next parent))))
@@ -1832,9 +1971,9 @@ function is called recursively."
(parent t)
(t nil)))
;; Special case: go to prev end-of-defun.
- (setq pos (or (treesit--navigate-defun
+ (setq pos (or (treesit--navigate-thing
(treesit-node-start (or prev parent))
- -1 'end t)
+ -1 'end regexp pred t)
(throw 'term nil)))
;; Normal case.
(setq pos (funcall advance (or prev parent)))))
@@ -1844,28 +1983,157 @@ function is called recursively."
(if (eq counter 0) pos nil)))
;; TODO: In corporate into thing-at-point.
-(defun treesit-defun-at-point ()
- "Return the defun at point or nil if none is found.
+(defun treesit-thing-at-point (pattern tactic)
+ "Return the thing node at point or nil if none is found.
-Respects `treesit-defun-tactic': return the top-level defun if it
-is `top-level', return the immediate parent defun if it is
-`nested'."
+\"Thing\" is defined by PATTERN, which can be either a string
+REGEXP or a cons cell (REGEXP . PRED): if a node's type matches
+REGEXP, it is a thing. The \"thing\" could be further restricted
+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
+immediate parent thing if TACTIC is `nested'."
(pcase-let* ((`(,regexp . ,pred)
- (if (consp treesit-defun-type-regexp)
- treesit-defun-type-regexp
- (cons treesit-defun-type-regexp nil)))
+ (treesit--thing-unpack-pattern pattern))
(`(,_ ,next ,parent)
- (treesit--defuns-around (point) regexp pred))
- ;; If point is at the beginning of a defun, we
- ;; prioritize that defun over the parent in nested
+ (treesit--things-around (point) regexp pred))
+ ;; If point is at the beginning of a thing, we
+ ;; prioritize that thing over the parent in nested
;; mode.
(node (or (and (eq (treesit-node-start next) (point))
next)
parent)))
- (if (eq treesit-defun-tactic 'top-level)
- (treesit--top-level-defun node regexp pred)
+ (if (eq tactic 'top-level)
+ (treesit--top-level-thing node regexp pred)
node)))
+(defun treesit-defun-at-point ()
+ "Return the defun node at point or nil if none is found.
+
+Respects `treesit-defun-tactic': return the top-level defun if it
+is `top-level', return the immediate parent defun if it is
+`nested'.
+
+Return nil if `treesit-defun-type-regexp' is not set."
+ (when treesit-defun-type-regexp
+ (treesit-thing-at-point
+ treesit-defun-type-regexp treesit-defun-tactic)))
+
+(defun treesit-defun-name (node)
+ "Return the defun name of NODE.
+
+Return nil if there is no name, or if NODE is not a defun node,
+or if NODE is nil.
+
+If `treesit-defun-name-function' is nil, always return nil."
+ (when treesit-defun-name-function
+ (funcall treesit-defun-name-function node)))
+
+(defun treesit-add-log-current-defun ()
+ "Return the name of the defun at point.
+
+Used for `add-log-current-defun-function'.
+
+The delimiter between nested defun names is controlled by
+`treesit-add-log-defun-delimiter'."
+ (let ((node (treesit-defun-at-point))
+ (name nil))
+ (while node
+ (when-let ((new-name (treesit-defun-name node)))
+ (if name
+ (setq name (concat new-name
+ treesit-add-log-defun-delimiter
+ name))
+ (setq name new-name)))
+ (setq node (treesit-node-parent node)))
+ name))
+
+;;; Imenu
+
+(defvar treesit-simple-imenu-settings nil
+ "Settings that configure `treesit-simple-imenu'.
+
+It should be a list of (CATEGORY REGEXP PRED NAME-FN).
+
+CATEGORY is the name of a category, like \"Function\", \"Class\",
+etc. REGEXP should be a regexp matching the type of nodes that
+belong to CATEGORY. PRED should be either nil or a function
+that takes a node an the argument. It should return non-nil if
+the node is a valid node for CATEGORY, or nil if not.
+
+CATEGORY could also be nil. In that case the entries matched by
+REGEXP and PRED are not grouped under CATEGORY.
+
+NAME-FN should be either nil or a function that takes a defun
+node and returns the name of that defun node. If NAME-FN is nil,
+`treesit-defun-name' is used.
+
+`treesit-major-mode-setup' automatically sets up Imenu if this
+variable is non-nil.")
+
+(defun treesit--simple-imenu-1 (node pred name-fn)
+ "Given a sparse tree, create an Imenu index.
+
+NODE is a node in the tree returned by
+`treesit-induce-sparse-tree' (not a tree-sitter node, its car is
+a tree-sitter node). Walk that tree and return an Imenu index.
+
+Return a list of entries where each ENTRY has the form:
+
+ENTRY := (NAME . MARKER)
+ | (NAME . ((\" \" . MARKER)
+ ENTRY
+ ...)
+
+PRED and NAME-FN are the same as described in
+`treesit-simple-imenu-settings'. NAME-FN computes NAME in an
+ENTRY. MARKER marks the start of each tree-sitter node."
+ (let* ((ts-node (car node))
+ (children (cdr node))
+ (subtrees (mapcan (lambda (node)
+ (treesit--simple-imenu-1 node pred name-fn))
+ children))
+ ;; The root of the tree could have a nil ts-node.
+ (name (when ts-node
+ (or (if name-fn
+ (funcall name-fn ts-node)
+ (treesit-defun-name ts-node))
+ "Anonymous")))
+ (marker (when ts-node
+ (set-marker (make-marker)
+ (treesit-node-start ts-node)))))
+ (cond
+ ;; The tree-sitter node in the root node of the tree returned by
+ ;; `treesit-induce-sparse-tree' is often nil.
+ ((null ts-node)
+ subtrees)
+ ;; This tree-sitter node is not a valid entry, skip it.
+ ((and pred (not (funcall pred ts-node)))
+ subtrees)
+ ;; Non-leaf node, return a (list of) subgroup.
+ (subtrees
+ `((,name
+ ,(cons " " marker)
+ ,@subtrees)))
+ ;; Leaf node, return a (list of) plain index entry.
+ (t (list (cons name marker))))))
+
+(defun treesit-simple-imenu ()
+ "Return an Imenu index for the current buffer."
+ (let ((root (treesit-buffer-root-node)))
+ (mapcan (lambda (setting)
+ (pcase-let ((`(,category ,regexp ,pred ,name-fn)
+ setting))
+ (when-let* ((tree (treesit-induce-sparse-tree
+ root regexp))
+ (index (treesit--simple-imenu-1
+ tree pred name-fn)))
+ (if category
+ (list (cons category index))
+ index))))
+ treesit-simple-imenu-settings)))
+
;;; Activating tree-sitter
(defun treesit-ready-p (language &optional quiet)
@@ -1896,7 +2164,7 @@ instead of emitting a warning."
(pcase-let ((`(,available . ,err)
(treesit-language-available-p lang t)))
(when (not available)
- (setq msg (format "language definition for %s is unavailable (%s):
%s"
+ (setq msg (format "language grammar for %s is unavailable (%s): %s"
lang (nth 0 err)
(string-join
(mapcar (lambda (x) (format "%s" x))
@@ -1923,6 +2191,11 @@ If `treesit-simple-indent-rules' is non-nil, setup
indentation.
If `treesit-defun-type-regexp' is non-nil, setup
`beginning/end-of-defun' functions.
+If `treesit-defun-name-function' is non-nil, setup
+`add-log-current-defun'.
+
+If `treesit-simple-imenu-settings' is non-nil, setup Imenu.
+
Make sure necessary parsers are created for the current buffer
before calling this function."
;; Font-lock.
@@ -1959,7 +2232,18 @@ before calling this function."
;; the variables. In future we should update `end-of-defun' to
;; work with nested defuns.
(setq-local beginning-of-defun-function #'treesit-beginning-of-defun)
- (setq-local end-of-defun-function #'treesit-end-of-defun)))
+ (setq-local end-of-defun-function #'treesit-end-of-defun))
+ ;; Defun name.
+ (when treesit-defun-name-function
+ (setq-local add-log-current-defun-function
+ #'treesit-add-log-current-defun))
+
+ (setq-local transpose-sexps-function #'treesit-transpose-sexps)
+
+ ;; Imenu.
+ (when treesit-simple-imenu-settings
+ (setq-local imenu-create-index-function
+ #'treesit-simple-imenu)))
;;; Debugging
@@ -2027,7 +2311,7 @@ When this mode is enabled, the mode-line displays
where NODE, CHILD, etc, are nodes which begin at point. PARENT
is the parent of NODE. NODE is displayed in bold typeface.
FIELD-NAMEs are field names of NODE and CHILD, etc (see Info
-node `(elisp)Language Definitions', heading \"Field names\").
+node `(elisp)Language Grammar', heading \"Field names\").
If no node starts at point, i.e., point is in the middle of a
node, then the mode line displays the earliest node that spans point,
@@ -2366,6 +2650,143 @@ window."
#'treesit--explorer-post-command t)
(kill-buffer treesit--explorer-buffer)))
+;;; Install & build language grammar
+
+(defvar treesit-language-source-alist nil
+ "Configures how to download tree-sitter language grammars.
+This should be an alist of
+
+ (LANG . (URL SOURCE-DIR GRAMMAR-DIR CC C++))
+
+Only LANG and URL are mandatory. LANG is the language symbol.
+URL is the repository's url.
+
+SOURCE-DIR is the relative directory in the repository in which
+the grammar.c file resides, default to \"src\".
+
+GRAMMAR-DIR is the relative grammar directory in the repository
+in which the grammar.js file resides, default to \"\".
+
+CC and C++ are C and C++ compilers, default to \"cc\" and
+\"c++\", respectively.")
+
+(defun treesit-install-language-grammar (lang)
+ "Build and install the tree-sitter language grammar library for LANG.
+
+This command requires Git, a C compiler and (sometimes) a C++ compiler,
+and the linker to be installed and on PATH. It also requires that the
+recipe for LANG exists in `treesit-language-source-alist'.
+
+See `exec-path' for the current path where Emacs looks for
+executable programs, such as the C/C++ compiler and linker."
+ (interactive (list (intern
+ (completing-read
+ "Language: "
+ (mapcar #'car treesit-language-source-alist)
+ nil t))))
+ (condition-case err
+ (apply #'treesit--install-language-grammar-1
+ ;; The nil is OUT-DIR.
+ (cons nil (assoc lang treesit-language-source-alist)))
+ (error
+ (display-warning
+ 'treesit
+ (format "Error encountered when installing language grammar: %s"
+ err))))
+ ;; Check that the installed language grammar is loadable.
+ (pcase-let ((`(,available . ,err)
+ (treesit-language-available-p lang t)))
+ (when (not available)
+ (display-warning
+ 'treesit
+ (format "The installed language grammar for %s cannot be located or has
problems (%s): %s"
+ lang (nth 0 err)
+ (string-join
+ (mapcar (lambda (x) (format "%s" x))
+ (cdr err))
+ " "))))))
+
+(defun treesit--call-process-signal (&rest args)
+ "Run `call-process' with ARGS.
+If it returns anything but 0, signal an error. Use the buffer
+content as signal data, and erase buffer afterwards."
+ (unless (eq 0 (apply #'call-process args))
+ (signal 'treesit-error (list "Command:"
+ (string-join (cons (car args)
+ (nthcdr 4 args))
+ " ")
+ "Error output:"
+ (buffer-string)))
+ (erase-buffer)))
+
+(defun treesit--install-language-grammar-1
+ (out-dir lang url &optional source-dir grammar-dir cc c++)
+ "Install and compile a tree-sitter language grammar library.
+
+OUT-DIR is the directory to put the compiled library file. If it
+is nil, the \"tree-sitter\" directory under user's Emacs
+configuration directory is used (and automatically created if not
+exist).
+
+For LANG, URL, SOURCE-DIR, GRAMMAR-DIR, CC, C++, see
+`treesit-language-source-alist'. If anything goes wrong, this
+function signals an error."
+ (let* ((lang (symbol-name lang))
+ (default-directory (make-temp-file "treesit-workdir" t))
+ (workdir (expand-file-name "repo"))
+ (source-dir (expand-file-name (or source-dir "src") workdir))
+ (grammar-dir (expand-file-name (or grammar-dir "") workdir))
+ (cc (or cc (seq-find #'executable-find '("cc" "gcc" "c99"))
+ ;; If no C compiler found, just use cc and let
+ ;; `call-process' signal the error.
+ "cc"))
+ (c++ (or c++ (seq-find #'executable-find '("c++" "g++"))
+ "c++"))
+ (soext (or (car dynamic-library-suffixes)
+ (signal 'treesit-error '("Emacs cannot figure out the file
extension for dynamic libraries for this system, because
`dynamic-library-suffixes' is nil"))))
+ (out-dir (or (and out-dir (expand-file-name out-dir))
+ (locate-user-emacs-file "tree-sitter")))
+ (lib-name (concat "libtree-sitter-" lang soext)))
+ (unwind-protect
+ (with-temp-buffer
+ (message "Cloning repository")
+ ;; git clone xxx --depth 1 --quiet workdir
+ (treesit--call-process-signal
+ "git" nil t nil "clone" url "--depth" "1" "--quiet"
+ workdir)
+ ;; cp "${grammardir}"/grammar.js "${sourcedir}"
+ (copy-file (expand-file-name "grammar.js" grammar-dir)
+ (expand-file-name "grammar.js" source-dir)
+ t t)
+ ;; cd "${sourcedir}"
+ (setq default-directory source-dir)
+ (message "Compiling library")
+ ;; cc -fPIC -c -I. parser.c
+ (treesit--call-process-signal
+ cc nil t nil "-fPIC" "-c" "-I." "parser.c")
+ ;; cc -fPIC -c -I. scanner.c
+ (when (file-exists-p "scanner.c")
+ (treesit--call-process-signal
+ cc nil t nil "-fPIC" "-c" "-I." "scanner.c"))
+ ;; c++ -fPIC -I. -c scanner.cc
+ (when (file-exists-p "scanner.cc")
+ (treesit--call-process-signal
+ c++ nil t nil "-fPIC" "-c" "-I." "scanner.cc"))
+ ;; cc/c++ -fPIC -shared *.o -o "libtree-sitter-${lang}.${soext}"
+ (apply #'treesit--call-process-signal
+ (if (file-exists-p "scanner.cc") c++ cc)
+ nil t nil
+ `("-fPIC" "-shared"
+ ,@(directory-files
+ default-directory nil
+ (rx bos (+ anychar) ".o" eos))
+ "-o" ,lib-name))
+ ;; Copy out.
+ (copy-file lib-name (file-name-as-directory out-dir) t t)
+ (message "Library installed to %s/%s" out-dir lib-name))
+ (when (file-exists-p workdir)
+ (delete-directory workdir t)))))
+
;;; Etc
(declare-function find-library-name "find-func.el")
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index 357ce001b3..b80337eb74 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -272,8 +272,7 @@ and hunk-based syntax highlighting otherwise as a fallback."
(defcustom diff-minor-mode-prefix "\C-c="
"Prefix key for `diff-minor-mode' commands."
- :type '(choice (string "ESC")
- (string "\C-c=") string))
+ :type '(choice (string "\e") (string "\C-c=") string))
(defvar-keymap diff-minor-mode-map
:doc "Keymap for `diff-minor-mode'. See also `diff-mode-shared-map'."
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 558be1841a..7a30274a33 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1014,34 +1014,11 @@ See also `whitespace-newline' and
`whitespace-display-mappings'."
;;;###autoload
-(define-minor-mode global-whitespace-mode
- "Toggle whitespace visualization globally (Global Whitespace mode).
-
-See also `whitespace-style', `whitespace-newline' and
-`whitespace-display-mappings'."
- :lighter " WS"
+(define-globalized-minor-mode global-whitespace-mode
+ whitespace-mode
+ whitespace-turn-on-if-enabled
:init-value nil
- :global t
- :group 'whitespace
- (cond
- (noninteractive ; running a batch job
- (setq global-whitespace-mode nil))
- (global-whitespace-mode ; global-whitespace-mode on
- (save-current-buffer
- (add-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
- (add-hook 'after-change-major-mode-hook 'whitespace-turn-on-if-enabled)
- (dolist (buffer (buffer-list)) ; adjust all local mode
- (set-buffer buffer)
- (unless whitespace-mode
- (whitespace-turn-on-if-enabled)))))
- (t ; global-whitespace-mode off
- (save-current-buffer
- (remove-hook 'find-file-hook 'whitespace-turn-on-if-enabled)
- (remove-hook 'after-change-major-mode-hook
'whitespace-turn-on-if-enabled)
- (dolist (buffer (buffer-list)) ; adjust all local mode
- (set-buffer buffer)
- (unless whitespace-mode
- (whitespace-turn-off)))))))
+ :group 'whitespace)
(defvar whitespace-enable-predicate
(lambda ()
@@ -1067,7 +1044,7 @@ This variable is normally modified via `add-function'.")
(defun whitespace-turn-on-if-enabled ()
(when (funcall whitespace-enable-predicate)
- (whitespace-turn-on)))
+ (whitespace-mode)))
;;;###autoload
(define-minor-mode global-whitespace-newline-mode
@@ -2511,7 +2488,7 @@ purposes)."
(setq whitespace-display-table-was-local t)
;; Save the old table so we can restore it when
;; `whitespace-mode' is switched off again.
- (when (or whitespace-mode global-whitespace-mode)
+ (when whitespace-mode
(setq whitespace-display-table
(copy-sequence buffer-display-table)))
;; Assure `buffer-display-table' is unique
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index d17cbec58c..8f5cc1617a 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -105,14 +105,10 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
#endif
-#ifdef __has_c_attribute
-# if ((defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710 \
- && _GL_GNUC_PREREQ (4, 6))
-# pragma GCC diagnostic ignored "-Wpedantic"
-# endif
-# define _GL_HAS_C_ATTRIBUTE(attr) __has_c_attribute (__##attr##__)
-#else
-# define _GL_HAS_C_ATTRIBUTE(attr) 0
+/* Disable GCC -Wpedantic if using __has_c_attribute and this is not C23+. */
+#if (defined __has_c_attribute && _GL_GNUC_PREREQ (4, 6) \
+ && (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710)
+# pragma GCC diagnostic ignored "-Wpedantic"
#endif
]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's alignas instead.
@@ -202,11 +198,15 @@ AC_DEFUN([gl_COMMON_BODY], [
- enumeration, enumeration item,
- typedef,
in C++ also: namespace, class, template specialization. */
-#if _GL_HAS_C_ATTRIBUTE (deprecated)
-# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]]
-#elif _GL_HAS_ATTRIBUTE (deprecated)
+#ifdef __has_c_attribute
+# if __has_c_attribute (__deprecated__)
+# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]]
+# endif
+#endif
+#if !defined _GL_ATTRIBUTE_DEPRECATED && _GL_HAS_ATTRIBUTE (deprecated)
# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
-#else
+#endif
+#ifndef _GL_ATTRIBUTE_DEPRECATED
# define _GL_ATTRIBUTE_DEPRECATED
#endif
@@ -240,11 +240,15 @@ AC_DEFUN([gl_COMMON_BODY], [
'default' label. The compiler should not warn in this case. */
/* Applies to: Empty statement (;), inside a 'switch' statement. */
/* Always expands to something. */
-#if _GL_HAS_C_ATTRIBUTE (fallthrough)
-# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]]
-#elif _GL_HAS_ATTRIBUTE (fallthrough)
+#ifdef __has_c_attribute
+# if __has_c_attribute (__fallthrough__)
+# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]]
+# endif
+#endif
+#if !defined _GL_ATTRIBUTE_FALLTHROUGH && _GL_HAS_ATTRIBUTE (fallthrough)
# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__))
-#else
+#endif
+#ifndef _GL_ATTRIBUTE_FALLTHROUGH
# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0)
#endif
@@ -308,9 +312,12 @@ AC_DEFUN([gl_COMMON_BODY], [
/* In C++ and C2x, this is spelled [[__maybe_unused__]].
GCC's syntax is __attribute__ ((__unused__)).
clang supports both syntaxes. */
-#if _GL_HAS_C_ATTRIBUTE (maybe_unused)
-# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
-#else
+#ifdef __has_c_attribute
+# if __has_c_attribute (__maybe_unused__)
+# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
+# endif
+#endif
+#ifndef _GL_ATTRIBUTE_MAYBE_UNUSED
# define _GL_ATTRIBUTE_MAYBE_UNUSED _GL_ATTRIBUTE_UNUSED
#endif
/* Alternative spelling of this macro, for convenience and for
@@ -323,11 +330,15 @@ AC_DEFUN([gl_COMMON_BODY], [
discard the return value. The compiler may warn if the caller does not use
the return value, unless the caller uses something like ignore_value. */
/* Applies to: function, enumeration, class. */
-#if _GL_HAS_C_ATTRIBUTE (nodiscard)
-# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
-#elif _GL_HAS_ATTRIBUTE (warn_unused_result)
+#ifdef __has_c_attribute
+# if __has_c_attribute (__nodiscard__)
+# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
+# endif
+#endif
+#if !defined _GL_ATTRIBUTE_NODISCARD && _GL_HAS_ATTRIBUTE (warn_unused_result)
# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__))
-#else
+#endif
+#ifndef _GL_ATTRIBUTE_NODISCARD
# define _GL_ATTRIBUTE_NODISCARD
#endif
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index 9261c82db1..0e5e62117d 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -6,7 +6,7 @@
This document describes how to compile a 64-bit GNU Emacs using MSYS2
and MinGW-w64. For instructions for building a 32-bit Emacs using
-MSYS and MinGW, see the file INSTALL in this directory.
+MSYS and mingw.org's MinGW, see the file INSTALL in this directory.
Do not use this recipe with Cygwin. For building on Cygwin, use the normal
installation instructions in ../INSTALL.
@@ -16,29 +16,29 @@ installation instructions in ../INSTALL.
The total space required is 3GB: 1.8GB for MSYS2 / MinGW-w64 and 1.2GB for
Emacs with the full repository, or less if you're using a release tarball.
+As of December 2022, the minimum supported system, both for building
+Emacs with the MSYS2/MinGW-w64 toolchain and for running the produced
+binary, is Windows 8.1. The computer hardware should also match the
+Microsoft requirements for Windows 8.1.
+
* Set up the MinGW-w64 / MSYS2 build environment
MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit
Windows -- it's located at https://mingw-w64.org/.
MSYS2 is a Cygwin-derived software distribution for Windows which provides
-build tools for MinGW-w64 -- see https://msys2.github.io/.
+build tools for MinGW-w64 -- see https://msys2.org/.
** Download and install MinGW-w64 and MSYS2
-You can download the x86_64 version of MSYS2 (i.e. msys2-x86_64-<date>.exe)
-from
-
- https://sourceforge.net/projects/msys2/files/Base/x86_64
-
-Run this file to install MSYS2 in your preferred directory, e.g. the default
-C:\msys64 -- this will install MinGW-w64 also. Note that directory names
-containing spaces may cause problems.
+Go to https://msys2.org and follow the Installation instructions, up
+to where they say to use 'pacman -S' to install packages. Instead,
+install the necessary packages as instructed in the next section.
** Download and install the necessary packages
-Run c:/msys64/msys2.exe in your MSYS2 directory and you will see a BASH window
-opened.
+Run mingw64.exe in your MSYS2 directory and you will see a BASH window
+open.
In the BASH prompt, use the following command to install the necessary
packages (you can copy and paste it into the shell with Shift + Insert):
@@ -46,6 +46,8 @@ packages (you can copy and paste it into the shell with Shift
+ Insert):
pacman -S --needed base-devel \
mingw-w64-x86_64-toolchain \
mingw-w64-x86_64-xpm-nox \
+ mingw-w64-x86_64-gmp \
+ mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-libtiff \
mingw-w64-x86_64-giflib \
mingw-w64-x86_64-libpng \
@@ -55,25 +57,30 @@ packages (you can copy and paste it into the shell with
Shift + Insert):
mingw-w64-x86_64-lcms2 \
mingw-w64-x86_64-jansson \
mingw-w64-x86_64-libxml2 \
- mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-zlib \
- mingw-w64-x86_64-harfbuzz
-
-The packages include the base developer tools (autoconf, grep, make, etc.),
-the compiler toolchain (gcc, gdb, etc.), several image libraries, an XML
-library, the GnuTLS (transport layer security) library, zlib for
-decompressing text, and HarfBuzz for use as the shaping engine. Only the
-first three packages are required (base-devel, toolchain, xpm-nox); the
-rest are optional. You can select only part of the libraries if you don't
+ mingw-w64-x86_64-harfbuzz \
+ mingw-w64-x86_64-libgccjit \
+ mingw-w64-x86_64-sqlite3 \
+ mingw-w64-x86_64-tree-sitter
+
+The packages include the base developer tools (autoconf, grep, make,
+etc.), the compiler toolchain (gcc, gdb, etc.), several image
+libraries, an XML library, the GnuTLS (transport layer security)
+library, zlib for decompressing text, HarfBuzz for use as the shaping
+engine, libgccjit for native-compilation support, SQLite3 for
+accessing SQL databases, and the tree-sitter library used by some
+major modes. Only the first four packages are required (base-devel,
+toolchain, xpm-nox, GMP), and GnuTLS is highly recommended; the rest
+are optional. You can select only part of the libraries if you don't
need them all.
You now have a complete build environment for Emacs.
* Install Git (optional) and disable autocrlf
-If you're going to be building the development version of Emacs from the Git
-repository, and you don't already have Git on your system, you can install it
-in your MSYS2 environment with:
+If you're going to be building the development version of Emacs from
+the Git repository (see below), and you don't already have Git on your
+system, you can install it in your MSYS2 environment with:
pacman -S git
@@ -96,19 +103,22 @@ Savannah Emacs site,
https://savannah.gnu.org/projects/emacs.
The Emacs ftp site is located at https://ftp.gnu.org/gnu/emacs/ - download the
version you want to build and put the file into a location like C:\emacs\,
then uncompress it with tar. This will put the Emacs source into a folder like
-C:\emacs\emacs-24.5:
+C:\emacs\emacs-29.1:
cd /c/emacs
- tar xJf emacs-24.5.tar.xz
+ tar xJf emacs-29.1.tar.xz
** From the Git repository
-To download the Git repository, do something like the following -- this will
-put the Emacs source into C:\emacs\emacs-26:
+To clone the Git repository, do something like the following -- this will
+put the Emacs source into C:\emacs\emacs-master:
mkdir /c/emacs
cd /c/emacs
- git clone git://git.sv.gnu.org/emacs.git emacs-26
+ git clone git://git.sv.gnu.org/emacs.git emacs-master
+
+This will produce the development sources, i.e. the master branch of
+the Emacs Git repository, in the directory C:\emacs\emacs-master.
(We recommend using the command shown on Savannah Emacs project page.)
@@ -117,15 +127,12 @@ put the Emacs source into C:\emacs\emacs-26:
Now you're ready to build and install Emacs with autogen, configure, make,
and make install.
-First we need to switch to the MinGW-w64 environment. Exit the MSYS2 BASH
-console and run mingw64.exe in the C:\msys64 folder, then cd back to
-your Emacs source directory, e.g.:
-
- cd /c/emacs/emacs-26
+ cd /c/emacs/emacs-29.1 (if building a source tarball)
+ cd /c/emacs/emacs-master (if building from Git)
** Run autogen
-If you are building the development sources, run autogen to generate the
+If you are building from Git, run autogen to generate the
configure script (note: this step is not necessary if you are using a
release source tarball, as the configure file is included):
@@ -137,15 +144,16 @@ Now you can run configure, which will build the various
Makefiles -- note
that the example given here is just a simple one - for more information
on the options available please see the INSTALL file in this directory.
-The '--prefix' option specifies a location for the resulting binary files,
-which 'make install' will use - in this example we set it to C:\emacs\emacs-26.
-If a prefix is not specified the files will be put in the standard Unix
-directories located in your C:\msys64 directory, but this is not recommended.
+The '--prefix' option specifies a location for the resulting binary
+files, which 'make install' will use - in this example we set it to
+C:\programs\emacs. If a prefix is not specified the files will be put
+in the standard Unix directories located in your C:\msys64 directory,
+but this is not recommended.
Note also that we need to disable D-Bus because Emacs does not yet
support them on Windows.
- ./configure --prefix=/c/emacs/emacs-26 --without-dbus
+ ./configure --prefix=/c/programs/emacs --without-dbus
** Run make
diff --git a/src/dispnew.c b/src/dispnew.c
index ed10accac7..6fc91e60eb 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3194,7 +3194,7 @@ DEFUN ("redraw-display", Fredraw_display,
Sredraw_display, 0, 0, "",
Lisp_Object tail, frame;
FOR_EACH_FRAME (tail, frame)
- if (FRAME_VISIBLE_P (XFRAME (frame)))
+ if (FRAME_REDISPLAY_P (XFRAME (frame)))
redraw_frame (XFRAME (frame));
return Qnil;
diff --git a/src/emacs.c b/src/emacs.c
index b6686f8809..9ef58ca412 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2938,6 +2938,7 @@ killed. */
if (!NILP (restart))
{
+ turn_on_atimers (false);
#ifdef WINDOWSNT
if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0)
#else
diff --git a/src/eval.c b/src/eval.c
index 99f3650fc9..cff4b92477 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1367,7 +1367,7 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
error ("Invalid condition handler: %s",
SDATA (Fprin1_to_string (tem, Qt, Qnil)));
if (CONSP (tem) && EQ (XCAR (tem), QCsuccess))
- success_handler = XCDR (tem);
+ success_handler = tem;
else
clausenb++;
}
@@ -1430,7 +1430,7 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
if (!NILP (success_handler))
{
if (NILP (var))
- return Fprogn (success_handler);
+ return Fprogn (XCDR (success_handler));
Lisp_Object handler_var = var;
if (!NILP (Vinternal_interpreter_environment))
@@ -1442,7 +1442,7 @@ internal_lisp_condition_case (Lisp_Object var,
Lisp_Object bodyform,
specpdl_ref count = SPECPDL_INDEX ();
specbind (handler_var, result);
- return unbind_to (count, Fprogn (success_handler));
+ return unbind_to (count, Fprogn (XCDR (success_handler)));
}
return result;
}
diff --git a/src/frame.h b/src/frame.h
index e0b47d26d6..e5693e0877 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1025,6 +1025,20 @@ default_pixels_per_inch_y (void)
/* True if frame F is currently visible. */
#define FRAME_VISIBLE_P(f) (f)->visible
+/* True if frame F should be redisplayed. This is normally the same
+ as FRAME_VISIBLE_P (f). Under X, frames can continue to be
+ displayed to the user by the compositing manager even if they are
+ invisible, so this also checks whether or not the frame is reported
+ visible by the X server. */
+
+#ifndef HAVE_X_WINDOWS
+#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f))
+#else
+#define FRAME_REDISPLAY_P(f) (FRAME_VISIBLE_P (f) \
+ || (FRAME_X_P (f) \
+ && FRAME_X_VISIBLE (f)))
+#endif
+
/* True if frame F is currently visible but hidden. */
#define FRAME_OBSCURED_P(f) ((f)->visible > 1)
diff --git a/src/gnutls.c b/src/gnutls.c
index 4093865cae..e58322934d 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -34,6 +34,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# endif
# if GNUTLS_VERSION_NUMBER >= 0x030200
+# define HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE
# endif
@@ -121,6 +122,11 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
(gnutls_certificate_credentials_t, const char *, const char *,
gnutls_x509_crt_fmt_t));
+# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file2,
+ (gnutls_certificate_credentials_t, const char *, const char *,
+ gnutls_x509_crt_fmt_t, const char *, unsigned int));
+# endif
# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
(gnutls_certificate_credentials_t));
@@ -314,6 +320,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
+# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+ LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file2);
+# endif
# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
# endif
@@ -455,6 +464,9 @@ init_gnutls_functions (void)
# define gnutls_certificate_set_verify_flags
fn_gnutls_certificate_set_verify_flags
# define gnutls_certificate_set_x509_crl_file
fn_gnutls_certificate_set_x509_crl_file
# define gnutls_certificate_set_x509_key_file
fn_gnutls_certificate_set_x509_key_file
+# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+# define gnutls_certificate_set_x509_key_file2
fn_gnutls_certificate_set_x509_key_file2
+# endif
# define gnutls_certificate_set_x509_system_trust
fn_gnutls_certificate_set_x509_system_trust
# define gnutls_certificate_set_x509_trust_file
fn_gnutls_certificate_set_x509_trust_file
# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
@@ -1774,6 +1786,72 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object
proplist)
return gnutls_make_error (ret);
}
+#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+
+/* Helper function for gnutls-boot.
+
+ The key :flags receives a list of symbols, each of which
+ corresponds to a GnuTLS C flag, the ORed result is to be passed to
+ the function `gnutls_certificate_set_x509_key_file2' as its last
+ argument. */
+static unsigned int
+key_file2_aux (Lisp_Object flags)
+{
+ unsigned int rv = 0;
+ Lisp_Object tail = flags;
+ FOR_EACH_TAIL_SAFE (tail)
+ {
+ Lisp_Object flag = XCAR (tail);
+ if (EQ (flag, Qgnutls_pkcs_plain))
+ rv |= GNUTLS_PKCS_PLAIN;
+ else if (EQ (flag, Qgnutls_pkcs_pkcs12_3des))
+ rv |= GNUTLS_PKCS_PKCS12_3DES;
+ else if (EQ (flag, Qgnutls_pkcs_pkcs12_arcfour))
+ rv |= GNUTLS_PKCS_PKCS12_ARCFOUR;
+ else if (EQ (flag, Qgnutls_pkcs_pkcs12_rc2_40))
+ rv |= GNUTLS_PKCS_PKCS12_RC2_40;
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_3des))
+ rv |= GNUTLS_PKCS_PBES2_3DES;
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_128))
+ rv |= GNUTLS_PKCS_PBES2_AES_128;
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_192))
+ rv |= GNUTLS_PKCS_PBES2_AES_192;
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_256))
+ rv |= GNUTLS_PKCS_PBES2_AES_256;
+ else if (EQ (flag, Qgnutls_pkcs_null_password))
+ rv |= GNUTLS_PKCS_NULL_PASSWORD;
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_des))
+ rv |= GNUTLS_PKCS_PBES2_DES;
+#ifdef GNUTLS_PKCS_PBES1_DES_MD5
+ else if (EQ (flag, Qgnutls_pkcs_pbes1_des_md5))
+ rv |= GNUTLS_PKCS_PBES1_DES_MD5;
+#endif
+#ifdef GNUTLS_PKCS_PBES2_GOST_TC26Z
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_tc26z))
+ rv |= GNUTLS_PKCS_PBES2_GOST_TC26Z;
+#endif
+#ifdef GNUTLS_PKCS_PBES2_GOST_CPA
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpa))
+ rv |= GNUTLS_PKCS_PBES2_GOST_CPA;
+#endif
+#ifdef GNUTLS_PKCS_PBES2_GOST_CPB
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpb))
+ rv |= GNUTLS_PKCS_PBES2_GOST_CPB;
+#endif
+#ifdef GNUTLS_PKCS_PBES2_GOST_CPC
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpc))
+ rv |= GNUTLS_PKCS_PBES2_GOST_CPC;
+#endif
+#ifdef GNUTLS_PKCS_PBES2_GOST_CPD
+ else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpd))
+ rv |= GNUTLS_PKCS_PBES2_GOST_CPD;
+#endif
+ }
+ return rv;
+}
+
+#endif /* HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2 */
+
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
Currently only client mode is supported. Return a success/failure
@@ -1813,6 +1891,22 @@ accept in Diffie-Hellman key exchange.
:complete-negotiation, if non-nil, will make negotiation complete
before returning even on non-blocking sockets.
+:pass, the password of the private key as per GnuTLS'
+gnutls_certificate_set_x509_key_file2. Specify as nil to have a NULL
+password.
+
+:flags, a list of symbols relating to :pass, each specifying a flag:
+GNUTLS_PKCS_PLAIN, GNUTLS_PKCS_PKCS12_3DES,
+GNUTLS_PKCS_PKCS12_ARCFOUR, GNUTLS_PKCS_PKCS12_RC2_40,
+GNUTLS_PKCS_PBES2_3DES, GNUTLS_PKCS_PBES2_AES_128,
+GNUTLS_PKCS_PBES2_AES_192, GNUTLS_PKCS_PBES2_AES_256,
+GNUTLS_PKCS_NULL_PASSWORD, GNUTLS_PKCS_PBES2_DES,
+GNUTLS_PKCS_PBES2_DES_MD5, GNUTLS_PKCS_PBES2_GOST_TC26Z,
+GNUTLS_PKCS_PBES2_GOST_CPA, GNUTLS_PKCS_PBES2_GOST_CPB,
+GNUTLS_PKCS_PBES2_GOST_CPC, GNUTLS_PKCS_PBES2_GOST_CPD. If not
+specified, or if nil, the bitflag with value 0 is used.
+Note that some of these are only supported since GnuTLS 3.6.3.
+
The debug level will be set for this process AND globally for GnuTLS.
So if you set it higher or lower at any point, it affects global
debugging.
@@ -1825,6 +1919,9 @@ Processes must be initialized with this function before
other GnuTLS
functions are used. This function allocates resources which can only
be deallocated by calling `gnutls-deinit' or by calling it again.
+The :pass and :flags keys are ignored with old versions of GnuTLS, and
+:flags is ignored if :pass is not specified.
+
The callbacks alist can have a `verify' key, associated with a
verification function (UNUSED).
@@ -1842,16 +1939,22 @@ one trustfile (usually a CA bundle). */)
Lisp_Object global_init;
char const *priority_string_ptr = "NORMAL"; /* default priority string. */
char *c_hostname;
+ const char *c_pass;
/* Placeholders for the property list elements. */
Lisp_Object priority_string;
Lisp_Object trustfiles;
Lisp_Object crlfiles;
Lisp_Object keylist;
+ Lisp_Object pass;
+ Lisp_Object flags;
/* Lisp_Object callbacks; */
Lisp_Object loglevel;
Lisp_Object hostname;
Lisp_Object prime_bits;
+#ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+ unsigned int aux_key_file;
+#endif
struct Lisp_Process *p = XPROCESS (proc);
CHECK_PROCESS (proc);
@@ -1877,6 +1980,13 @@ one trustfile (usually a CA bundle). */)
crlfiles = plist_get (proplist, QCcrlfiles);
loglevel = plist_get (proplist, QCloglevel);
prime_bits = plist_get (proplist, QCmin_prime_bits);
+ pass = plist_get (proplist, QCpass);
+ flags = plist_get (proplist, QCflags);
+
+ if (STRINGP (pass))
+ c_pass = SSDATA (pass);
+ else
+ c_pass = NULL;
if (!STRINGP (hostname))
{
@@ -2037,6 +2147,20 @@ one trustfile (usually a CA bundle). */)
# ifdef WINDOWSNT
keyfile = ansi_encode_filename (keyfile);
certfile = ansi_encode_filename (certfile);
+# endif
+# ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
+ if (!NILP (plist_member (proplist, QCpass)))
+ {
+ aux_key_file = key_file2_aux (flags);
+ ret
+ = gnutls_certificate_set_x509_key_file2 (x509_cred,
+ SSDATA (certfile),
+ SSDATA (keyfile),
+ file_format,
+ c_pass,
+ aux_key_file);
+ }
+ else
# endif
ret = gnutls_certificate_set_x509_key_file
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
@@ -2862,8 +2986,26 @@ level in the ones. For builds without libgnutls, the
value is -1. */);
DEFSYM (QCmin_prime_bits, ":min-prime-bits");
DEFSYM (QCloglevel, ":loglevel");
DEFSYM (QCcomplete_negotiation, ":complete-negotiation");
+ DEFSYM (QCpass, ":pass");
+ DEFSYM (QCflags, ":flags");
DEFSYM (QCverify_flags, ":verify-flags");
DEFSYM (QCverify_error, ":verify-error");
+ DEFSYM (Qgnutls_pkcs_plain, "GNUTLS_PKCS_PLAIN");
+ DEFSYM (Qgnutls_pkcs_pkcs12_3des, "GNUTLS_PKCS_PKCS12_3DES");
+ DEFSYM (Qgnutls_pkcs_pkcs12_arcfour, "GNUTLS_PKCS_PKCS12_ARCFOUR");
+ DEFSYM (Qgnutls_pkcs_pkcs12_rc2_40, "GNUTLS_PKCS_PKCS12_RC2_40");
+ DEFSYM (Qgnutls_pkcs_pbes2_3des, "GNUTLS_PKCS_PBES2_3DES");
+ DEFSYM (Qgnutls_pkcs_pbes2_aes_128, "GNUTLS_PKCS_PBES2_AES_128");
+ DEFSYM (Qgnutls_pkcs_pbes2_aes_192, "GNUTLS_PKCS_PBES2_AES_192");
+ DEFSYM (Qgnutls_pkcs_pbes2_aes_256, "GNUTLS_PKCS_PBES2_AES_256");
+ DEFSYM (Qgnutls_pkcs_null_password, "GNUTLS_PKCS_NULL_PASSWORD");
+ DEFSYM (Qgnutls_pkcs_pbes2_des, "GNUTLS_PKCS_PBES2_DES");
+ DEFSYM (Qgnutls_pkcs_pbes1_des_md5, "GNUTLS_PKCS_PBES1_DES_MD5");
+ DEFSYM (Qgnutls_pkcs_pbes2_gost_tc26z, "GNUTLS_PKCS_PBES2_GOST_TC26Z");
+ DEFSYM (Qgnutls_pkcs_pbes2_gost_cpa, "GNUTLS_PKCS_PBES2_GOST_CPA");
+ DEFSYM (Qgnutls_pkcs_pbes2_gost_cpb, "GNUTLS_PKCS_PBES2_GOST_CPB");
+ DEFSYM (Qgnutls_pkcs_pbes2_gost_cpc, "GNUTLS_PKCS_PBES2_GOST_CPC");
+ DEFSYM (Qgnutls_pkcs_pbes2_gost_cpd, "GNUTLS_PKCS_PBES2_GOST_CPD");
DEFSYM (QCcipher_id, ":cipher-id");
DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
diff --git a/src/indent.c b/src/indent.c
index 4671ccccf9..66edaff67d 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -887,6 +887,8 @@ DEFUN ("indent-to", Findent_to, Sindent_to, 1, 2, "NIndent
to column: ",
Optional second argument MINIMUM says always do at least MINIMUM spaces
even if that goes past COLUMN; by default, MINIMUM is zero.
+Whether this uses tabs or spaces depends on `indent-tabs-mode'.
+
The return value is the column where the insertion ends. */)
(Lisp_Object column, Lisp_Object minimum)
{
diff --git a/src/json.c b/src/json.c
index cdcc11358e..621c7d7c15 100644
--- a/src/json.c
+++ b/src/json.c
@@ -555,6 +555,40 @@ json_parse_args (ptrdiff_t nargs,
}
}
+static bool
+json_available_p (void)
+{
+#ifdef WINDOWSNT
+ if (!json_initialized)
+ {
+ Lisp_Object status;
+ json_initialized = init_json_functions ();
+ status = json_initialized ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
+ }
+ return json_initialized;
+#else /* !WINDOWSNT */
+ return true;
+#endif
+}
+
+#ifdef WINDOWSNT
+static void
+ensure_json_available (void)
+{
+ if (!json_available_p ())
+ Fsignal (Qjson_unavailable,
+ list1 (build_unibyte_string ("jansson library not found")));
+}
+#endif
+
+DEFUN ("json--available-p", Fjson__available_p, Sjson__available_p, 0, 0, NULL,
+ doc: /* Return non-nil if libjansson is available (internal use only).
*/)
+ (void)
+{
+ return json_available_p () ? Qt : Qnil;
+}
+
DEFUN ("json-serialize", Fjson_serialize, Sjson_serialize, 1, MANY,
NULL,
doc: /* Return the JSON representation of OBJECT as a string.
@@ -587,16 +621,7 @@ usage: (json-serialize OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
- if (!json_initialized)
- {
- Lisp_Object status;
- json_initialized = init_json_functions ();
- status = json_initialized ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
- }
- if (!json_initialized)
- Fsignal (Qjson_unavailable,
- list1 (build_unibyte_string ("jansson library not found")));
+ ensure_json_available ();
#endif
struct json_configuration conf =
@@ -696,16 +721,7 @@ usage: (json-insert OBJECT &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
- if (!json_initialized)
- {
- Lisp_Object status;
- json_initialized = init_json_functions ();
- status = json_initialized ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
- }
- if (!json_initialized)
- Fsignal (Qjson_unavailable,
- list1 (build_unibyte_string ("jansson library not found")));
+ ensure_json_available ();
#endif
struct json_configuration conf =
@@ -953,16 +969,7 @@ usage: (json-parse-string STRING &rest ARGS) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
- if (!json_initialized)
- {
- Lisp_Object status;
- json_initialized = init_json_functions ();
- status = json_initialized ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
- }
- if (!json_initialized)
- Fsignal (Qjson_unavailable,
- list1 (build_unibyte_string ("jansson library not found")));
+ ensure_json_available ();
#endif
Lisp_Object string = args[0];
@@ -1050,16 +1057,7 @@ usage: (json-parse-buffer &rest args) */)
specpdl_ref count = SPECPDL_INDEX ();
#ifdef WINDOWSNT
- if (!json_initialized)
- {
- Lisp_Object status;
- json_initialized = init_json_functions ();
- status = json_initialized ? Qt : Qnil;
- Vlibrary_cache = Fcons (Fcons (Qjson, status), Vlibrary_cache);
- }
- if (!json_initialized)
- Fsignal (Qjson_unavailable,
- list1 (build_unibyte_string ("jansson library not found")));
+ ensure_json_available ();
#endif
struct json_configuration conf =
@@ -1137,6 +1135,7 @@ syms_of_json (void)
DEFSYM (Qplist, "plist");
DEFSYM (Qarray, "array");
+ defsubr (&Sjson__available_p);
defsubr (&Sjson_serialize);
defsubr (&Sjson_insert);
defsubr (&Sjson_parse_string);
diff --git a/src/keyboard.c b/src/keyboard.c
index d68b50428a..7bf89ac7d4 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -503,11 +503,10 @@ echo_add_key (Lisp_Object c)
if ((NILP (echo_string) || SCHARS (echo_string) == 0)
&& help_char_p (c))
{
- AUTO_STRING (str, " (Type ? for further options, q for quick help)");
+ AUTO_STRING (str, " (Type ? for further options, C-q for quick help)");
AUTO_LIST2 (props, Qface, Qhelp_key_binding);
Fadd_text_properties (make_fixnum (7), make_fixnum (8), props, str);
- Fadd_text_properties (make_fixnum (30), make_fixnum (31), props,
-str);
+ Fadd_text_properties (make_fixnum (30), make_fixnum (33), props, str);
new_string = concat2 (new_string, str);
}
diff --git a/src/lisp.h b/src/lisp.h
index 1f1d47f2a9..d6525ebdc5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <alloca.h>
#include <setjmp.h>
-#include <stdalign.h>
#include <stdarg.h>
#include <stddef.h>
#include <string.h>
diff --git a/src/process.c b/src/process.c
index de1b07a81c..a4be68f741 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6810,10 +6810,13 @@ emacs_get_tty_pgrp (struct Lisp_Process *p)
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
- doc: /* Return non-nil if PROCESS has given the terminal to a
-child. If the operating system does not make it possible to find out,
-return t. If we can find out, return the numeric ID of the foreground
-process group. */)
+ doc: /* Return non-nil if PROCESS has given control of its terminal to
a child.
+If the operating system does not make it possible to find out, return t.
+If it's possible to find out, return the numeric ID of the foreground
+process group if PROCESS did give control of its terminal to a
+child process, and return nil if it didn't.
+
+PROCESS must be a real subprocess, not a connection. */)
(Lisp_Object process)
{
/* Initialize in case ioctl doesn't exist or gives an error,
diff --git a/src/treesit.c b/src/treesit.c
index c882d45513..974d2fc451 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -2,6 +2,8 @@
Copyright (C) 2021-2022 Free Software Foundation, Inc.
+Maintainer: Yuan Fu <casouri@gmail.com>
+
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
@@ -404,6 +406,10 @@ init_treesit_functions (void)
/*** Initialization */
+/* This is the limit on recursion levels for some tree-sitter
+ functions. Remember to update docstrings when changing this
+ value. */
+const ptrdiff_t treesit_recursion_limit = 1000;
bool treesit_initialized = false;
static bool
@@ -656,9 +662,8 @@ If DETAIL is non-nil, return (t . nil) when LANGUAGE is
available,
}
}
-DEFUN ("treesit-language-version",
- Ftreesit_language_version,
- Streesit_language_version,
+DEFUN ("treesit-library-abi-version", Ftreesit_library_abi_version,
+ Streesit_library_abi_version,
0, 1, 0,
doc: /* Return the language ABI version of the tree-sitter library.
@@ -674,6 +679,29 @@ is non-nil, return the oldest compatible ABI version. */)
return make_fixnum (TREE_SITTER_MIN_COMPATIBLE_LANGUAGE_VERSION);
}
+DEFUN ("treesit-language-version", Ftreesit_language_abi_version,
+ Streesit_language_abi_version,
+ 0, 1, 0,
+ doc: /* Return the language ABI version of the tree-sitter LANGUAGE.
+Return nil if LANGUAGE is not available. */)
+ (Lisp_Object language)
+{
+ if (NILP (Ftreesit_langauge_available_p (language, Qnil)))
+ return Qnil;
+ else
+ {
+ Lisp_Object signal_symbol = Qnil;
+ Lisp_Object signal_data = Qnil;
+ TSLanguage *ts_language = treesit_load_language (language,
+ &signal_symbol,
+ &signal_data);
+ if (ts_language == NULL)
+ return Qnil;
+ uint32_t version = ts_language_version (ts_language);
+ return make_fixnum((ptrdiff_t) version);
+ }
+}
+
/*** Parsing functions */
static void
@@ -927,11 +955,24 @@ static void
treesit_call_after_change_functions (TSTree *old_tree, TSTree *new_tree,
Lisp_Object parser)
{
- uint32_t len;
- TSRange *ranges = ts_tree_get_changed_ranges (old_tree, new_tree, &len);
+ /* If the old_tree is NULL, meaning this is the first parse, the
+ changed range is the whole buffer. */
+ Lisp_Object lisp_ranges;
struct buffer *buf = XBUFFER (XTS_PARSER (parser)->buffer);
- Lisp_Object lisp_ranges = treesit_make_ranges (ranges, len, buf);
- xfree (ranges);
+ if (old_tree)
+ {
+ uint32_t len;
+ TSRange *ranges = ts_tree_get_changed_ranges (old_tree, new_tree, &len);
+ lisp_ranges = treesit_make_ranges (ranges, len, buf);
+ xfree (ranges);
+ }
+ else
+ {
+ struct buffer *oldbuf = current_buffer;
+ set_buffer_internal (buf);
+ lisp_ranges = Fcons (Fcons (Fpoint_min (), Fpoint_max ()), Qnil);
+ set_buffer_internal (oldbuf);
+ }
specpdl_ref count = SPECPDL_INDEX ();
@@ -949,6 +990,11 @@ treesit_call_after_change_functions (TSTree *old_tree,
TSTree *new_tree,
static void
treesit_ensure_parsed (Lisp_Object parser)
{
+ /* Make sure this comes before everything else, see comment
+ (ref:notifier-inside-ensure-parsed) for more detail. */
+ if (!XTS_PARSER (parser)->need_reparse)
+ return;
+
struct buffer *buffer = XBUFFER (XTS_PARSER (parser)->buffer);
/* Before we parse, catch up with the narrowing situation. */
@@ -957,8 +1003,6 @@ treesit_ensure_parsed (Lisp_Object parser)
because it might set the flag to true. */
treesit_sync_visible_region (parser);
- if (!XTS_PARSER (parser)->need_reparse)
- return;
TSParser *treesit_parser = XTS_PARSER (parser)->parser;
TSTree *tree = XTS_PARSER (parser)->tree;
TSInput input = XTS_PARSER (parser)->input;
@@ -978,14 +1022,17 @@ treesit_ensure_parsed (Lisp_Object parser)
xsignal1 (Qtreesit_parse_error, buf);
}
- if (tree != NULL)
- {
- treesit_call_after_change_functions (tree, new_tree, parser);
- ts_tree_delete (tree);
- }
-
XTS_PARSER (parser)->tree = new_tree;
XTS_PARSER (parser)->need_reparse = false;
+
+ /* After-change functions should run at the very end, most crucially
+ after need_reparse is set to false, this way if the function
+ calls some tree-sitter function which invokes
+ treesit_ensure_parsed again, it returns early and do not
+ recursively call the after change functions again.
+ (ref:notifier-inside-ensure-parsed) */
+ treesit_call_after_change_functions (tree, new_tree, parser);
+ ts_tree_delete (tree);
}
/* This is the read function provided to tree-sitter to read from a
@@ -1147,10 +1194,12 @@ treesit_query_error_to_string (TSQueryError error)
static Lisp_Object
treesit_compose_query_signal_data (uint32_t error_offset,
- TSQueryError error_type)
+ TSQueryError error_type,
+ Lisp_Object query_source)
{
- return list3 (build_string (treesit_query_error_to_string (error_type)),
+ return list4 (build_string (treesit_query_error_to_string (error_type)),
make_fixnum (error_offset + 1),
+ query_source,
build_pure_c_string ("Debug the query with
`treesit-query-validate'"));
}
@@ -1192,7 +1241,8 @@ treesit_ensure_query_compiled (Lisp_Object query,
Lisp_Object *signal_symbol,
{
*signal_symbol = Qtreesit_query_error;
*signal_data = treesit_compose_query_signal_data (error_offset,
- error_type);
+ error_type,
+ source);
}
XTS_COMPILED_QUERY (query)->query = treesit_query;
return treesit_query;
@@ -1762,7 +1812,7 @@ If NODE is nil, return nil. */)
return build_string (string);
}
-static TSTreeCursor treesit_cursor_helper (TSNode, Lisp_Object);
+static bool treesit_cursor_helper (TSTreeCursor *, TSNode, Lisp_Object);
DEFUN ("treesit-node-parent",
Ftreesit_node_parent, Streesit_node_parent, 1, 1, 0,
@@ -1778,7 +1828,10 @@ Return nil if NODE has no parent. If NODE is nil,
return nil. */)
TSNode treesit_node = XTS_NODE (node)->node;
Lisp_Object parser = XTS_NODE (node)->parser;
- TSTreeCursor cursor = treesit_cursor_helper (treesit_node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, treesit_node, parser))
+ return return_value;
+
if (ts_tree_cursor_goto_parent (&cursor))
{
TSNode parent = ts_tree_cursor_current_node (&cursor);
@@ -2042,12 +2095,11 @@ Note that this function returns an immediate child, not
the smallest
struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer);
ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
- ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos));
treesit_check_position (pos, buf);
-
treesit_initialize ();
+ ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos));
TSNode treesit_node = XTS_NODE (node)->node;
TSNode child;
if (NILP (named))
@@ -2078,14 +2130,14 @@ If NODE is nil, return nil. */)
struct buffer *buf = XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer);
ptrdiff_t visible_beg = XTS_PARSER (XTS_NODE (node)->parser)->visible_beg;
- ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg));
- ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end));
treesit_check_position (beg, buf);
treesit_check_position (end, buf);
treesit_initialize ();
+ ptrdiff_t byte_beg = buf_charpos_to_bytepos (buf, XFIXNUM (beg));
+ ptrdiff_t byte_end = buf_charpos_to_bytepos (buf, XFIXNUM (end));
TSNode treesit_node = XTS_NODE (node)->node;
TSNode child;
if (NILP (named))
@@ -2161,6 +2213,8 @@ See Info node `(elisp)Pattern Matching' for detailed
explanation. */)
return build_pure_c_string ("#equal");
if (EQ (pattern, QCmatch))
return build_pure_c_string ("#match");
+ if (EQ (pattern, QCpred))
+ return build_pure_c_string ("#pred");
Lisp_Object opening_delimeter
= build_pure_c_string (VECTORP (pattern) ? "[" : "(");
Lisp_Object closing_delimiter
@@ -2260,10 +2314,10 @@ treesit_predicates_for_pattern (TSQuery *query,
uint32_t pattern_index)
return Fnreverse (result);
}
-/* Translate a capture NAME (symbol) to the text of the captured node.
+/* Translate a capture NAME (symbol) to a node.
Signals treesit-query-error if such node is not captured. */
static Lisp_Object
-treesit_predicate_capture_name_to_text (Lisp_Object name,
+treesit_predicate_capture_name_to_node (Lisp_Object name,
struct capture_range captures)
{
Lisp_Object node = Qnil;
@@ -2283,6 +2337,16 @@ treesit_predicate_capture_name_to_text (Lisp_Object name,
name, build_pure_c_string ("A predicate can only refer"
" to captured nodes in the "
"same pattern"));
+ return node;
+}
+
+/* Translate a capture NAME (symbol) to the text of the captured node.
+ Signals treesit-query-error if such node is not captured. */
+static Lisp_Object
+treesit_predicate_capture_name_to_text (Lisp_Object name,
+ struct capture_range captures)
+{
+ Lisp_Object node = treesit_predicate_capture_name_to_node (name, captures);
struct buffer *old_buffer = current_buffer;
set_buffer_internal (XBUFFER (XTS_PARSER (XTS_NODE (node)->parser)->buffer));
@@ -2356,13 +2420,30 @@ treesit_predicate_match (Lisp_Object args, struct
capture_range captures)
return false;
}
-/* About predicates: I decide to hard-code predicates in C instead of
- implementing an extensible system where predicates are translated
- to Lisp functions, and new predicates can be added by extending a
- list of functions, because I really couldn't imagine any useful
- predicates besides equal and match. If we later found out that
- such system is indeed useful and necessary, it can be easily
- added. */
+/* Handles predicate (#pred FN ARG...). Return true if FN returns
+ non-nil; return false otherwise. The arity of FN must match the
+ number of ARGs */
+static bool
+treesit_predicate_pred (Lisp_Object args, struct capture_range captures)
+{
+ if (XFIXNUM (Flength (args)) < 2)
+ xsignal2 (Qtreesit_query_error,
+ build_pure_c_string ("Predicate `pred' requires "
+ "at least two arguments, "
+ "but was only given"),
+ Flength (args));
+
+ Lisp_Object fn = Fintern (XCAR (args), Qnil);
+ Lisp_Object nodes = Qnil;
+ Lisp_Object tail = XCDR (args);
+ FOR_EACH_TAIL (tail)
+ nodes = Fcons (treesit_predicate_capture_name_to_node (XCAR (tail),
+ captures),
+ nodes);
+ nodes = Fnreverse (nodes);
+
+ return !NILP (CALLN (Fapply, fn, nodes));
+}
/* If all predicates in PREDICATES passes, return true; otherwise
return false. */
@@ -2378,14 +2459,17 @@ treesit_eval_predicates (struct capture_range captures,
Lisp_Object predicates)
Lisp_Object fn = XCAR (predicate);
Lisp_Object args = XCDR (predicate);
if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal"))))
- pass = treesit_predicate_equal (args, captures);
+ pass &= treesit_predicate_equal (args, captures);
else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match"))))
- pass = treesit_predicate_match (args, captures);
+ pass &= treesit_predicate_match (args, captures);
+ else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred"))))
+ pass &= treesit_predicate_pred (args, captures);
else
xsignal3 (Qtreesit_query_error,
build_pure_c_string ("Invalid predicate"),
fn, build_pure_c_string ("Currently Emacs only supports"
- " equal and match predicate"));
+ " equal, match, and pred"
+ " predicate"));
}
/* If all predicates passed, add captures to result list. */
return pass;
@@ -2546,7 +2630,7 @@ the query. */)
if (treesit_query == NULL)
xsignal (Qtreesit_query_error,
treesit_compose_query_signal_data (error_offset,
- error_type));
+ error_type, query));
cursor = ts_query_cursor_new ();
needs_to_free_query_and_cursor = true;
}
@@ -2637,8 +2721,59 @@ treesit_assume_true (bool val)
eassert (val == true);
}
+/* Tries to move CURSOR to point to TARGET. END_POS is the end of
+ TARGET. If success, return true, otherwise move CURSOR back to
+ starting position and return false. LIMIT is the recursion
+ limit. */
+static bool
+treesit_cursor_helper_1 (TSTreeCursor *cursor, TSNode *target,
+ uint32_t end_pos, ptrdiff_t limit)
+{
+ if (limit <= 0)
+ return false;
+
+ TSNode cursor_node = ts_tree_cursor_current_node (cursor);
+ if (ts_node_eq (cursor_node, *target))
+ return true;
+
+ if (!ts_tree_cursor_goto_first_child (cursor))
+ return false;
+
+ /* Skip nodes that definitely don't contain TARGET. */
+ while (ts_node_end_byte (cursor_node) < end_pos)
+ {
+ if (!ts_tree_cursor_goto_next_sibling (cursor))
+ break;
+ cursor_node = ts_tree_cursor_current_node (cursor);
+ }
+
+ /* Go through each sibling that could contain TARGET. Because of
+ missing nodes (their width is 0), there could be multiple
+ siblings that could contain TARGET. */
+ while (ts_node_start_byte (cursor_node) <= end_pos)
+ {
+ if (treesit_cursor_helper_1 (cursor, target, end_pos, limit - 1))
+ return true;
+
+ if (!ts_tree_cursor_goto_next_sibling (cursor))
+ break;
+ cursor_node = ts_tree_cursor_current_node (cursor);
+ }
+
+ /* Couldn't find TARGET, must be not in this subtree, move cursor
+ back and pray that other brothers and sisters can succeed. */
+ treesit_assume_true (ts_tree_cursor_goto_parent (cursor));
+ return false;
+}
+
/* Create a TSTreeCursor pointing at NODE. PARSER is the lisp parser
- that produced NODE.
+ that produced NODE. If success, return true, otherwise return
+ false. This function should almost always succeed, but if the parse
+ tree is strangely too deep and exceeds the recursion limit, this
+ function will fail and return false.
+
+ If this function returns true, caller needs to free CURSOR; if
+ returns false, caller don't need to free CURSOR.
The reason we need this instead of simply using ts_tree_cursor_new
is that we have to create the cursor on the root node and traverse
@@ -2646,56 +2781,17 @@ treesit_assume_true (bool val)
Otherwise going to sibling or parent of NODE wouldn't work.
(Wow perfect filling.) */
-static TSTreeCursor
-treesit_cursor_helper (TSNode node, Lisp_Object parser)
+static bool
+treesit_cursor_helper (TSTreeCursor *cursor, TSNode node, Lisp_Object parser)
{
uint32_t end_pos = ts_node_end_byte (node);
TSNode root = ts_tree_root_node (XTS_PARSER (parser)->tree);
- TSTreeCursor cursor = ts_tree_cursor_new (root);
- TSNode cursor_node = ts_tree_cursor_current_node (&cursor);
- /* This is like treesit-node-at. We go down from the root node,
- either to first child or next sibling, repeatedly, and finally
- arrive at NODE. */
- while (!ts_node_eq (node, cursor_node))
- {
- treesit_assume_true (ts_tree_cursor_goto_first_child (&cursor));
- cursor_node = ts_tree_cursor_current_node (&cursor);
- /* ts_tree_cursor_goto_first_child_for_byte is not reliable, so
- we just go through each sibling. */
- while (ts_node_is_missing (cursor_node)
- || ts_node_end_byte (cursor_node) < end_pos)
- {
- /* A "missing" node has zero width, so it's possible that
- its end = NODE.end but it's not NODE, so we skip them.
- But we need to make sure this missing node is not the
- node we are looking for before skipping it. */
- if (ts_node_is_missing (cursor_node)
- && ts_node_eq (node, cursor_node))
- return cursor;
- treesit_assume_true (ts_tree_cursor_goto_next_sibling (&cursor));
- cursor_node = ts_tree_cursor_current_node (&cursor);
- }
- /* Right now CURSOR.end >= NODE.end. But what if CURSOR.end =
- NODE.end, and there are missing nodes after CURSOR, and the
- missing node after CURSOR is the NODE we are looking for??
- Well, create a probe and look ahead. (This is tested by
- treesit-cursor-helper-with-missing-node.) */
- TSTreeCursor probe = ts_tree_cursor_copy (&cursor);
- TSNode probe_node;
- while (ts_tree_cursor_goto_next_sibling (&probe))
- {
- probe_node = ts_tree_cursor_current_node (&probe);
- if (!ts_node_is_missing (probe_node))
- break;
- if (ts_node_eq (probe_node, node))
- {
- ts_tree_cursor_delete (&cursor);
- return probe;
- }
- }
- ts_tree_cursor_delete (&probe);
- }
- return cursor;
+ *cursor = ts_tree_cursor_new (root);
+ bool success = treesit_cursor_helper_1 (cursor, &node, end_pos,
+ treesit_recursion_limit);
+ if (!success)
+ ts_tree_cursor_delete (cursor);
+ return success;
}
/* Move CURSOR to the next/previous sibling. FORWARD controls the
@@ -2957,7 +3053,7 @@ Return the first matched node, or nil if none matches.
*/)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
- ptrdiff_t the_limit = 1000;
+ ptrdiff_t the_limit = treesit_recursion_limit;
if (!NILP (limit))
{
CHECK_FIXNUM (limit);
@@ -2968,7 +3064,10 @@ Return the first matched node, or nil if none matches.
*/)
Lisp_Object parser = XTS_NODE (node)->parser;
Lisp_Object return_value = Qnil;
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (node)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (node)->node, parser))
+ return return_value;
+
if (treesit_search_dfs (&cursor, predicate, parser, NILP (backward),
NILP (all), the_limit, false))
{
@@ -3022,7 +3121,10 @@ always traverse leaf nodes first, then upwards. */)
Lisp_Object parser = XTS_NODE (start)->parser;
Lisp_Object return_value = Qnil;
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (start)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (start)->node, parser))
+ return return_value;
+
if (treesit_search_forward (&cursor, predicate, parser,
NILP (backward), NILP (all)))
{
@@ -3130,7 +3232,7 @@ a regexp. */)
/* We use a default limit of 1000. See bug#59426 for the
discussion. */
- ptrdiff_t the_limit = 1000;
+ ptrdiff_t the_limit = treesit_recursion_limit;
if (!NILP (limit))
{
CHECK_FIXNUM (limit);
@@ -3141,7 +3243,10 @@ a regexp. */)
Lisp_Object parser = XTS_NODE (root)->parser;
Lisp_Object parent = Fcons (Qnil, Qnil);
- TSTreeCursor cursor = treesit_cursor_helper (XTS_NODE (root)->node, parser);
+ TSTreeCursor cursor;
+ if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser))
+ return Qnil;
+
treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
the_limit, parser);
ts_tree_cursor_delete (&cursor);
@@ -3187,6 +3292,7 @@ syms_of_treesit (void)
DEFSYM (QCanchor, ":anchor");
DEFSYM (QCequal, ":equal");
DEFSYM (QCmatch, ":match");
+ DEFSYM (QCpred, ":pred");
DEFSYM (Qnot_found, "not-found");
DEFSYM (Qsymbol_error, "symbol-error");
@@ -3264,7 +3370,8 @@ then in the system default locations for dynamic
libraries, in that order. */);
Vtreesit_extra_load_path = Qnil;
defsubr (&Streesit_language_available_p);
- defsubr (&Streesit_language_version);
+ defsubr (&Streesit_library_abi_version);
+ defsubr (&Streesit_language_abi_version);
defsubr (&Streesit_parser_p);
defsubr (&Streesit_node_p);
diff --git a/src/w32menu.c b/src/w32menu.c
index b10239d5cc..5f06f4c417 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -1073,7 +1073,10 @@ is_simple_dialog (Lisp_Object contents)
if (NILP (Fstring_equal (name, other)))
return false;
- /* Check there are no more options. */
+ /* Check there are no more options.
+
+ (FIXME: Since we use MB_YESNOCANCEL, we could also consider
+ dialogs with 3 options: Yes/No/Cancel as "simple". */
options = XCDR (options);
return !(CONSP (options));
}
@@ -1085,7 +1088,13 @@ simple_dialog_show (struct frame *f, Lisp_Object
contents, Lisp_Object header)
UINT type;
Lisp_Object lispy_answer = Qnil, temp = XCAR (contents);
- type = MB_YESNO;
+ /* We use MB_YESNOCANCEL to allow the user the equivalent of C-g
+ when the Yes/No question is asked vya y-or-n-p or
+ yes-or-no-p. */
+ if (w32_yes_no_dialog_show_cancel)
+ type = MB_YESNOCANCEL;
+ else
+ type = MB_YESNO;
/* Since we only handle Yes/No dialogs, and we already checked
is_simple_dialog, we don't need to worry about checking contents
diff --git a/src/w32term.c b/src/w32term.c
index dff21489e5..e40e4588fd 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -7696,6 +7696,7 @@ static void
w32_initialize (void)
{
HANDLE shell;
+ BOOL caret;
HRESULT (WINAPI * set_user_model) (const wchar_t * id);
baud_rate = 19200;
@@ -7732,8 +7733,9 @@ w32_initialize (void)
/* Initialize w32_use_visible_system_caret based on whether a screen
reader is in use. */
- if (!SystemParametersInfo (SPI_GETSCREENREADER, 0,
- &w32_use_visible_system_caret, 0))
+ if (SystemParametersInfo (SPI_GETSCREENREADER, 0, &caret, 0))
+ w32_use_visible_system_caret = caret == TRUE;
+ else
w32_use_visible_system_caret = 0;
any_help_event_p = 0;
@@ -7923,6 +7925,11 @@ unconditionally set to nil on older systems. */);
w32_use_native_image_api = 0;
#endif
+ DEFVAR_BOOL ("w32-yes-no-dialog-show-cancel",
+ w32_yes_no_dialog_show_cancel,
+ doc: /* If non-nil, show Cancel button in MS-Windows GUI Yes/No dialogs.
*/);
+ w32_yes_no_dialog_show_cancel = 1;
+
/* FIXME: The following variable will be (hopefully) removed
before Emacs 25.1 gets released. */
diff --git a/src/xdisp.c b/src/xdisp.c
index cc4c60f02d..7d1e7eeb0b 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -12938,7 +12938,7 @@ clear_garbaged_frames (void)
{
struct frame *f = XFRAME (frame);
- if (FRAME_VISIBLE_P (f) && FRAME_GARBAGED_P (f))
+ if (FRAME_REDISPLAY_P (f) && FRAME_GARBAGED_P (f))
{
if (f->resized_p
/* It makes no sense to redraw a non-selected TTY
@@ -12987,7 +12987,7 @@ echo_area_display (bool update_frame_p)
f = XFRAME (WINDOW_FRAME (w));
/* Don't display if frame is invisible or not yet initialized. */
- if (!FRAME_VISIBLE_P (f) || !f->glyphs_initialized_p)
+ if (!FRAME_REDISPLAY_P (f) || !f->glyphs_initialized_p)
return;
#ifdef HAVE_WINDOW_SYSTEM
@@ -13543,7 +13543,7 @@ prepare_menu_bars (void)
TTY frames to be completely redrawn, when there
are more than one of them, even though nothing
should be changed on display. */
- || (FRAME_VISIBLE_P (f) == 2 && FRAME_WINDOW_P (f))))
+ || (FRAME_REDISPLAY_P (f) && FRAME_WINDOW_P (f))))
gui_consider_frame_title (frame);
}
}
@@ -14271,12 +14271,14 @@ redisplay_tab_bar (struct frame *f)
frame_default_tab_bar_height = new_height;
}
- /* If new_height or new_nrows indicate that we need to enlarge the
- tab-bar window, we can return right away. */
+ /* If new_height or new_nrows indicate that we need to enlarge or
+ shrink the tab-bar window, we can return right away. */
if (new_nrows > f->n_tab_bar_rows
|| (EQ (Vauto_resize_tab_bars, Qgrow_only)
&& !f->minimize_tab_bar_window_p
- && new_height > WINDOW_PIXEL_HEIGHT (w)))
+ && new_height > WINDOW_PIXEL_HEIGHT (w))
+ || (! EQ (Vauto_resize_tab_bars, Qgrow_only)
+ && new_height < WINDOW_PIXEL_HEIGHT (w)))
{
if (FRAME_TERMINAL (f)->change_tab_bar_height_hook)
FRAME_TERMINAL (f)->change_tab_bar_height_hook (f, new_height);
@@ -16430,7 +16432,7 @@ redisplay_internal (void)
{
struct frame *f = XFRAME (frame);
- if (FRAME_VISIBLE_P (f))
+ if (FRAME_REDISPLAY_P (f))
{
++number_of_visible_frames;
/* Adjust matrices for visible frames only. */
@@ -16572,7 +16574,7 @@ redisplay_internal (void)
&& !w->update_mode_line
&& !current_buffer->clip_changed
&& !current_buffer->prevent_redisplay_optimizations_p
- && FRAME_VISIBLE_P (XFRAME (w->frame))
+ && FRAME_REDISPLAY_P (XFRAME (w->frame))
&& !FRAME_OBSCURED_P (XFRAME (w->frame))
&& !XFRAME (w->frame)->cursor_type_changed
&& !XFRAME (w->frame)->face_change
@@ -16838,14 +16840,20 @@ redisplay_internal (void)
/* Only GC scrollbars when we redisplay the whole frame. */
= f->redisplay || !REDISPLAY_SOME_P ();
bool f_redisplay_flag = f->redisplay;
+
+ /* The X error handler may have deleted that frame
+ before we went back to retry_frame. This must come
+ before any accesses to f->terminal. */
+ if (!FRAME_LIVE_P (f))
+ continue;
+
/* Mark all the scroll bars to be removed; we'll redeem
the ones we want when we redisplay their windows. */
if (gcscrollbars && FRAME_TERMINAL (f)->condemn_scroll_bars_hook)
FRAME_TERMINAL (f)->condemn_scroll_bars_hook (f);
- if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f))
+ if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f))
{
-
/* Don't allow freeing images and faces for this
frame as long as the frame's update wasn't
completed. This prevents crashes when some Lisp
@@ -16870,7 +16878,7 @@ redisplay_internal (void)
if (gcscrollbars && FRAME_TERMINAL (f)->judge_scroll_bars_hook)
FRAME_TERMINAL (f)->judge_scroll_bars_hook (f);
- if (FRAME_VISIBLE_P (f) && !FRAME_OBSCURED_P (f))
+ if (FRAME_REDISPLAY_P (f) && !FRAME_OBSCURED_P (f))
{
/* If fonts changed on visible frame, display again. */
if (f->fonts_changed)
@@ -16976,7 +16984,7 @@ redisplay_internal (void)
}
}
}
- else if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
+ else if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf))
{
sf->inhibit_clear_image_cache = true;
displayed_buffer = XBUFFER (XWINDOW (selected_window)->contents);
@@ -17027,7 +17035,7 @@ redisplay_internal (void)
unrequest_sigio ();
STOP_POLLING;
- if (FRAME_VISIBLE_P (sf) && !FRAME_OBSCURED_P (sf))
+ if (FRAME_REDISPLAY_P (sf) && !FRAME_OBSCURED_P (sf))
{
if (hscroll_retries <= MAX_HSCROLL_RETRIES
&& hscroll_windows (selected_window))
@@ -17126,7 +17134,7 @@ redisplay_internal (void)
FOR_EACH_FRAME (tail, frame)
{
- if (XFRAME (frame)->visible)
+ if (FRAME_REDISPLAY_P (XFRAME (frame)))
new_count++;
}
@@ -33262,7 +33270,7 @@ display_and_set_cursor (struct window *w, bool on,
windows and frames; in the latter case, the frame or window may
be in the midst of changing its size, and x and y may be off the
window. */
- if (! FRAME_VISIBLE_P (f)
+ if (! FRAME_REDISPLAY_P (f)
|| vpos >= w->current_matrix->nrows
|| hpos >= w->current_matrix->matrix_w)
return;
@@ -33423,7 +33431,7 @@ gui_update_cursor (struct frame *f, bool on_p)
void
gui_clear_cursor (struct window *w)
{
- if (FRAME_VISIBLE_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
+ if (FRAME_REDISPLAY_P (XFRAME (w->frame)) && w->phys_cursor_on_p)
update_window_cursor (w, false);
}
diff --git a/src/xfns.c b/src/xfns.c
index 668f711bdb..1cc5aec1eb 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -4741,6 +4741,7 @@ This function is an internal primitive--use `make-frame'
instead. */)
#endif /* USE_LUCID && USE_TOOLKIT_SCROLL_BARS */
f->output_data.x->white_relief.pixel = -1;
f->output_data.x->black_relief.pixel = -1;
+ f->output_data.x->visibility_state = VisibilityFullyObscured;
fset_icon_name (f, gui_display_get_arg (dpyinfo,
parms,
diff --git a/src/xterm.c b/src/xterm.c
index 8e0a97899f..1eef8e7a72 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -21743,9 +21743,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case VisibilityNotify:
f = x_top_window_to_frame (dpyinfo, event->xvisibility.window);
- if (f && (event->xvisibility.state == VisibilityUnobscured
- || event->xvisibility.state == VisibilityPartiallyObscured))
- SET_FRAME_VISIBLE (f, 1);
+
+ if (f)
+ FRAME_X_OUTPUT (f)->visibility_state = event->xvisibility.state;
goto OTHER;
diff --git a/src/xterm.h b/src/xterm.h
index 832ffc172b..f06e1ec5bc 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -1290,6 +1290,11 @@ struct x_output
strictly an optimization to avoid extraneous synchronizing in
some cases. */
int root_x, root_y;
+
+ /* The frame visibility state. This starts out
+ VisibilityFullyObscured, but is set to something else in
+ handle_one_xevent. */
+ int visibility_state;
};
enum
@@ -1408,6 +1413,11 @@ extern void x_mark_frame_dirty (struct frame *f);
/* And its corresponding visual info. */
#define FRAME_X_VISUAL_INFO(f) (&FRAME_DISPLAY_INFO (f)->visual_info)
+/* Whether or not the frame is visible. Do not test this alone.
+ Instead, use FRAME_REDISPLAY_P. */
+#define FRAME_X_VISIBLE(f) (FRAME_X_OUTPUT (f)->visibility_state \
+ != VisibilityFullyObscured)
+
#ifdef HAVE_XRENDER
#define FRAME_X_PICTURE_FORMAT(f) FRAME_DISPLAY_INFO (f)->pict_format
#define FRAME_X_PICTURE(f) ((f)->output_data.x->picture)
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index 429ef26657..3d6e768693 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -180,6 +180,90 @@
;; along with Mentor. If not, see <https://www.gnu.org/licenses>.
" "Mentor is distributed in the hope that")
+;; from GnuTLS [has a line break in snail mail address]
+(elide-head--add-test gpl3-6 "\
+# This file is part of GnuTLS.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
+# USA
+" "This program is distributed in the hope that")
+
+;; from GnuTLS [has a different line break in snail mail address]
+(elide-head--add-test gpl3-7 "\
+# This file is part of GnuTLS.
+#
+# The GnuTLS is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Lesser General Public License
+# as published by the Free Software Foundation; either version 2.1 of
+# the License, or (at your option) any later version.
+#
+# The GnuTLS is distributed in the hope that it will be
+# useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Lesser General Public License for more details.
+#
+# You should have received a copy of the GNU Lesser General Public
+# License along with GnuTLS; if not, write to the Free
+# Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+# MA 02110-1301, USA
+" "The GnuTLS is distributed in the hope that")
+
+;; from GnuTLS [has a typo in the 02111-1301 part]
+(elide-head--add-test gpl3-8 "\
+/* nettle, low-level cryptographics library
+ *
+ * Copyright (C) 2002 Niels Möller
+ * Copyright (C) 2014 Red Hat
+ *\s\s
+ * The nettle library is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *\s
+ * The nettle library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+ * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
+ * License for more details.
+ *\s
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with the nettle library; see the file COPYING.LIB. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
+ * MA 02111-1301, USA.
+ */
+" "The nettle library is distributed in the hope that")
+
+;; from GnuTLS-EXTRA [has a different line break in snail mail address]
+(elide-head--add-test gpl3-9 "\
+# This file is part of GnuTLS-EXTRA.
+#
+# GnuTLS-extra is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation; either version 3 of the
+# License, or (at your option) any later version.
+#
+# GnuTLS-extra is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GnuTLS-EXTRA; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301, USA.
+" "GnuTLS-extra is distributed in the hope that")
+
;;; GPLv2
@@ -201,6 +285,28 @@
" "This program is distributed in the hope that")
+;;; Apache License
+
+(elide-head--add-test apache1-1 "\
+/*
+ * Copyright 2011-2016 The Pkcs11Interop Project
+ *
+ * Licensed under the Apache License, Version 2.0 (the \"License\");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * https://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an \"AS IS\" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+" "Unless required by applicable law")
+
+
+
;;; Obsolete
(with-suppressed-warnings ((obsolete elide-head)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 3400128759..5c61ca10b9 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -704,6 +704,59 @@ inner loops respectively."
(let ((bytecomp-tests--xx 1))
(set (make-local-variable 'bytecomp-tests--xx) 2)
bytecomp-tests--xx)
+
+ ;; Check for-effect optimisation of `condition-case' body form.
+ ;; With `condition-case' in for-effect context:
+ (let ((x (bytecomp-test-identity ?A))
+ (r nil))
+ (condition-case e
+ (characterp x) ; value (:success, var)
+ (error (setq r 'bad))
+ (:success (setq r (list 'good e))))
+ r)
+ (let ((x (bytecomp-test-identity ?B))
+ (r nil))
+ (condition-case nil
+ (characterp x) ; for-effect (:success, no var)
+ (error (setq r 'bad))
+ (:success (setq r 'good)))
+ r)
+ (let ((x (bytecomp-test-identity ?C))
+ (r nil))
+ (condition-case e
+ (characterp x) ; for-effect (no :success, var)
+ (error (setq r (list 'bad e))))
+ r)
+ (let ((x (bytecomp-test-identity ?D))
+ (r nil))
+ (condition-case nil
+ (characterp x) ; for-effect (no :success, no var)
+ (error (setq r 'bad)))
+ r)
+ ;; With `condition-case' in value context:
+ (let ((x (bytecomp-test-identity ?E)))
+ (condition-case e
+ (characterp x) ; for-effect (:success, var)
+ (error (list 'bad e))
+ (:success (list 'good e))))
+ (let ((x (bytecomp-test-identity ?F)))
+ (condition-case nil
+ (characterp x) ; for-effect (:success, no var)
+ (error 'bad)
+ (:success 'good)))
+ (let ((x (bytecomp-test-identity ?G)))
+ (condition-case e
+ (characterp x) ; value (no :success, var)
+ (error (list 'bad e))))
+ (let ((x (bytecomp-test-identity ?H)))
+ (condition-case nil
+ (characterp x) ; value (no :success, no var)
+ (error 'bad)))
+
+ (condition-case nil
+ (bytecomp-test-identity 3)
+ (error 'bad)
+ (:success)) ; empty handler
)
"List of expressions for cross-testing interpreted and compiled code.")
@@ -869,6 +922,16 @@ byte-compiled. Run with dynamic binding."
(bytecomp--with-warning-test "defvar.*foo.*wider than.*characters"
`(defvar foo t ,bytecomp-tests--docstring)))
+(ert-deftest bytecomp-warn-quoted-condition ()
+ (bytecomp--with-warning-test
+ "Warning: `condition-case' condition should not be quoted: 'arith-error"
+ '(condition-case nil
+ (abc)
+ ('arith-error "ugh")))
+ (bytecomp--with-warning-test
+ "Warning: `ignore-error' condition argument should not be quoted: 'error"
+ '(ignore-error 'error (abc))))
+
(ert-deftest bytecomp-warn-dodgy-args-eq ()
(dolist (fn '(eq eql))
(cl-flet ((msg (type arg)
@@ -1370,7 +1433,50 @@ literals (Bug#20852)."
(set-buffer (get-buffer-create "foo"))
nil))
'((suspicious set-buffer))
- "Warning: Use .with-current-buffer. rather than"))
+ "Warning: Use .with-current-buffer. rather than")
+
+ (test-suppression
+ '(defun zot ()
+ (let ((_ 1))
+ ))
+ '((empty-body let))
+ "Warning: `let' with empty body")
+
+ (test-suppression
+ '(defun zot ()
+ (let* ((_ 1))
+ ))
+ '((empty-body let*))
+ "Warning: `let\\*' with empty body")
+
+ (test-suppression
+ '(defun zot (x)
+ (when x
+ ))
+ '((empty-body when))
+ "Warning: `when' with empty body")
+
+ (test-suppression
+ '(defun zot (x)
+ (unless x
+ ))
+ '((empty-body unless))
+ "Warning: `unless' with empty body")
+
+ (test-suppression
+ '(defun zot (x)
+ (ignore-error arith-error
+ ))
+ '((empty-body ignore-error))
+ "Warning: `ignore-error' with empty body")
+
+ (test-suppression
+ '(defun zot (x)
+ (with-suppressed-warnings ((suspicious eq))
+ ))
+ '((empty-body with-suppressed-warnings))
+ "Warning: `with-suppressed-warnings' with empty body")
+ )
(ert-deftest bytecomp-tests--not-writable-directory ()
"Test that byte compilation works if the output directory isn't
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index 63e7cd7608..1cfd218592 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -82,6 +82,40 @@
(should-not (buffer-live-p buffer-1))
(should (buffer-live-p buffer-2))))))
+(ert-deftest ert-test-with-buffer-selected/current ()
+ (let ((origbuf (current-buffer)))
+ (ert-with-test-buffer ()
+ (let ((buf (current-buffer)))
+ (should (not (eq buf origbuf)))
+ (with-current-buffer origbuf
+ (ert-with-buffer-selected buf
+ (should (eq (current-buffer) buf))))))))
+
+(ert-deftest ert-test-with-buffer-selected/selected ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (eq (window-buffer) (current-buffer))))))
+
+(ert-deftest ert-test-with-buffer-selected/nil-buffer ()
+ (ert-with-test-buffer ()
+ (let ((buf (current-buffer)))
+ (ert-with-buffer-selected nil
+ (should (eq (window-buffer) buf))))))
+
+(ert-deftest ert-test-with-buffer-selected/modification-hooks ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (null inhibit-modification-hooks)))))
+
+(ert-deftest ert-test-with-buffer-selected/read-only ()
+ (ert-with-test-buffer ()
+ (ert-with-buffer-selected (current-buffer)
+ (should (null inhibit-read-only))
+ (should (null buffer-read-only)))))
+
+(ert-deftest ert-test-with-buffer-selected/return-value ()
+ (should (equal (ert-with-buffer-selected nil "foo") "foo")))
+
(ert-deftest ert-test-with-test-buffer-selected/selected ()
(ert-with-test-buffer-selected ()
(should (eq (window-buffer) (current-buffer)))))
@@ -90,6 +124,11 @@
(ert-with-test-buffer-selected ()
(should (null inhibit-modification-hooks))))
+(ert-deftest ert-test-with-test-buffer-selected/read-only ()
+ (ert-with-test-buffer-selected ()
+ (should (null inhibit-read-only))
+ (should (null buffer-read-only))))
+
(ert-deftest ert-test-with-test-buffer-selected/return-value ()
(should (equal (ert-with-test-buffer-selected () "foo") "foo")))
diff --git a/test/lisp/emacs-lisp/multisession-tests.el
b/test/lisp/emacs-lisp/multisession-tests.el
index 5807c27bd2..68d9c9646f 100644
--- a/test/lisp/emacs-lisp/multisession-tests.el
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -94,7 +94,7 @@
(dotimes (i 100)
(cl-incf (multisession-value
multisession--bar))))))))
(while (process-live-p proc)
- (ignore-error 'sqlite-locked-error
+ (ignore-error sqlite-locked-error
(message "multisession--bar %s" (multisession-value
multisession--bar))
;;(cl-incf (multisession-value multisession--bar))
)
diff --git a/test/lisp/erc/erc-scenarios-base-unstable.el
b/test/lisp/erc/erc-scenarios-base-unstable.el
index f5b8df6f4a..e6db40c5ef 100644
--- a/test/lisp/erc/erc-scenarios-base-unstable.el
+++ b/test/lisp/erc/erc-scenarios-base-unstable.el
@@ -24,7 +24,7 @@
(let ((load-path (cons (ert-resource-directory) load-path)))
(require 'erc-scenarios-common)))
-(eval-when-compile (require 'erc-join))
+(eval-when-compile (require 'erc-join) (require 'warnings))
;; Not unstable, but stashed here for now
@@ -132,4 +132,56 @@
(not (setq failed (zerop (cl-decf tries)))))))
(should-not failed)))
+;; The `erc-networks' library has slowly become a hard dependency of
+;; the interactive client since its incorporation in 2006. But its
+;; module, which was added in ERC 5.3 (2008) and thereafter loaded by
+;; default, only became quasi-required in ERC 5.5 (2022). Despite
+;; this, a basic connection should still always succeed, at least long
+;; enough to warn users that their setup is abnormal. Of course,
+;; third-party code intentionally omitting the module will have to
+;; override various erc-server-*-functions to avoid operating in a
+;; degraded state, which has likely been the case for a while.
+
+(ert-deftest erc-scenarios-networks-no-module ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "networks/no-module")
+ (erc-server-flood-penalty 0.1)
+ (erc-networks-mode-orig erc-networks-mode)
+ (dumb-server (erc-d-run "localhost" t 'basic))
+ (port (process-contact dumb-server :service))
+ (erc-modules (remq 'networks erc-modules))
+ (warning-suppress-log-types '((erc)))
+ (expect (erc-d-t-make-expecter)))
+
+ (erc-networks-mode -1)
+ (ert-info ("Connect and retain dialed name")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :user "tester"
+ :full-name "tester")
+ (funcall expect 10 "Required module `networks' not loaded")
+ (funcall expect 10 "This server is in debug mode")
+ ;; Buffer not named after network
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+ (erc-cmd-JOIN "#chan")))
+
+ (ert-info ("Join #chan, change nick, query op")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 20 "Even at thy teat thou")
+ (erc-cmd-NICK "dummy")
+ (funcall expect 10 "Your new nickname is dummy")
+ (erc-scenarios-common-say "/msg alice hi")))
+
+ (ert-info ("Switch to query and quit")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "alice"))
+ (funcall expect 20 "bye"))
+
+ (with-current-buffer (format "127.0.0.1:%d" port)
+ (erc-cmd-QUIT "")
+ (funcall expect 10 "finished")))
+ (when erc-networks-mode-orig
+ (erc-networks-mode +1))))
+
;;; erc-scenarios-base-unstable.el ends here
diff --git a/test/lisp/erc/resources/networks/no-module/basic.eld
b/test/lisp/erc/resources/networks/no-module/basic.eld
new file mode 100644
index 0000000000..f1bdbd1219
--- /dev/null
+++ b/test/lisp/erc/resources/networks/no-module/basic.eld
@@ -0,0 +1,44 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 1 "USER tester 0 * :tester")
+ (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.00 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running
version ergo-v2.8.0")
+ (0.00 ":irc.foonet.org 003 tester :This server was created Mon, 12 Dec 2022
01:25:38 UTC")
+ (0.00 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.8.0 BERTZios
CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
+ (0.00 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES
MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by
this server")
+ (0.00 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1
server(s)")
+ (0.00 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.00 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.00 ":irc.foonet.org 254 tester 1 :channels formed")
+ (0.00 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
+ (0.00 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
+ (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
+ (0.00 ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.00 ":irc.foonet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
+
+((join 10 "JOIN #chan")
+ (0.03 ":tester!~u@z5d6jyn8pwxge.irc JOIN #chan"))
+
+((~nick 10 "NICK dummy")
+ (0.01 ":tester!~u@z5d6jyn8pwxge.irc NICK dummy"))
+
+((mode-1 10 "MODE #chan")
+ (0.01 ":irc.foonet.org 353 tester = #chan :@alice bob foonet tester")
+ (0.00 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.03 ":irc.foonet.org 324 tester #chan +nt")
+ (0.00 ":irc.foonet.org 329 tester #chan 1670808354")
+ (0.00 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
+ (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :tester, welcome!")
+ (0.03 ":bob!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :alice: Forbear it therefore;
give your cause to heaven.")
+ (0.01 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG #chan :bob: Even at thy teat thou
hadst thy tyranny."))
+
+((privmsg 10 "PRIVMSG alice :hi")
+ (0.00 ":alice!~u@d6ftaiqzk8x2k.irc PRIVMSG dummy :bye"))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.03 ":dummy!~u@z5d6jyn8pwxge.irc QUIT :Quit: \2ERC\2"))
diff --git a/test/lisp/eshell/em-tramp-tests.el
b/test/lisp/eshell/em-tramp-tests.el
index 982a1eba27..936397d886 100644
--- a/test/lisp/eshell/em-tramp-tests.el
+++ b/test/lisp/eshell/em-tramp-tests.el
@@ -23,40 +23,41 @@
(require 'em-tramp)
(require 'tramp)
+(defmacro em-tramp-test/should-replace-command (form replacement)
+ "Check that calling FORM results in it being replaced with REPLACEMENT."
+ (declare (indent 1))
+ `(should (equal
+ (catch 'eshell-replace-command ,form)
+ (list 'eshell-with-copied-handles
+ (list 'eshell-trap-errors
+ ,replacement)
+ t))))
+
(ert-deftest em-tramp-test/su-default ()
"Test Eshell `su' command with no arguments."
- (should (equal
- (catch 'eshell-replace-command (eshell/su))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/su:root@%s:%s"
- tramp-default-host default-directory))))))))
+ (em-tramp-test/should-replace-command (eshell/su)
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/su:root@%s:%s"
+ tramp-default-host default-directory)))))
(ert-deftest em-tramp-test/su-user ()
"Test Eshell `su' command with USER argument."
- (should (equal
- (catch 'eshell-replace-command (eshell/su "USER"))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/su:USER@%s:%s"
- tramp-default-host default-directory))))))))
+ (em-tramp-test/should-replace-command (eshell/su "USER")
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/su:USER@%s:%s"
+ tramp-default-host default-directory)))))
(ert-deftest em-tramp-test/su-login ()
"Test Eshell `su' command with -/-l/--login option."
(dolist (args '(("--login")
("-l")
("-")))
- (should (equal
- (catch 'eshell-replace-command (apply #'eshell/su args))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/su:root@%s:~/" tramp-default-host)))))))))
+ (em-tramp-test/should-replace-command (apply #'eshell/su args)
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/su:root@%s:~/" tramp-default-host))))))
(defun mock-eshell-named-command (&rest args)
"Dummy function to test Eshell `sudo' command rewriting."
@@ -92,25 +93,19 @@
"Test Eshell `sudo' command with -s/--shell option."
(dolist (args '(("--shell")
("-s")))
- (should (equal
- (catch 'eshell-replace-command (apply #'eshell/sudo args))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/sudo:root@%s:%s"
- tramp-default-host default-directory)))))))))
+ (em-tramp-test/should-replace-command (apply #'eshell/sudo args)
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/sudo:root@%s:%s"
+ tramp-default-host default-directory))))))
(ert-deftest em-tramp-test/sudo-user-shell ()
"Test Eshell `sudo' command with -s and -u options."
- (should (equal
- (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s"))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/sudo:USER@%s:%s"
- tramp-default-host default-directory))))))))
+ (em-tramp-test/should-replace-command (eshell/sudo "-u" "USER" "-s")
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/sudo:USER@%s:%s"
+ tramp-default-host default-directory)))))
(ert-deftest em-tramp-test/doas-basic ()
"Test Eshell `doas' command with default user."
@@ -147,24 +142,18 @@
"Test Eshell `doas' command with -s/--shell option."
(dolist (args '(("--shell")
("-s")))
- (should (equal
- (catch 'eshell-replace-command (apply #'eshell/doas args))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/doas:root@%s:%s"
- tramp-default-host default-directory)))))))))
+ (em-tramp-test/should-replace-command (apply #'eshell/doas args)
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory))))))
(ert-deftest em-tramp-test/doas-user-shell ()
"Test Eshell `doas' command with -s and -u options."
- (should (equal
- (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s"))
- `(eshell-with-copied-handles
- (eshell-trap-errors
- (eshell-named-command
- "cd"
- (list ,(format "/doas:USER@%s:%s"
- tramp-default-host default-directory))))))))
+ (em-tramp-test/should-replace-command (eshell/doas "-u" "USER" "-s")
+ `(eshell-named-command
+ "cd"
+ (list ,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)))))
;;; em-tramp-tests.el ends here
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index 92d785d7fd..42d24967ff 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -148,14 +148,21 @@ e.g. \"{(+ 1 2)} 3\" => 3"
"echo $name; for name in 3 { echo $name }; echo $name"
"env-value\n3\nenv-value\n"))))
+(ert-deftest esh-cmd-test/for-loop-pipe ()
+ "Test invocation of a for loop piped to another command."
+ (skip-unless (executable-find "rev"))
+ (with-temp-eshell
+ (eshell-match-command-output "for i in foo bar baz { echo $i } | rev"
+ "zabraboof")))
+
(ert-deftest esh-cmd-test/while-loop ()
"Test invocation of a while loop."
(with-temp-eshell
(let ((eshell-test-value '(0 1 2)))
(eshell-match-command-output
(concat "while $eshell-test-value "
- "{ setq eshell-test-value (cdr eshell-test-value) }")
- "(1 2)\n(2)\n"))))
+ "{ (pop eshell-test-value) }")
+ "0\n1\n2\n"))))
(ert-deftest esh-cmd-test/while-loop-lisp-form ()
"Test invocation of a while loop using a Lisp form."
@@ -176,6 +183,17 @@ e.g. \"{(+ 1 2)} 3\" => 3"
"{ setq eshell-test-value (1+ eshell-test-value) }")
"1\n2\n3\n"))))
+(ert-deftest esh-cmd-test/while-loop-pipe ()
+ "Test invocation of a while loop piped to another command."
+ (skip-unless (executable-find "rev"))
+ (with-temp-eshell
+ (let ((eshell-test-value '("foo" "bar" "baz")))
+ (eshell-match-command-output
+ (concat "while $eshell-test-value "
+ "{ (pop eshell-test-value) }"
+ " | rev")
+ "zabraboof"))))
+
(ert-deftest esh-cmd-test/until-loop ()
"Test invocation of an until loop."
(with-temp-eshell
@@ -253,6 +271,30 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
(eshell-command-result-equal "if {[ foo = bar ]} {echo yes} {echo no}"
"no"))
+(ert-deftest esh-cmd-test/if-statement-pipe ()
+ "Test invocation of an if statement piped to another command."
+ (skip-unless (executable-find "rev"))
+ (with-temp-eshell
+ (let ((eshell-test-value t))
+ (eshell-match-command-output "if $eshell-test-value {echo yes} | rev"
+ "\\`sey\n?"))
+ (let ((eshell-test-value nil))
+ (eshell-match-command-output "if $eshell-test-value {echo yes} | rev"
+ "\\`\n?"))))
+
+(ert-deftest esh-cmd-test/if-else-statement-pipe ()
+ "Test invocation of an if/else statement piped to another command."
+ (skip-unless (executable-find "rev"))
+ (with-temp-eshell
+ (let ((eshell-test-value t))
+ (eshell-match-command-output
+ "if $eshell-test-value {echo yes} {echo no} | rev"
+ "\\`sey\n?"))
+ (let ((eshell-test-value nil))
+ (eshell-match-command-output
+ "if $eshell-test-value {echo yes} {echo no} | rev"
+ "\\`on\n?"))))
+
(ert-deftest esh-cmd-test/unless-statement ()
"Test invocation of an unless statement."
(let ((eshell-test-value t))
diff --git a/test/lisp/eshell/esh-io-tests.el b/test/lisp/eshell/esh-io-tests.el
index 9a3c14f365..52501f5bb7 100644
--- a/test/lisp/eshell/esh-io-tests.el
+++ b/test/lisp/eshell/esh-io-tests.el
@@ -301,15 +301,29 @@ stdout originally pointed (the terminal)."
"stderr\n"))
(should (equal (buffer-string) "stdout\n"))))
-(ert-deftest esh-io-test/redirect-pipe ()
- "Check that \"redirecting\" to a pipe works."
- ;; `|' should only redirect stdout.
+
+;; Pipelines
+
+(ert-deftest esh-io-test/pipeline/default ()
+ "Check that `|' only pipes stdout."
+ (skip-unless (executable-find "rev"))
(eshell-command-result-equal "test-output | rev"
- "stderr\ntuodts\n")
- ;; `|&' should redirect stdout and stderr.
+ "stderr\ntuodts\n"))
+
+
+(ert-deftest esh-io-test/pipeline/all ()
+ "Check that `|&' only pipes stdout and stderr."
+ (skip-unless (executable-find "rev"))
(eshell-command-result-equal "test-output |& rev"
"tuodts\nrredts\n"))
+(ert-deftest esh-io-test/pipeline/subcommands ()
+ "Chek that all commands in a subcommand are properly piped."
+ (skip-unless (executable-find "rev"))
+ (with-temp-eshell
+ (eshell-match-command-output "{echo foo; echo bar} | rev"
+ "\\`raboof\n?")))
+
;; Virtual targets
diff --git a/test/lisp/eshell/eshell-tests-helpers.el
b/test/lisp/eshell/eshell-tests-helpers.el
index 1d9674070c..a933805031 100644
--- a/test/lisp/eshell/eshell-tests-helpers.el
+++ b/test/lisp/eshell/eshell-tests-helpers.el
@@ -33,9 +33,9 @@
(defvar eshell-history-file-name nil)
(defvar eshell-last-dir-ring-file-name nil)
-(defvar eshell-test--max-subprocess-time 5
- "The maximum amount of time to wait for a subprocess to finish, in seconds.
-See `eshell-wait-for-subprocess'.")
+(defvar eshell-test--max-wait-time 5
+ "The maximum amount of time to wait for a condition to resolve, in seconds.
+See `eshell-wait-for'.")
(defun eshell-tests-remote-accessible-p ()
"Return if a test involving remote files can proceed.
@@ -73,19 +73,28 @@ BUFNAME will be set to the name of the temporary buffer."
(let ((,bufname (buffer-name)))
,@body)))
+(defun eshell-wait-for (predicate &optional message)
+ "Wait until PREDICATE returns non-nil.
+If this takes longer than `eshell-test--max-wait-time', raise an
+error. MESSAGE is an optional message to use if this times out."
+ (let ((start (current-time))
+ (message (or message "timed out waiting for condition")))
+ (while (not (funcall predicate))
+ (when (> (float-time (time-since start))
+ eshell-test--max-wait-time)
+ (error message))
+ (sit-for 0.1))))
+
(defun eshell-wait-for-subprocess (&optional all)
"Wait until there is no interactive subprocess running in Eshell.
If ALL is non-nil, wait until there are no Eshell subprocesses at
all running.
-If this takes longer than `eshell-test--max-subprocess-time',
+If this takes longer than `eshell-test--max-wait-time',
raise an error."
- (let ((start (current-time)))
- (while (if all eshell-process-list (eshell-interactive-process-p))
- (when (> (float-time (time-since start))
- eshell-test--max-subprocess-time)
- (error "timed out waiting for subprocess(es)"))
- (sit-for 0.1))))
+ (eshell-wait-for
+ (lambda ()
+ (not (if all eshell-process-list (eshell-interactive-process-p))))))
(defun eshell-insert-command (command &optional func)
"Insert a COMMAND at the end of the buffer.
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index c67ac67fd3..dd8be8e65f 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -128,16 +128,17 @@
(delete-region (point) (point-max))))))
(ert-deftest eshell-test/queue-input ()
- "Test queuing command input"
+ "Test queuing command input.
+This should let the current command finish, then automatically
+insert the queued one at the next prompt, and finally run it."
(with-temp-eshell
- (eshell-insert-command "sleep 2")
- (eshell-insert-command "echo alpha" 'eshell-queue-input)
- (let ((count 10))
- (while (and eshell-current-command
- (> count 0))
- (sit-for 1)
- (setq count (1- count))))
- (should (eshell-match-output "alpha\n"))))
+ (eshell-insert-command "sleep 1; echo slept")
+ (eshell-insert-command "echo alpha" #'eshell-queue-input)
+ (let ((start (marker-position (eshell-beginning-of-output))))
+ (eshell-wait-for (lambda () (not eshell-current-command)))
+ (should (string-match "^slept\n.*echo alpha\nalpha\n$"
+ (buffer-substring-no-properties
+ start (eshell-end-of-output)))))))
(ert-deftest eshell-test/flush-output ()
"Test flushing of previous output"
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index d7f4576335..50b0e948e4 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5510,15 +5510,11 @@ INPUT, if non-nil, is a string sent to the process."
;; String to be sent.
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
- (string-equal
- ;; tramp-adb.el echoes, so we must add the string.
- (if (and (tramp--test-adb-p)
- (not (tramp-direct-async-process-p)))
- (format
- "%s\n%s\n"
- (file-name-nondirectory tmp-name)
- (file-name-nondirectory tmp-name))
- (format "%s\n" (file-name-nondirectory tmp-name)))
+ (string-match-p
+ ;; Some shells echo, for example the "adb" or "docker" methods.
+ (tramp-compat-rx
+ bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
+ eos)
(buffer-string))))
;; Cleanup.
diff --git
a/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
new file mode 100644
index 0000000000..25cd8736f9
--- /dev/null
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-after-operator-indent.rb
@@ -0,0 +1,29 @@
+4 +
+ 5 +
+ 6 +
+ 7
+
+qux = 4 + 5 *
+ 6 +
+ 7
+
+foo = obj.bar { |m| tee(m) } +
+ obj.qux { |m| hum(m) }
+
+foo.
+ bar
+ .baz
+
+qux = foo.fee ?
+ bar :
+ tee
+
+# Endless methods.
+class Bar
+ def foo(abc) = bar +
+ baz
+end
+
+# Local Variables:
+# ruby-after-operator-indent: nil
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-block-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-block-indent.rb
new file mode 100644
index 0000000000..32882814b7
--- /dev/null
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-block-indent.rb
@@ -0,0 +1,33 @@
+foo
+ .asdasd
+ .proc do |**args|
+ p(**args)
+ end
+
+foo
+ .asdasd
+ .proc { |**args|
+ p(**args)
+ }
+
+bar.foo do
+ bar
+end
+
+bar.foo(tee) do
+ bar
+end
+
+bar.foo(tee) {
+ bar
+}
+
+x.foo do
+ foo
+end.bar do
+ bar
+end
+
+# Local Variables:
+# ruby-block-indent: nil
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
new file mode 100644
index 0000000000..1a8285ee91
--- /dev/null
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
@@ -0,0 +1,15 @@
+foo2 =
+ subject.
+ update(
+ 2
+ )
+
+foo3 =
+ subject
+ .update(
+ 2
+ )
+
+# Local Variables:
+# ruby-method-call-indent: nil
+# End:
diff --git
a/test/lisp/progmodes/ruby-mode-resources/ruby-parenless-call-arguments-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-parenless-call-arguments-indent.rb
new file mode 100644
index 0000000000..58e08810c4
--- /dev/null
+++
b/test/lisp/progmodes/ruby-mode-resources/ruby-parenless-call-arguments-indent.rb
@@ -0,0 +1,23 @@
+method arg1,
+ method2 arg2,
+ arg3, [
+ arg4,
+ arg5
+ ]
+
+zzz = method (a + b),
+ c, :d => :e,
+ f: g
+
+return render json: {
+ errors: { base: [message] },
+ copying: copying
+ },
+ status: 400
+
+foo(a,
+ b)
+
+# Local Variables:
+# ruby-parenless-call-arguments-indent: nil
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 6a69d9db78..bfae948b25 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -226,6 +226,7 @@ desc "foo foo" \
foo.
bar
+ .baz
#
https://github.com/rails/rails/blob/17f5d8e062909f1fcae25351834d8e89967b645e/activesupport/lib/active_support/time_with_zone.rb#L206
foo # comment intended to confuse the tokenizer
@@ -380,6 +381,18 @@ foo = [1, 2, 3].map do |i|
i + 1
end
+m1 = foo
+ .asdasd
+ .proc do |**args|
+ p(**args)
+end
+
+m2 = foo
+ .asdasd
+ .proc { |**args|
+ p(**args)
+}
+
bar.foo do
bar
end
@@ -398,6 +411,12 @@ bar 1 do
end
end
+x.foo do
+ foo
+end.bar do
+ bar
+end
+
foo |
bar
@@ -540,5 +559,9 @@ class Bar
end
# Local Variables:
+# ruby-after-operator-indent: t
+# ruby-block-indent: t
+# ruby-method-call-indent: t
# ruby-method-params-indent: t
+# ruby-parenless-call-arguments-indent: t
# End:
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 560f780285..5c81cc31cc 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -956,7 +956,11 @@ VALUES-PLIST is a list with alternating index and value
elements."
(kill-buffer buf)))))
(ruby-deftest-indent "ruby.rb")
+(ruby-deftest-indent "ruby-after-operator-indent.rb")
+(ruby-deftest-indent "ruby-block-indent.rb")
+(ruby-deftest-indent "ruby-method-call-indent.rb")
(ruby-deftest-indent "ruby-method-params-indent.rb")
+(ruby-deftest-indent "ruby-parenless-call-arguments-indent.rb")
(ert-deftest ruby--test-chained-indentation ()
(with-temp-buffer
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 19e3dbb42a..b67ccd4fe0 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -478,5 +478,84 @@ baz"))))
(should (equal (diff-hunk-file-names)
'("/tmp/ange-ftp1351895K.el" "/tmp/ange-ftp13518wvE.el")))))
+(ert-deftest diff-mode-test-fixups-added-lines ()
+ "Check that `diff-fixup-modifs' works well with hunks with added lines."
+ (let ((patch "--- file
++++ file
+@@ -0,0 +1,15 @@
++1
++2
++3
++4
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -0,0 +1,4 @@
++1
++2
++3
++4
+"))))
+ (let ((patch "--- file
++++ file
+@@ -389,5 +398,6 @@
+ while (1)
+ ;
++ # not needed
+ # at all
+ # stop
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -389,4 +398,5 @@
+ while (1)
+ ;
++ # not needed
+ # at all
+ # stop
+")))))
+
+(ert-deftest diff-mode-test-fixups-empty-hunks ()
+ "Check that `diff-fixup-modifs' works well with empty hunks."
+ (let ((patch "--- file
++++ file
+@@ -1 +1 @@
+-1
+@@ -10 +10 @@
+-1
++1
+--- otherfile
++++ otherfile
+@@ -1 +1 @@
++2
+@@ -10 +10 @@
+-1
++1
+"))
+ (with-temp-buffer
+ (insert patch)
+ (diff-fixup-modifs (point-min) (point-max))
+ (should (equal (buffer-string) "--- file
++++ file
+@@ -1,1 +1,0 @@
+-1
+@@ -10,1 +10,1 @@
+-1
++1
+--- otherfile
++++ otherfile
+@@ -1,0 +1,1 @@
++2
+@@ -10,1 +10,1 @@
+-1
++1
+")))))
+
(provide 'diff-mode-tests)
;;; diff-mode-tests.el ends here
diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el
index 12f6cb99a2..3a53e02503 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -42,13 +42,6 @@ nil, `whitespace-mode' is left disabled."
'(whitespace-mode 1))
,@body)))
-(defmacro whitespace--with-buffer-selected (buffer-or-name &rest body)
- (declare (debug (form body)) (indent 1))
- `(save-window-excursion
- (with-current-buffer (or ,buffer-or-name (current-buffer))
- (with-selected-window (display-buffer (current-buffer))
- ,@body))))
-
(defun whitespace-tests--faceup (&rest lines)
"Convenience wrapper around `faceup-test-font-lock-buffer'.
Returns non-nil if the concatenated LINES match the current
@@ -64,6 +57,24 @@ buffer's content."
(whitespace-cleanup)
(buffer-string)))
+(ert-deftest whitespace-tests--global ()
+ (let ((backup global-whitespace-mode)
+ (noninteractive nil)
+ (whitespace-enable-predicate (lambda () t)))
+ (unwind-protect
+ (progn
+ (global-whitespace-mode 1)
+ (ert-with-test-buffer-selected ()
+ (normal-mode)
+ (should whitespace-mode)
+ (global-whitespace-mode -1)
+ (should (null whitespace-mode))
+ (whitespace-mode 1)
+ (should whitespace-mode)
+ (global-whitespace-mode 1)
+ (should whitespace-mode)))
+ (global-whitespace-mode (if backup 1 -1)))))
+
(ert-deftest whitespace-cleanup-eob ()
(let ((whitespace-style '(empty)))
(should (equal (whitespace-tests--cleanup-string "a\n")
@@ -354,7 +365,7 @@ buffer's content."
(indirect (clone-indirect-buffer (buffer-name) nil)))
(should (eq (marker-buffer whitespace-bob-marker) base))
(should (eq (marker-buffer whitespace-eob-marker) base))
- (whitespace--with-buffer-selected indirect
+ (ert-with-buffer-selected indirect
;; Mutate the indirect buffer to update its bob/eob markers.
(execute-kbd-macro (kbd "z RET M-< a")))
;; With Bug#59618, the above mutation would cause the base
@@ -382,7 +393,7 @@ buffer's content."
;; because the buffer should only be killed on success.
(indirect (clone-indirect-buffer nil nil)))
(whitespace-tests--check-markers base 2 4)
- (whitespace--with-buffer-selected indirect
+ (ert-with-buffer-selected indirect
(whitespace-tests--check-markers indirect 2 4)
;; Mutate the buffer to trigger `after-change-functions' and
;; thus `whitespace--update-bob-eob'.
@@ -405,7 +416,7 @@ buffer's content."
;; the buffer should only be killed on success.
(clone (clone-buffer)))
(whitespace-tests--check-markers orig 2 4)
- (whitespace--with-buffer-selected clone
+ (ert-with-buffer-selected clone
(whitespace-tests--check-markers clone 2 4)
(execute-kbd-macro (kbd "z RET M-< a"))
(whitespace-tests--check-markers clone 1 8))
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 7d3d9eb72b..f0b9dc0fb9 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -830,7 +830,7 @@ Return nil if that can't be determined."
(when (eq process-tests--EMFILE-message :unknown)
(setq process-tests--EMFILE-message
(with-temp-buffer
- (when (eql (ignore-error 'file-error
+ (when (eql (ignore-error file-error
(call-process "errno" nil t nil "EMFILE"))
0)
(goto-char (point-min))
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index b323f592dc..977b2f6371 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -273,7 +273,7 @@ on success"
string
(condition-case nil
(if (string-match pattern string) nil 'search-failed)
- ('invalid-regexp 'compilation-failed))
+ (invalid-regexp 'compilation-failed))
bounds-ref substring-ref)))
@@ -518,7 +518,7 @@ known/benign differences in behavior.")
what-failed
(condition-case nil
(if (string-match pattern string) nil 'search-failed)
- ('invalid-regexp 'compilation-failed))
+ (invalid-regexp 'compilation-failed))
matches-observed
(cl-loop for x from 0 to 20
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index 48b61cf3dc..f7f0c96efa 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -252,9 +252,7 @@ BODY is the test body."
(setq parser (treesit-parser-create 'json))
(setq root (treesit-parser-root-node
parser))
- (setq array (treesit-node-child root 0))
- ;; First bracket.
- (setq cursor (treesit-node-child array 0)))
+ (setq array (treesit-node-child root 0)))
,@body)))
(ert-deftest treesit-search-forward ()
@@ -335,6 +333,9 @@ BODY is the test body."
;;; Query
+(defun treesit--ert-pred-last-sibling (node)
+ (null (treesit-node-next-sibling node t)))
+
(ert-deftest treesit-query-api ()
"Tests for query API."
(skip-unless (treesit-language-available-p 'json))
@@ -357,13 +358,16 @@ BODY is the test body."
(pair key: (_) @keyword)
((_) @bob (#match \"^B.b$\" @bob))
(number) @number
-((number) @n3 (#equal \"3\" @n3)) "
+((number) @n3 (#equal \"3\" @n3))
+((number) @n3p (#pred treesit--ert-pred-last-sibling @n3p))"
;; Sexp query.
((string) @string
(pair key: (_) @keyword)
((_) @bob (:match "^B.b$" @bob))
(number) @number
- ((number) @n3 (:equal "3" @n3)))))
+ ((number) @n3 (:equal "3" @n3))
+ ((number) @n3p (:pred treesit--ert-pred-last-sibling
+ @n3p)))))
;; Test `treesit-query-compile'.
(dolist (query (list query1
(treesit-query-compile 'json query1)))
@@ -375,7 +379,8 @@ BODY is the test body."
(string . "\"Bob\"")
(bob . "Bob")
(number . "3")
- (n3 . "3"))
+ (n3 . "3")
+ (n3p . "3"))
(mapcar (lambda (entry)
(cons (car entry)
(treesit-node-text
@@ -831,36 +836,40 @@ OPENING and CLOSING are the same as in
and \"]\"."
(with-temp-buffer
(funcall init)
- (let* ((opening (or opening "["))
- (closing (or closing "]"))
- ;; Insert program and parse marker positions.
- (marker-alist (treesit--ert-insert-and-parse-marker
- opening closing program))
- ;; Translate marker positions into buffer positions.
- (decoded-master
- (cl-loop for record in master
- collect
- (cl-loop for pos in record
- collect (alist-get pos marker-alist))))
- ;; Collect positions each function returns.
- (positions
- (treesit--ert-collect-positions
- ;; The first column of DECODED-MASTER.
- (mapcar #'car decoded-master)
- ;; Four functions: next-end, prev-beg, next-beg, prev-end.
- (mapcar (lambda (conf)
- (lambda ()
- (if-let ((pos (funcall
- #'treesit--navigate-defun
- (point) (car conf) (cdr conf))))
- (save-excursion
- (goto-char pos)
- (funcall treesit-defun-skipper)
- (point)))))
- '((-1 . beg)
- (1 . end)
- (-1 . end)
- (1 . beg))))))
+ (pcase-let*
+ ((opening (or opening "["))
+ (closing (or closing "]"))
+ ;; Insert program and parse marker positions.
+ (marker-alist (treesit--ert-insert-and-parse-marker
+ opening closing program))
+ ;; Translate marker positions into buffer positions.
+ (decoded-master
+ (cl-loop for record in master
+ collect
+ (cl-loop for pos in record
+ collect (alist-get pos marker-alist))))
+ (`(,regexp . ,pred) (treesit--thing-unpack-pattern
+ treesit-defun-type-regexp))
+ ;; Collect positions each function returns.
+ (positions
+ (treesit--ert-collect-positions
+ ;; The first column of DECODED-MASTER.
+ (mapcar #'car decoded-master)
+ ;; Four functions: next-end, prev-beg, next-beg, prev-end.
+ (mapcar (lambda (conf)
+ (lambda ()
+ (if-let ((pos (funcall
+ #'treesit--navigate-thing
+ (point) (car conf) (cdr conf)
+ regexp pred)))
+ (save-excursion
+ (goto-char pos)
+ (funcall treesit-defun-skipper)
+ (point)))))
+ '((-1 . beg)
+ (1 . end)
+ (-1 . end)
+ (1 . beg))))))
;; Verify each position.
(cl-loop for record in decoded-master
for orig-record in master
@@ -931,7 +940,28 @@ and \"]\"."
[999]}
[110]
"
- "Javascript source for navigation test.")
+ "Bash source for navigation test.")
+
+(defvar treesit--ert-defun-navigation-elixir-program
+ "[100]
+[101]def bar() do
+[999]end
+[102]
+[103]defmodule Example do[0]
+[999] @impl true
+[104] [1]def bar() do[2]
+[999] end[3]
+[105] [4]
+[106] [5]def baz() do[6]
+[999] end[7]
+[107] [8]
+[999]end[9]
+[108]
+[109]def bar() do
+[999]end
+[110]
+"
+ "Elixir source for navigation test.")
(defvar treesit--ert-defun-navigation-nested-master
;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
@@ -1013,6 +1043,23 @@ the prev-beg, now point should be at marker 103\", etc.")
treesit--ert-defun-navigation-bash-program
treesit--ert-defun-navigation-nested-master)))
+(ert-deftest treesit-defun-navigation-nested-4 ()
+ "Test defun navigation using Elixir.
+This tests bug#60355."
+ (skip-unless (treesit-language-available-p 'elixir))
+ ;; Nested defun navigation
+ (let ((treesit-defun-tactic 'nested)
+ (pred (lambda (node)
+ (member (treesit-node-text
+ (treesit-node-child-by-field-name node "target"))
+ '("def" "defmodule")))))
+ (treesit--ert-test-defun-navigation
+ (lambda ()
+ (treesit-parser-create 'elixir)
+ (setq-local treesit-defun-type-regexp `("call" . ,pred)))
+ treesit--ert-defun-navigation-elixir-program
+ treesit--ert-defun-navigation-nested-master)))
+
(ert-deftest treesit-defun-navigation-top-level ()
"Test top-level only defun navigation."
(skip-unless (treesit-language-available-p 'python))