[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/pkg 716d676747: Merge remote-tracking branch 'origin/master' int
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/pkg 716d676747: Merge remote-tracking branch 'origin/master' into scratch/pkg |
|
Date: |
Sat, 31 Dec 2022 03:06:46 -0500 (EST) |
branch: scratch/pkg
commit 716d676747119f9950861f9a64a8e7871b0082d4
Merge: 54ec3973e2 7493b4026f
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into scratch/pkg
---
ChangeLog.3 | 16 +-
admin/admin.el | 3 +
admin/find-gc.el | 2 +-
admin/git-bisect-start | 2 +-
admin/gitmerge.el | 2 +-
configure.ac | 37 +-
doc/emacs/custom.texi | 6 +-
doc/emacs/display.texi | 12 +-
doc/emacs/maintaining.texi | 2 +-
doc/lispref/ChangeLog.1 | 2 +-
doc/lispref/compile.texi | 2 +-
doc/lispref/display.texi | 44 +-
doc/lispref/edebug.texi | 23 +-
doc/lispref/eval.texi | 3 -
doc/lispref/modes.texi | 43 +-
doc/lispref/parsing.texi | 127 ++++-
doc/lispref/text.texi | 2 +-
doc/lispref/tips.texi | 2 +-
doc/misc/ChangeLog.1 | 2 +-
doc/misc/calc.texi | 13 +-
doc/misc/cc-mode.texi | 2 +-
doc/misc/erc.texi | 12 +-
doc/misc/eshell.texi | 5 -
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 | 608 ++++++++++++---------
etc/ORG-NEWS | 8 +-
etc/PROBLEMS | 14 +-
etc/emacsclient-mail.desktop | 4 +-
etc/emacsclient.desktop | 2 +-
etc/package-keyring.gpg | Bin 2069 -> 2043 bytes
etc/tutorials/TUTORIAL.cn | 4 +-
etc/tutorials/TUTORIAL.fr | 2 +-
lib/file-has-acl.c | 120 +++-
lib/time.in.h | 1 +
lisp/ChangeLog.14 | 4 +-
lisp/ChangeLog.7 | 2 +-
lisp/abbrev.el | 2 +-
lisp/bindings.el | 13 +-
lisp/calendar/cal-dst.el | 12 +-
lisp/calendar/diary-lib.el | 2 +-
lisp/calendar/solar.el | 10 +-
lisp/cedet/ChangeLog.1 | 2 +-
lisp/cedet/semantic/decorate/include.el | 8 +-
lisp/cedet/semantic/lex-spp.el | 2 +-
lisp/cedet/semantic/lex.el | 2 +-
lisp/comint.el | 4 +-
lisp/cus-edit.el | 4 +-
lisp/desktop.el | 2 +-
lisp/dired.el | 2 +-
lisp/elide-head.el | 62 ++-
lisp/emacs-lisp/byte-opt.el | 5 +-
lisp/emacs-lisp/byte-run.el | 4 +-
lisp/emacs-lisp/bytecomp.el | 31 +-
lisp/emacs-lisp/comp.el | 4 +-
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 | 12 +-
lisp/erc/erc-networks.el | 26 +-
lisp/erc/erc-sasl.el | 2 +-
lisp/erc/erc.el | 18 +-
lisp/eshell/em-elecslash.el | 14 +-
lisp/eshell/em-prompt.el | 4 +-
lisp/eshell/esh-cmd.el | 39 +-
lisp/eshell/esh-io.el | 170 +++---
lisp/eshell/esh-mode.el | 4 +-
lisp/eshell/esh-proc.el | 2 +-
lisp/faces.el | 7 +-
lisp/files.el | 55 +-
lisp/font-lock.el | 7 +-
lisp/frame.el | 9 +-
lisp/gnus/ChangeLog.3 | 2 +-
lisp/gnus/gnus-registry.el | 2 +-
lisp/gnus/message.el | 1 -
lisp/gnus/mml.el | 13 +-
lisp/gnus/nndiary.el | 7 +
lisp/gnus/nnml.el | 13 +-
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/keymap.el | 2 +-
lisp/mail/rmailout.el | 5 +-
lisp/mail/rmailsum.el | 2 +-
lisp/mh-e/mh-search.el | 2 +-
lisp/minibuffer.el | 5 +-
lisp/net/ange-ftp.el | 5 +-
lisp/net/eww.el | 8 +-
lisp/net/gnutls.el | 5 +-
lisp/net/newst-backend.el | 20 +-
lisp/net/soap-client.el | 2 +-
lisp/net/tramp-adb.el | 19 +-
lisp/net/tramp-crypt.el | 11 +-
lisp/net/tramp-fuse.el | 10 +-
lisp/net/tramp-gvfs.el | 26 +-
lisp/net/tramp-sh.el | 15 +-
lisp/net/tramp-smb.el | 32 +-
lisp/net/tramp-sudoedit.el | 13 +-
lisp/net/tramp.el | 23 +-
lisp/org/ChangeLog.1 | 8 +-
lisp/org/ob-core.el | 10 +-
lisp/org/ob-tangle.el | 3 +-
lisp/org/oc-basic.el | 18 +-
lisp/org/org-element.el | 22 +-
lisp/org/org-faces.el | 2 +-
lisp/org/org-fold-core.el | 8 +-
lisp/org/org-persist.el | 46 +-
lisp/org/org-version.el | 2 +-
lisp/org/org.el | 5 +-
lisp/org/ox-html.el | 2 +-
lisp/outline.el | 15 +-
lisp/pcomplete.el | 27 +-
lisp/progmodes/c-ts-mode.el | 435 ++++++++++-----
lisp/progmodes/cc-engine.el | 2 +-
lisp/progmodes/csharp-mode.el | 91 +--
lisp/progmodes/eglot.el | 9 +-
lisp/progmodes/idlw-help.el | 2 +-
lisp/progmodes/java-ts-mode.el | 86 +--
lisp/progmodes/js.el | 252 ++++-----
lisp/progmodes/json-ts-mode.el | 43 +-
lisp/progmodes/prog-mode.el | 6 +-
lisp/progmodes/project.el | 4 +-
lisp/progmodes/python.el | 62 ++-
lisp/progmodes/ruby-mode.el | 30 +-
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 | 120 ++--
lisp/replace.el | 2 +-
lisp/server.el | 2 +-
lisp/shell.el | 4 +-
lisp/simple.el | 90 +--
lisp/sort.el | 2 +-
lisp/startup.el | 2 +-
lisp/subr.el | 72 ++-
lisp/tab-bar.el | 23 +-
lisp/tab-line.el | 14 +-
lisp/textmodes/bibtex.el | 28 +-
lisp/textmodes/css-mode.el | 57 +-
lisp/textmodes/reftex-vars.el | 4 +-
lisp/textmodes/toml-ts-mode.el | 52 +-
lisp/treesit.el | 574 ++++++++++++++-----
lisp/url/url-future.el | 5 +-
lisp/vc/diff-mode.el | 3 +-
lisp/vc/vc-git.el | 126 ++++-
lisp/vc/vc.el | 33 +-
lisp/whitespace.el | 43 +-
lisp/window.el | 7 +-
lisp/winner.el | 4 +-
m4/gnulib-common.m4 | 57 +-
nt/INSTALL.W64 | 88 +--
src/alloc.c | 2 +-
src/data.c | 1 +
src/dispextern.h | 4 +-
src/dispnew.c | 2 +-
src/emacs-module.h.in | 2 +-
src/emacs.c | 1 +
src/eval.c | 6 +-
src/fileio.c | 10 +-
src/frame.h | 14 +
src/haikufns.c | 2 +-
src/indent.c | 2 +
src/itree.c | 2 +-
src/json.c | 79 ++-
src/keyboard.c | 5 +-
src/lisp.h | 1 -
src/process.c | 11 +-
src/treesit.c | 247 ++++++---
src/w32menu.c | 13 +-
src/w32term.c | 11 +-
src/window.c | 3 +-
src/xdisp.c | 40 +-
src/xfaces.c | 2 +-
src/xfns.c | 1 +
src/xterm.c | 121 ++--
src/xterm.h | 10 +
test/lisp/cus-edit-tests.el | 11 +-
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-extpipe-tests.el | 2 +-
test/lisp/eshell/em-script-tests.el | 32 +-
test/lisp/eshell/em-tramp-tests.el | 92 ++--
test/lisp/eshell/esh-cmd-tests.el | 44 +-
test/lisp/eshell/esh-io-tests.el | 84 ++-
test/lisp/eshell/eshell-tests-helpers.el | 29 +-
test/lisp/eshell/eshell-tests.el | 19 +-
test/lisp/gnus/mml-sec-resources/trustlist.txt | 2 +-
test/lisp/net/tramp-tests.el | 15 +-
.../fontify-punctuation-vars.pl | 2 +-
test/lisp/progmodes/cperl-mode-tests.el | 2 +-
.../ruby-method-params-indent.rb | 18 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 4 +
test/lisp/progmodes/ruby-mode-tests.el | 24 +-
test/lisp/repeat-tests.el | 30 +-
test/lisp/url/url-future-tests.el | 2 +-
test/lisp/vc/diff-mode-tests.el | 79 +++
test/lisp/whitespace-tests.el | 78 +++
test/src/process-tests.el | 2 +-
test/src/regex-emacs-tests.el | 4 +-
test/src/treesit-tests.el | 121 ++--
223 files changed, 4569 insertions(+), 2496 deletions(-)
diff --git a/ChangeLog.3 b/ChangeLog.3
index 4b3507bae3..bff2f7a66d 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -3928,7 +3928,7 @@
* lisp/follow.el (follow-scroll-down): Do away with the optimization of
doing
vertical-motion over only one window. Instead move over all windows, to
- checck for being close to point-min, and setting point accordingly.
+ check for being close to point-min, and setting point accordingly.
2021-11-13 Eli Zaretskii <eliz@gnu.org>
@@ -50632,7 +50632,7 @@
Allow for adding constraints targeting blocks with multiple predecessors
- This commit remove the limitaiton we had not being able to add
+ This commit remove the limitation we had not being able to add
constraints derived from conditional branches to basic blocks with
multiple predecessors. When this condition is verified we add a new
dedicated basic block to hold the constraints.
@@ -75446,7 +75446,7 @@
According to RFC 3986 it should be percent-encoded and thus should not
contain spaces. However, there are HTTP server implementation (notably
nginx) that do not do that. This makes Emacs url-http.el behave like
- most other HTTP client implementatios. Also remove the stripping of
+ most other HTTP client implementations. Also remove the stripping of
angle bracket quotes as they are not valid according to the RFCs.
2020-07-19 Satoshi Nakagawa <ghnacker@gmail.com> (tiny change)
@@ -87619,7 +87619,7 @@
itself and reevaluates it in each stop to yield an address.
We also add a warning (a red bold exclamation mark) on the header line
when the content of the page doesn't represent the memory location
- user requested for. That happends when some error occurs in
+ user requested for. That happens when some error occurs in
evaluating the address, and we display the last successfully displayed
memory page.
* lisp/progmodes/gdb-mi.el (gdb-memory-address-expression)
@@ -105227,7 +105227,7 @@
Sometimes, when finding files with icomplete-mode, backward-deleting
the previous word or sexp (to move up a directory) doesn't actually
refresh the file list of the new directory. Forcing redisplay in
- icomplete-exhibit misteriously fixes the problem.
+ icomplete-exhibit mysteriously fixes the problem.
* lisp/icomplete.el (icomplete-exhibit): Add call to redisplay.
@@ -129725,7 +129725,7 @@
* lisp/delim-col.el: Use lexical-binding.
* test/lisp/delim-col-tests.el: New file.
- (delim-col-tests-delimit-colummns-before-after)
+ (delim-col-tests-delimit-columns-before-after)
(delim-col-tests-delimit-columns)
(delim-col-tests-delimit-columns-format/nil)
(delim-col-tests-delimit-columns-format/padding)
@@ -154614,7 +154614,7 @@
Fixes: Bug#31951
* lisp/server.el (server-save-buffers-kill-terminal): Only pass
- PRED=t to save-some-bufers if ARG in non-nil.
+ PRED=t to save-some-buffers if ARG in non-nil.
2018-06-27 Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -221589,7 +221589,7 @@
(ses-define-if-new-local-printer): New defsubst.
(ses-center, ses-center-span, ses-dashfill)
(ses-dashfill-span, ses-tildefill-span): Allow to pass printer
- as an optional argument to superseed column printer/default
+ as an optional argument to supersede column printer/default
spreadsheet printer.
(ses-prin1): New defun.
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/git-bisect-start b/admin/git-bisect-start
index 945d4901c1..227ea0ba05 100755
--- a/admin/git-bisect-start
+++ b/admin/git-bisect-start
@@ -66,7 +66,7 @@ $REAL_GIT bisect start "$@"
## already on master. In other words, it is the parent of the merge
## commit for which 'git rev-list --max-parents=0 <commit>' does not
## include ce5584125c44a1a2fbb46e810459c50b227a95e2 (which is the root
-## commit of the Emacs respository).
+## commit of the Emacs repository).
for C in $(cat $0 | grep '^# SKIP-BRANCH ' | sed 's/^# SKIP-BRANCH //')
do
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 5bd6645a25..d0217bdcf4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2695,39 +2695,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],
@@ -3222,6 +3189,7 @@ AC_SUBST([JSON_OBJ])
HAVE_TREE_SITTER=no
TREE_SITTER_OBJ=
+NEED_DYNLIB=no
if test "${with_tree_sitter}" != "no"; then
dnl Tree-sitter 0.20.2 added support to change the malloc it uses
@@ -3247,6 +3215,7 @@ if test "${with_tree_sitter}" != "no"; then
LIBS=$OLD_LIBS
if test "$ac_cv_func_ts_set_allocator" = yes; then
AC_DEFINE(HAVE_TREE_SITTER, 1, [Define if using tree-sitter.])
+ NEED_DYNLIB=yes
else
AC_MSG_ERROR([Tree-sitter library exists but its version is too old]);
TREE_SITTER_CFLAGS=
@@ -4145,7 +4114,6 @@ AC_SUBST(DYNAMIC_LIB_SECONDARY_SUFFIX)
LIBMODULES=
HAVE_MODULES=no
MODULES_OBJ=
-NEED_DYNLIB=no
MODULES_SUFFIX="${DYNAMIC_LIB_SUFFIX}"
MODULES_SECONDARY_SUFFIX="${DYNAMIC_LIB_SECONDARY_SUFFIX}"
@@ -5241,6 +5209,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/custom.texi b/doc/emacs/custom.texi
index aaf41d2aef..f75512a00e 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1990,13 +1990,17 @@ to assign meanings to key bindings that use these
modifiers. The
modifier bits are labeled as @samp{s-}, @samp{H-} and @samp{A-}
respectively.
+@cindex modifier keys unsupported by keyboard
Even if your keyboard lacks these additional modifier keys, you can
-enter it using @kbd{C-x @@}: @kbd{C-x @@ h} adds the Hyper flag to
+enter them using @kbd{C-x @@}: @kbd{C-x @@ h} adds the Hyper flag to
the next character, @kbd{C-x @@ s} adds the Super flag, and
@kbd{C-x @@ a} adds the Alt flag. For instance, @kbd{C-x @@ h
C-a} is a way to enter @kbd{Hyper-Control-a}. (Unfortunately, there
is no way to add two modifiers by using @kbd{C-x @@} twice for the
same character, because the first one goes to work on the @kbd{C-x}.)
+You can similarly enter the Shift, Control, and Meta modifiers by
+using @kbd{C-x @ S}, @kbd{C-x @ c}, and @kbd{C-x @ m}, respectively,
+although this is rarely needed.
@node Function Keys
@subsection Rebinding Function Keys
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/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 9ebb044652..cd3244a912 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -3166,7 +3166,7 @@ Most projects with a certain amount of users track bug
reports in some
issue tracking software which assigns each report a unique and short
number or identifier. Those are used to reference a given bug, e.g.,
in a source code comment above the code fixing some bug, in
-documentation files, or in discussions on some mailinglist or IRC
+documentation files, or in discussions on some mailing list or IRC
channel.
@findex bug-reference-mode
diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1
index 82840aed1d..361e816bc3 100644
--- a/doc/lispref/ChangeLog.1
+++ b/doc/lispref/ChangeLog.1
@@ -5150,7 +5150,7 @@
* backups.texi (Making Backups):
* modes.texi (Example Major Modes): Use recommended coding style.
- (Major Mode Basics, Derived Modes): Encourge more strongly use of
+ (Major Mode Basics, Derived Modes): Encourage more strongly use of
define-derived-mode. Mention completion-at-point-functions.
2010-12-13 Chong Yidong <cyd@stupidchicken.com>
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 3e39734999..ae4905bb1f 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -930,7 +930,7 @@ used by Emacs to natively-compile any Lisp file or
byte-compiled Lisp
file that is loaded into Emacs, when no natively-compiled file for it
is available. Note that because of this use of a subprocess, native
compilation may produce warning and errors which byte-compilation does
-not, and lisp code may thus need to be modified to work correctly. See
+not, and Lisp code may thus need to be modified to work correctly. See
@code{native-comp-async-report-warnings-errors} in @pxref{Native-Compilation
Variables} for more details.
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 4111a86aa7..5397489e44 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,23 @@ 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
-@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.
+for newly created frames.
+
+To @emph{unset} the value of an attribute, that is, to indicate that
+the face doesn't by itself specify a value for the attribute, the
+special value @code{unspecified} (@emph{not} @code{nil}!@:) must be
+used.
+
+Note that the attribute-value pairs are evaluated in the order they
+are specified, except the @code{:family} and @code{:foundry}
+attributes, which are evaluated first. This means both that only the
+last value of a given attribute will be used, and that in some cases a
+different order will give 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
@@ -6280,7 +6300,7 @@ embedding large images, comparing to @code{svg-embed},
because all the
work is done directly by librsvg.
@lisp
-;; Embeding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg
+;; Embedding /tmp/subdir/rms.jpg and /tmp/another/rms.jpg
(svg-embed-base-uri-image svg "subdir/rms.jpg"
:width "100px" :height "100px"
:x "50px" :y "75px")
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/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..de17969566 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
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index adb4c5e6e0..86b3bd54e7 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -393,12 +393,6 @@ 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
@@ -511,7 +505,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 +572,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 +606,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 +625,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 +645,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
@@ -1266,10 +1268,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 +1285,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.
@@ -1716,15 +1724,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 +1753,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
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/lispref/tips.texi b/doc/lispref/tips.texi
index 3a1f6de12b..3216a35395 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -804,7 +804,7 @@ Finally, to create a hyperlink to URLs, write the
single-quoted URL,
preceded by @samp{URL}. For example,
@smallexample
-The GNU project wesite has more information (see URL
+The GNU project website has more information (see URL
`https://www.gnu.org/').
@end smallexample
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index 1c5e7c1e2f..cd3f599b93 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -6012,7 +6012,7 @@
(Built-in table editor): Document M-e and M-a navigate
inside table field.
(Stuck projects): Docment that projects identified as
- un-stuck will still be searchd for stuck sub-projects.
+ un-stuck will still be searched for stuck sub-projects.
(Paragraphs): Document centering.
(Creating timestamps, Agenda commands): Document new
behavior when changing time stamps.
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 89a340e734..e5bac25cac 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -11040,7 +11040,8 @@ the year even for older dates. The customizable
variable
have Calc's date forms switch from the Julian to Gregorian calendar at
any specified date.
-Today's timekeepers introduce an occasional ``leap second''.
+A few platforms support leap seconds, such as the time stamp
+1972-06-30 23:59:60 UTC, an extra second appended to June 1972.
These do not occur regularly and Calc does not take these minor
effects into account. (If it did, it would have to report a
non-integer number of days between, say,
@@ -17340,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.
@@ -17363,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/cc-mode.texi b/doc/misc/cc-mode.texi
index a8f5248c4c..eee8463a0f 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -7149,7 +7149,7 @@ If you add more directives to this variable, or remove
directives from
it, whilst ``indent to body'' is active, you need to re-enable the
feature by calling @code{c-toggle-cpp-indent-to-body} for these
changes to take effect@footnote{Note that the removal of directives
-doesn't work satisfactorally on XEmacs or on very old versions of
+doesn't work satisfactorily on XEmacs or on very old versions of
Emacs}.
@end defopt
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/eshell.texi b/doc/misc/eshell.texi
index f9796d69a9..118ee80acb 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -2162,11 +2162,6 @@ So that @kbd{M-@key{DEL}} acts in a predictable manner,
etc.
@item Allow all Eshell buffers to share the same history and list-dir
-@item There is a problem with script commands that output to @file{/dev/null}
-
-If a script file, somewhere in the middle, uses @samp{> /dev/null},
-output from all subsequent commands is swallowed.
-
@item Split up parsing of text after @samp{$} in @file{esh-var.el}
Make it similar to the way that @file{esh-arg.el} is structured.
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 01c75f8da7..382e7cb7b6 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 017fd850b4..d2e11e5adf 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:
@@ -265,6 +269,16 @@ controlled by the internal Emacs machinery led to
low-contrast faces
in common default setups. Emacs now uses the same 'region' face on
Gtk and non-Gtk setups.
+---
+** 'C-h f' and 'C-h x' may now require confirmation when you press 'RET'.
+If the text in the minibuffer cannot be completed to a single function
+or command, typing 'RET' will not automatically complete to the shortest
+candidate, but will instead ask for confirmation. Typing 'TAB' will
+complete as much as possible, and another 'TAB' will show all the
+possible completions. This allows you to insist on the functions name
+even if Help doesn't appear to know about it, by confirming with a
+second 'RET'.
+
** Dired
---
@@ -281,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.
@@ -314,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.
@@ -345,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.
@@ -442,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.
@@ -496,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.
@@ -511,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.
@@ -556,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
@@ -584,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)
@@ -606,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.
@@ -652,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
@@ -677,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.
@@ -699,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.
@@ -736,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
@@ -874,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
@@ -885,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.
@@ -926,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.
+++
@@ -936,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.
@@ -982,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.
@@ -1017,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'.
@@ -1055,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
@@ -1065,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
@@ -1078,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
@@ -1089,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.
@@ -1108,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
@@ -1135,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'.
@@ -1201,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
@@ -1213,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
@@ -1232,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.
@@ -1257,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'.
@@ -1269,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.
@@ -1291,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
@@ -1308,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'.
@@ -1329,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".
@@ -1413,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
@@ -1496,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
---
@@ -1512,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
@@ -1543,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
@@ -1556,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'.
@@ -1578,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'.
@@ -1626,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'.
@@ -1663,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
@@ -1722,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
@@ -1738,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
@@ -1775,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
@@ -1798,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
@@ -1820,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.
@@ -1934,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.
@@ -1973,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'.
@@ -2182,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.
@@ -2300,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
+++
@@ -2484,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).
@@ -2572,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
---
@@ -2761,6 +2831,9 @@ project-dedicated or global) is specified by the new
---
*** Support for endless methods.
+---
+*** New user option 'ruby-method-params-indent'.
+
** Eshell
+++
@@ -2817,7 +2890,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
@@ -2931,11 +3004,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".
@@ -2987,6 +3055,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
@@ -2999,7 +3080,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.
@@ -3024,8 +3105,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'.
@@ -3048,10 +3129,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,
@@ -3082,77 +3165,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.
@@ -3174,15 +3274,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
@@ -3206,7 +3308,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
@@ -3231,7 +3333,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.
@@ -3271,7 +3373,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'.
@@ -3294,10 +3396,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.
@@ -3492,9 +3594,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.
@@ -3502,7 +3603,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'.
@@ -3654,7 +3755,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'.
@@ -3666,10 +3767,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.
@@ -3689,6 +3790,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
@@ -3825,7 +3927,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.
@@ -3837,8 +3939,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'.
@@ -3857,8 +3959,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'.
@@ -3878,7 +3980,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.
@@ -3927,7 +4029,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.
@@ -4024,8 +4129,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'.
@@ -4344,7 +4449,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.
@@ -4435,9 +4541,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.
@@ -4594,6 +4701,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/ORG-NEWS b/etc/ORG-NEWS
index 67889c0b10..6c50469d4d 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -733,7 +733,7 @@ following snippet to allow multiple different ID formats in
Org files.
(and (or (org-uuidgen-p id)
(string-match-p "[0-9a-z]\\{12\\}" id))
(org-attach-id-uuid-folder-format id)))
- ;; When ID looks like a timestap-based ID. Group by year-month
+ ;; When ID looks like a timestamp-based ID. Group by year-month
;; folders.
(lambda (id)
(and (string-match-p "[0-9]\\{8\\}T[0-9]\\{6\\}\.[0-9]\\{6\\}" id)
@@ -5431,9 +5431,9 @@ doing computation.
There are now three lookup functions:
-- [[doc:org-loopup-first][org-loopup-first]]
-- [[doc:org-loopup-last][org-loopup-last]]
-- [[doc:org-loopup-all][org-loopup-all]]
+- [[doc:org-lookup-first][org-lookup-first]]
+- [[doc:org-lookup-last][org-lookup-last]]
+- [[doc:org-lookup-all][org-lookup-all]]
See [[https://orgmode.org/org.html#Lookup-functions][the manual]] for details.
*** Startup keywords
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index f114049985..1e45887b86 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -3193,7 +3193,7 @@ something like the following in your init file:
** Native Compilation on macOS
-Native complitation requires the libgccjit library to be installed and
+Native compilation requires the libgccjit library to be installed and
its path available to Emacs. Errors such as:
libgccjit.so: error: error invoking gcc driver
@@ -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.cn b/etc/tutorials/TUTORIAL.cn
index 770d9a83be..cb430d3fdb 100644
--- a/etc/tutorials/TUTORIAL.cn
+++ b/etc/tutorials/TUTORIAL.cn
@@ -299,7 +299,7 @@ Emacs 可以有多个“窗格”，每个窗格显示不同的文字。后面
>> 试试 C-u 8 *，这将会插入 ********。
-好，现在你应该已经掌握了最基本的的文本插入和修改功能，其实删除还可以
+好，现在你应该已经掌握了最基本的文本插入和修改功能，其实删除还可以
“以词为单位”进行，下面是一个关于“删除”操作的小结：
<DEL> 删除光标前的一个字符
@@ -316,7 +316,7 @@ Emacs 可以有多个“窗格”，每个窗格显示不同的文字。后面
注意“<DEL> 和 C-d”还有“M-<DEL> 和 M-d”是根据前述惯例从 C-f和 M-f 衍生
出来的（其实<DEL>不是控制字符，我们先忽略这一点）。C-k和 M-k 的关系在
-某种程度上与 C-e 和 M-e 一样――如果把“一行”和“一句”作一个类比的话。
+某种程度上与 C-e 和 M-e 一样――如果把“一行”和“一句”做一个类比的话。
你也可以用一种通用的办法来移除缓冲区里的任何一部分：首先把光标移动到你
想要移除的区域的一端，然后按 C-<SPC>（<SPC>指空格）【注意，C-<SPC> 往
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/ChangeLog.14 b/lisp/ChangeLog.14
index eae47fe198..1ce11c11ad 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -6299,7 +6299,7 @@
2008-10-22 Vinicius Jose Latorre <viniciusjl@ig.com.br>
- * ps-print.el: Deal with page sizes for label printes. Suggested by
+ * ps-print.el: Deal with page sizes for label printers. Suggested by
Friedrich Delgado Friedrichs <friedel@nomaden.org>.
(ps-print-version): New version 7.3.3.
(ps-page-dimensions-database): New page sizes for label printers.
@@ -6371,7 +6371,7 @@
* replace.el (query-replace, query-replace-regexp)
(replace-string, replace-regexp, perform-replace): Add "word"
- indicatiors to the prompt for word delimited replacements.
+ indicators to the prompt for word delimited replacements.
* replace.el (read-regexp): Rename arg `default' to `default-value'.
Doc fix.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 91b8d47422..83143f7336 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -14679,7 +14679,7 @@
* simple.el (current-word): Ignore text properties.
* edebug.el (edebug-sit-for-seconds): New variable.
- (edebug-display): Use that variable to control amt of time.
+ (edebug-display): Use that variable to control amount of time.
1997-06-22 Morten Welinder <terra@diku.dk>
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/bindings.el b/lisp/bindings.el
index a3f51ebb31..f2e0799f72 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1012,8 +1012,8 @@ if `inhibit-field-text-motion' is non-nil."
;; (define-key ctl-x-map "U" 'undo-only)
(defvar-keymap undo-repeat-map
:doc "Keymap to repeat undo key sequences \\`C-x u u'. Used in
`repeat-mode'."
+ :repeat t
"u" #'undo)
-(put 'undo 'repeat-map 'undo-repeat-map)
(define-key global-map '[(control ??)] 'undo-redo)
(define-key global-map [?\C-\M-_] 'undo-redo)
@@ -1033,12 +1033,10 @@ if `inhibit-field-text-motion' is non-nil."
(defvar-keymap buffer-navigation-repeat-map
:doc "Keymap to repeat `next-buffer' and `previous-buffer'. Used in
`repeat-mode'."
+ :repeat t
"<right>" #'next-buffer
"<left>" #'previous-buffer)
-(put 'next-buffer 'repeat-map 'buffer-navigation-repeat-map)
-(put 'previous-buffer 'repeat-map 'buffer-navigation-repeat-map)
-
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
@@ -1111,12 +1109,11 @@ if `inhibit-field-text-motion' is non-nil."
(defvar-keymap next-error-repeat-map
:doc "Keymap to repeat `next-error' key sequences. Used in `repeat-mode'."
+ :repeat t
"n" #'next-error
"M-n" #'next-error
"p" #'previous-error
"M-p" #'previous-error)
-(put 'next-error 'repeat-map 'next-error-repeat-map)
-(put 'previous-error 'repeat-map 'next-error-repeat-map)
(defvar-keymap goto-map
:doc "Keymap for navigation commands."
@@ -1474,12 +1471,10 @@ if `inhibit-field-text-motion' is non-nil."
(defvar-keymap page-navigation-repeat-map
:doc "Keymap to repeat page navigation key sequences. Used in
`repeat-mode'."
+ :repeat t
"]" #'forward-page
"[" #'backward-page)
-(put 'forward-page 'repeat-map 'page-navigation-repeat-map)
-(put 'backward-page 'repeat-map 'page-navigation-repeat-map)
-
(define-key ctl-x-map "\C-p" 'mark-page)
(define-key ctl-x-map "l" 'count-lines-page)
(define-key ctl-x-map "np" 'narrow-to-page)
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/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index 78275f4db3..a3a1034e08 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -1446,7 +1446,7 @@
modes, and merge the tables together in :tables from :modetables.
(srecode-make-mode-table): Init :modetables.
(srecode-mode-table-find): Search in modetables.
- (srecode-mode-table-new): Merge the differet files into the
+ (srecode-mode-table-new): Merge the different files into the
modetables slot.
2012-10-01 David Engster <deng@randomsample.de>
diff --git a/lisp/cedet/semantic/decorate/include.el
b/lisp/cedet/semantic/decorate/include.el
index fe510c371e..26785298e6 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -790,9 +790,7 @@ any decorated referring includes.")
;; This is a hack. Add in something better?
(semanticdb-notify-references
table (lambda (tab _me)
- (semantic-decoration-unparsed-include-refrence-reset tab)
- ))
- ))
+ (semantic-decoration-unparsed-include-reference-reset tab)))))
(cl-defmethod semanticdb-partial-synchronize ((cache
semantic-decoration-unparsed-include-cache)
new-tags)
@@ -805,7 +803,7 @@ any decorated referring includes.")
"Synchronize a CACHE with some NEW-TAGS."
(semantic-reset cache))
-(defun semantic-decoration-unparsed-include-refrence-reset (table)
+(defun semantic-decoration-unparsed-include-reference-reset (table)
"Refresh any highlighting in buffers referred to by TABLE.
If TABLE is not in a buffer, do nothing."
;; This cache removal may seem odd in that we are "creating one", but
@@ -835,6 +833,8 @@ If TABLE is not in a buffer, do nothing."
(semantic-decorate-add-decorations allinc)
))))
+(define-obsolete-function-alias
'semantic-decoration-unparsed-include-refrence-reset
+ #'semantic-decoration-unparsed-include-reference-reset "30.1")
(provide 'semantic/decorate/include)
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/comint.el b/lisp/comint.el
index 7ba423e65d..77d213574f 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -606,12 +606,10 @@ via PTYs.")
(defvar-keymap comint-repeat-map
:doc "Keymap to repeat comint key sequences. Used in `repeat-mode'."
+ :repeat t
"C-n" #'comint-next-prompt
"C-p" #'comint-previous-prompt)
-(put #'comint-next-prompt 'repeat-map 'comint-repeat-map)
-(put #'comint-previous-prompt 'repeat-map 'comint-repeat-map)
-
;; Fixme: Is this still relevant?
(defvar comint-ptyp t
"Non-nil if communications via pty; false if by pipe. Buffer local.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 8af4618dbd..65eb066a55 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -903,9 +903,9 @@ This also shows the saved values in the buffer."
(defun custom-reset-standard-save-and-update ()
"Save settings and redraw after erasing customizations."
(when (or (and custom-reset-standard-variables-list
- (not (eq custom-reset-standard-variables-list '(t))))
+ (not (equal custom-reset-standard-variables-list '(t))))
(and custom-reset-standard-faces-list
- (not (eq custom-reset-standard-faces-list '(t)))))
+ (not (equal custom-reset-standard-faces-list '(t)))))
;; Save settings to file.
(custom-save-all)
;; Set state of and redraw variables.
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/dired.el b/lisp/dired.el
index 81e62f88cf..f5d1b90abf 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -4882,9 +4882,9 @@ Interactively with prefix argument, read FILE-NAME."
(defvar-keymap dired-jump-map
:doc "Keymap to repeat `dired-jump'. Used in `repeat-mode'."
+ :repeat t
"j" #'dired-jump
"C-j" #'dired-jump)
-(put 'dired-jump 'repeat-map 'dired-jump-map)
;;; Miscellaneous commands
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..d909395e97 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -649,8 +649,8 @@ 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'
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 6067800759..b5e121f0cd 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.")
@@ -4836,6 +4842,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))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 2c306d892c..7fec370d47 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3716,7 +3716,7 @@ Prepare every function for final compilation and drive
the C back-end."
(if (zerop
(call-process (expand-file-name invocation-name
invocation-directory)
- nil t t "-no-comp-spawn" "--batch" "-l"
+ nil t t "-no-comp-spawn" "-Q" "--batch" "-l"
temp-file))
(progn
(delete-file temp-file)
@@ -4005,7 +4005,7 @@ display a message."
:command (list
(expand-file-name invocation-name
invocation-directory)
- "-no-comp-spawn" "--batch"
+ "-no-comp-spawn" "-Q" "--batch"
"--eval"
;; Suppress Abort dialogs on MS-Windows
"(setq w32-disable-abort-dialog t)"
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 e1902ca8e3..6d089c27b7 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 77625398ab..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)))
@@ -391,11 +391,11 @@ If START or END is negative, it counts from the end."
(cond ((fboundp 'browse-url-irc)) ; 29
((boundp 'browse-url-default-handlers) ; 28
- (setf (alist-get "\\`irc6?s?://" browse-url-default-handlers
- nil nil (lambda (a _)
- (and (stringp a)
- (string-match-p a "irc://localhost"))))
- #'erc-compat--29-browse-url-irc))
+ (add-to-list 'browse-url-default-handlers
+ '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ nil (lambda (_ a)
+ (and (stringp (car-safe a))
+ (string-match-p (car a) "irc://localhost")))))
((boundp 'browse-url-browser-function) ; 27
(require 'browse-url)
(let ((existing browse-url-browser-function))
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 6cfc39c4bd..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)
@@ -1765,8 +1766,7 @@ all channel buffers on all servers."
;; to, it was never realized.
;;
;; New library code should use the `erc--target' struct instead.
-;; Third-party code can continue to use this until a getter for
-;; `erc--target' (or whatever replaces it) is exported.
+;; Third-party code can continue to use this and `erc-default-target'.
(defvar-local erc-default-recipients nil
"List of default recipients of the current buffer.")
@@ -6012,13 +6012,14 @@ See also `erc-downcase'."
;; While `erc-default-target' happens to return nil in channel buffers
;; you've parted or from which you've been kicked, using it to detect
;; whether a channel is currently joined may become unreliable in the
-;; future. For now, new code should consider using
+;; future. For now, third-party code can use
;;
;; (erc-get-channel-user (erc-current-nick))
;;
-;; and expect a nicer option eventually. For retrieving a target
-;; regardless of subscription or connection status, use replacements
-;; based on `erc--target' instead. See also `erc--default-target'.
+;; A predicate may be provided eventually. For retrieving a target's
+;; name regardless of subscription or connection status, new library
+;; code should use `erc--default-target'. Third-party code should
+;; continue to use `erc-default-target'.
(defun erc-default-target ()
"Return the current default target (as a character string) or nil if none."
@@ -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-elecslash.el b/lisp/eshell/em-elecslash.el
index 091acb9a86..0ce3a4cc96 100644
--- a/lisp/eshell/em-elecslash.el
+++ b/lisp/eshell/em-elecslash.el
@@ -74,8 +74,9 @@ insertion."
(command (save-excursion
(eshell-bol)
(skip-syntax-forward " ")
- (thing-at-point 'sexp))))
- (if (and (file-remote-p default-directory)
+ (thing-at-point 'sexp)))
+ (prefix (file-remote-p default-directory)))
+ (if (and prefix
;; We can't formally parse the input. But if there is
;; one of these operators behind us, then looking at
;; the first command would not be sensible. So be
@@ -93,14 +94,9 @@ insertion."
(or eshell-prefer-lisp-functions
(not (eshell-search-path command))))))))
(let ((map (make-sparse-keymap))
- (start (if tilde-before (1- (point)) (point)))
- (localname
- (tramp-file-name-localname
- (tramp-dissect-file-name default-directory))))
+ (start (if tilde-before (1- (point)) (point))))
(when tilde-before (delete-char -1))
- (insert
- (substring default-directory 0
- (string-search localname default-directory)))
+ (insert prefix)
(unless tilde-before (insert "/"))
;; Typing a second slash undoes the insertion, for when
;; you really do want to type a local absolute file name.
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index a8744de1db..abb123bcff 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -102,12 +102,10 @@ arriving, or after."
(defvar-keymap eshell-prompt-repeat-map
:doc "Keymap to repeat eshell-prompt key sequences. Used in `repeat-mode'."
+ :repeat t
"C-n" #'eshell-next-prompt
"C-p" #'eshell-previous-prompt)
-(put #'eshell-next-prompt 'repeat-map 'eshell-prompt-repeat-map)
-(put #'eshell-previous-prompt 'repeat-map 'eshell-prompt-repeat-map)
-
;;; Functions:
(define-minor-mode eshell-prompt-mode
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 1fb8499112..39579335cf 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -418,8 +418,11 @@ hooks should be run before and after the command."
(eshell-separate-commands terms "[&;]" nil 'eshell--sep-terms))))
(let ((cmd commands))
(while cmd
- (if (cdr cmd)
- (setcar cmd `(eshell-commands ,(car cmd))))
+ ;; Copy I/O handles so each full statement can manipulate them
+ ;; 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
@@ -788,16 +791,17 @@ 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-copy-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-create-handles
- (car (aref eshell-current-handles
- eshell-output-handle)) nil
- (car (aref eshell-current-handles
- eshell-error-handle)) nil)))
+ (eshell-duplicate-handles eshell-current-handles ,steal-p)))
,object))
+(define-obsolete-function-alias 'eshell-copy-handles
+ #'eshell-with-copied-handles "30.1")
+
(defmacro eshell-protect (object)
"Protect I/O handles, so they aren't get closed after eval'ing OBJECT."
`(progn
@@ -808,7 +812,7 @@ this grossness will be made to disappear by using
`call/cc'..."
"Execute the commands in PIPELINE, connecting each to one another.
This macro calls itself recursively, with NOTFIRST non-nil."
(when (setq pipeline (cadr pipeline))
- `(eshell-copy-handles
+ `(eshell-with-copied-handles
(progn
,(when (cdr pipeline)
`(let ((nextproc
@@ -833,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.
@@ -880,11 +886,8 @@ This is used on systems where async subprocesses are not
supported."
(progn
,(if (fboundp 'make-process)
`(eshell-do-pipelines ,pipeline)
- `(let ((tail-handles (eshell-create-handles
- (car (aref eshell-current-handles
- ,eshell-output-handle)) nil
- (car (aref eshell-current-handles
- ,eshell-error-handle)) nil)))
+ `(let ((tail-handles (eshell-duplicate-handles
+ eshell-current-handles)))
(eshell-do-pipelines-synchronously ,pipeline)))
(eshell-process-identity (cons (symbol-value headproc)
(symbol-value tailproc))))))
@@ -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 4620565f85..90826a312b 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -116,16 +116,22 @@ from executing while Emacs is redisplaying."
:group 'eshell-io)
(defcustom eshell-virtual-targets
- '(("/dev/eshell" eshell-interactive-print nil)
+ '(;; The literal string "/dev/null" is intentional here. It just
+ ;; provides compatibility so that users can redirect to
+ ;; "/dev/null" no matter the actual value of `null-device'.
+ ("/dev/null" (lambda (_mode) (throw 'eshell-null-device t)) t)
+ ("/dev/eshell" eshell-interactive-print nil)
("/dev/kill" (lambda (mode)
- (if (eq mode 'overwrite)
- (kill-new ""))
- 'eshell-kill-append) t)
+ (when (eq mode 'overwrite)
+ (kill-new ""))
+ #'eshell-kill-append)
+ t)
("/dev/clip" (lambda (mode)
- (if (eq mode 'overwrite)
- (let ((select-enable-clipboard t))
- (kill-new "")))
- 'eshell-clipboard-append) t))
+ (when (eq mode 'overwrite)
+ (let ((select-enable-clipboard t))
+ (kill-new "")))
+ #'eshell-clipboard-append)
+ t))
"Map virtual devices name to Emacs Lisp functions.
If the user specifies any of the filenames above as a redirection
target, the function in the second element will be called.
@@ -138,10 +144,8 @@ function.
The output function is then called repeatedly with single strings,
which represents successive pieces of the output of the command, until nil
-is passed, meaning EOF.
-
-NOTE: /dev/null is handled specially as a virtual target, and should
-not be added to this variable."
+is passed, meaning EOF."
+ :version "30.1"
:type '(repeat
(list (string :tag "Target")
function
@@ -291,25 +295,58 @@ describing the mode, e.g. for using with
`eshell-get-target'.")
(defun eshell-create-handles
(stdout output-mode &optional stderr error-mode)
"Create a new set of file handles for a command.
-The default location for standard output and standard error will go to
-STDOUT and STDERR, respectively.
-OUTPUT-MODE and ERROR-MODE are either `overwrite', `append' or `insert';
-a nil value of mode defaults to `insert'."
+The default target for standard output and standard error will
+go to STDOUT and STDERR, respectively. OUTPUT-MODE and
+ERROR-MODE are either `overwrite', `append' or `insert'; a nil
+value of mode defaults to `insert'.
+
+The result is a vector of file handles. Each handle is of the form:
+
+ ((TARGETS . REF-COUNT) DEFAULT)
+
+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-target stdout output-mode))
- (error-target (if stderr
- (eshell-get-target stderr error-mode)
- output-target)))
- (aset handles eshell-output-handle (cons output-target 1))
- (aset handles eshell-error-handle (cons error-target 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 &optional steal-p)
+ "Create a duplicate of the file handles in HANDLES.
+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 (aref handles idx)
- (setcdr (aref handles idx)
- (1+ (cdr (aref handles idx))))))
+ (when-let ((handle (aref handles idx)))
+ (cl-incf (cdar handle))))
handles)
(defun eshell-close-handles (&optional exit-code result handles)
@@ -327,42 +364,56 @@ 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)))
- (setcdr handle (1- (cdr handle)))
- (when (= (cdr 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)))
- (if (and (stringp target)
- (string= target (null-device)))
- (aset handles index nil)
- (let ((where (eshell-get-target target mode))
- (current (car (aref handles index))))
- (if (listp current)
- (unless (member where current)
- (setq current (append current (list where))))
- (setq current (list where)))
- (if (not (aref handles index))
- (aset handles index (cons nil 1)))
- (setcar (aref handles index) current))))))
+ (let* ((handles (or handles eshell-current-handles))
+ (handle (or (aref handles index)
+ (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 ((current (caar handle))
+ (where (eshell-get-target target mode)))
+ (unless (member where current)
+ (setcar (car handle) (append current (list where))))))
+ (setcar (cdr handle) nil))))
(defun eshell-copy-output-handle (index index-to-copy &optional handles)
"Copy the handle INDEX-TO-COPY to INDEX for the 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.
@@ -493,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 (eq (car (aref handles eshell-output-handle)) t)
- (eq (car (aref handles eshell-error-handle)) t))
- (eq (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)
@@ -602,15 +653,10 @@ 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 ((target (car (aref (or handles eshell-current-handles)
- (or handle-index eshell-output-handle)))))
- (if (listp target)
- (while target
- (eshell-output-object-to-target object (car target))
- (setq target (cdr target)))
- (eshell-output-object-to-target object target)
- ;; Explicitly return nil to match the list case above.
- nil)))
+ (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))))
(provide 'esh-io)
;;; esh-io.el ends here
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 4357a0e29a..b3db0f6af4 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -282,12 +282,10 @@ This is used by `eshell-watch-for-password-prompt'."
(defvar-keymap eshell-command-repeat-map
:doc "Keymap to repeat eshell-command key sequences. Used in `repeat-mode'."
+ :repeat t
"C-f" #'eshell-forward-argument
"C-b" #'eshell-backward-argument)
-(put #'eshell-forward-argument 'repeat-map 'eshell-command-repeat-map)
-(put #'eshell-backward-argument 'repeat-map 'eshell-command-repeat-map)
-
;;; User Functions:
(defun eshell-kill-buffer-function ()
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..fe683e437f 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 the `:family' and `:foundry'
+attributes which 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 bf9a179d6a..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")
@@ -2361,6 +2363,7 @@ in which C preprocessor directives are used, e.g.
`asm-mode' and
(define-obsolete-function-alias 'font-lock-after-fontify-buffer #'ignore
"29.1")
(define-obsolete-function-alias 'font-lock-after-unfontify-buffer #'ignore
"29.1")
+(define-obsolete-function-alias 'font-lock-fontify-syntactically-region
#'font-lock-default-fontify-syntactically "29.1")
(provide 'font-lock)
diff --git a/lisp/frame.el b/lisp/frame.el
index 400f8a44ee..e4cd2cd8ae 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -1188,7 +1188,7 @@ e.g. (mapc \\='frame-set-background-mode (frame-list))."
(defvar inhibit-frame-set-background-mode nil)
-(defun frame--current-backround-mode (frame)
+(defun frame--current-background-mode (frame)
(let* ((frame-default-bg-mode (frame-terminal-default-bg-mode frame))
(bg-color (frame-parameter frame 'background-color))
(tty-type (tty-type frame))
@@ -1218,7 +1218,7 @@ If optional arg KEEP-FACE-SPECS is non-nil, don't
recalculate
face specs for the new background mode."
(unless inhibit-frame-set-background-mode
(let* ((bg-mode
- (frame--current-backround-mode frame))
+ (frame--current-background-mode frame))
(display-type
(cond ((null (window-system frame))
(if (tty-display-color-p frame) 'color 'mono))
@@ -1297,7 +1297,7 @@ the `background-mode' terminal parameter."
;; :global t
;; :group 'faces
;; (when (eq dark-mode
-;; (eq 'light (frame--current-backround-mode (selected-frame))))
+;; (eq 'light (frame--current-background-mode (selected-frame))))
;; ;; FIXME: Change the face's SPEC instead?
;; (set-face-attribute 'default nil
;; :foreground (face-attribute 'default :background)
@@ -3105,6 +3105,9 @@ If FRAME isn't maximized, show the title bar."
frame 'undecorated
(eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized)))
+(define-obsolete-function-alias 'frame--current-backround-mode
+ #'frame--current-background-mode "30.1")
+
(provide 'frame)
;;; frame.el ends here
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index 8c1073dc8d..bf64780799 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -11763,7 +11763,7 @@
2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-dribble-read-file): Ensure that the directory
- where the dribbel file lives exists.
+ where the dribble file lives exists.
* message.el (message-send-mail-partially-limit): Change the default to
nil, since most people don't want this.
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/message.el b/lisp/gnus/message.el
index e7d11b597b..6c10a4ae97 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -3191,7 +3191,6 @@ Like `text-mode', but with these additional commands:
(mail-abbrevs-setup))
((message-mail-alias-type-p 'ecomplete)
(ecomplete-setup)))
- (add-hook 'completion-at-point-functions #'eudc-capf-complete -1 t)
(add-hook 'completion-at-point-functions #'message-completion-function nil t)
(unless buffer-file-name
(message-set-auto-save-file-name))
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index ebd0adf2e2..dc86fe6db9 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1484,10 +1484,12 @@ Ask for type, description or disposition according to
(setq disposition (mml-minibuffer-read-disposition type nil file)))
(mml-attach-file file type description disposition)))))
-(defun mml-attach-buffer (buffer &optional type description disposition)
+(defun mml-attach-buffer (buffer &optional type description disposition
filename)
"Attach a buffer to the outgoing MIME message.
BUFFER is the name of the buffer to attach. See
-`mml-attach-file' for details of operation."
+`mml-attach-file' regarding TYPE, DESCRIPTION and DISPOSITION.
+FILENAME is a suggested file name for the attachment should a
+recipient wish to save a copy separate from the message."
(interactive
(let* ((buffer (read-buffer "Attach buffer: "))
(type (mml-minibuffer-read-type buffer "text/plain"))
@@ -1497,9 +1499,10 @@ BUFFER is the name of the buffer to attach. See
;; If in the message header, attach at the end and leave point unchanged.
(let ((head (unless (message-in-body-p) (point))))
(if head (goto-char (point-max)))
- (mml-insert-empty-tag 'part 'type type 'buffer buffer
- 'disposition disposition
- 'description description)
+ (apply #'mml-insert-empty-tag
+ 'part 'type type 'buffer buffer
+ 'disposition disposition 'description description
+ (and filename `(filename ,filename)))
;; When using Mail mode, make sure it does the mime encoding
;; when you send the message.
(or (eq mail-user-agent 'message-user-agent)
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/gnus/nnml.el b/lisp/gnus/nnml.el
index 40e4b9ea82..7aa445e664 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -776,17 +776,22 @@ article number. This function is called narrowed to an
article."
(nnml--encode-headers headers)
headers))))
+;; RFC2047-encode Subject and From, but leave invalid headers unencoded.
(defun nnml--encode-headers (headers)
(let ((subject (mail-header-subject headers))
(rfc2047-encoding-type 'mime))
(unless (string-match "\\`[[:ascii:]]*\\'" subject)
- (setf (mail-header-subject headers)
- (mail-encode-encoded-word-string subject t))))
+ (let ((encoded-subject
+ (ignore-errors (mail-encode-encoded-word-string subject t))))
+ (if encoded-subject
+ (setf (mail-header-subject headers) encoded-subject)))))
(let ((from (mail-header-from headers))
(rfc2047-encoding-type 'address-mime))
(unless (string-match "\\`[[:ascii:]]*\\'" from)
- (setf (mail-header-from headers)
- (rfc2047-encode-string from t)))))
+ (let ((encoded-from
+ (ignore-errors (rfc2047-encode-string from t))))
+ (if encoded-from
+ (setf (mail-header-from headers) encoded-from))))))
(defun nnml-get-nov-buffer (group &optional incrementalp)
(let ((buffer (gnus-get-buffer-create
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/keymap.el b/lisp/keymap.el
index b355f68aa2..e93e3c5f3b 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -625,7 +625,7 @@ command exists in this specific map, but it doesn't have the
`(defvar ,variable-name
(define-keymap ,@(nreverse opts) ,@defs)
,@(and doc (list doc)))))
- (if repeat
+ (if props
`(progn
,defvar-form
,@(nreverse props))
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/mail/rmailsum.el b/lisp/mail/rmailsum.el
index d63e05f5fa..20362d39d1 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -339,7 +339,7 @@ First element is ignored.")
(split-string header "[ \f\t\n\r\v,;]+"))))
(defun rmail-summary-fill-message-parents-and-descs-vectors ()
- "Fill parents and descendats vectors for messages.
+ "Fill parents and descendants vectors for messages.
This populates `rmail-summary-message-parents-vector'
and `rmail-summary-message-descendants-vector'."
(with-current-buffer rmail-buffer
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index 058ea4499f..1b28509dd1 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -292,7 +292,7 @@ folder containing the index search results."
(cons folder msg)))))
folder-results-map)
- ;; Vist the results folder.
+ ;; Visit the results folder.
(mh-visit-folder index-folder () (list folder-results-map origin-map))
(goto-char (point-min))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index a89f8191c0..2f9b902f08 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1476,7 +1476,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/ange-ftp.el b/lisp/net/ange-ftp.el
index 9781ebf863..f8e2858bc3 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4129,7 +4129,7 @@ directory, so that Emacs will know its current contents."
(or (file-exists-p parent)
(ange-ftp-make-directory parent parents))))
(if (file-exists-p dir)
- (unless parents
+ (if parents t
(signal
'file-already-exists
(list "Cannot make directory: file already exists" dir)))
@@ -4158,7 +4158,8 @@ directory, so that Emacs will know its current contents."
(format "Could not make directory %s: %s"
dir
(cdr result))))
- (ange-ftp-add-file-entry dir t))
+ (ange-ftp-add-file-entry dir t)
+ nil)
(ange-ftp-real-make-directory dir)))))
(defun ange-ftp-delete-directory (dir &optional recursive trash)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 3799ef96e8..a8a985b8de 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -2498,10 +2498,10 @@ Otherwise, the restored buffer will contain a prompt to
do so by using
(when (plist-get eww-data :url)
(cl-case eww-restore-desktop
((t auto) (eww (plist-get eww-data :url)))
- ((zerop (buffer-size))
- (let ((inhibit-read-only t))
- (insert (substitute-command-keys
- eww-restore-reload-prompt)))))))
+ ((nil) (when (zerop (buffer-size))
+ (let ((inhibit-read-only t))
+ (insert (substitute-command-keys
+ eww-restore-reload-prompt))))))))
;; .
(current-buffer)))
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 6e3845aec1..9f14df08a7 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)
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/soap-client.el b/lisp/net/soap-client.el
index 5e7bdbe6c6..6e9200e465 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -1317,7 +1317,7 @@ See also `soap-wsdl-resolve-references'."
"Validate VALUE against the basic type TYPE."
(let* ((kind (soap-xs-basic-type-kind type)))
(cl-case kind
- ((anyType Array byte[])
+ ((anyType Array byte\[\])
value)
(t
(let ((convert (get kind 'rng-xsd-convert)))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 90020fbb1b..5a025130ec 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -411,20 +411,11 @@ Emacs dired can't find files."
(defun tramp-adb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists dir))
- (when parents
- (let ((par (expand-file-name ".." dir)))
- (unless (file-directory-p par)
- (make-directory par parents))))
- (tramp-flush-directory-properties v localname)
- (unless (or (tramp-adb-send-command-and-check
- v (format "mkdir -m %#o %s"
- (default-file-modes)
- (tramp-shell-quote-argument localname)))
- (and parents (file-directory-p dir)))
+ (tramp-skeleton-make-directory dir parents
+ (unless (tramp-adb-send-command-and-check
+ v (format "mkdir -m %#o %s"
+ (default-file-modes)
+ (tramp-shell-quote-argument localname)))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
(defun tramp-adb-handle-delete-directory (directory &optional recursive trash)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 249b3fcd4d..e6c0ebccbf 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -800,16 +800,9 @@ WILDCARD is not supported."
(defun tramp-crypt-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name dir) nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists dir))
+ (tramp-skeleton-make-directory dir parents
(let (tramp-crypt-enabled)
- (make-directory (tramp-crypt-encrypt-file-name dir) parents))
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))))
+ (make-directory (tramp-crypt-encrypt-file-name dir) parents))))
(defun tramp-crypt-handle-rename-file
(filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index ea6b5a0622..5176c6e9c4 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -127,14 +127,8 @@
(defun tramp-fuse-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name dir) nil
- (make-directory (tramp-fuse-local-file-name dir) parents)
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole file cache.
- (tramp-flush-file-properties v localname)
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))))
+ (tramp-skeleton-make-directory dir parents
+ (make-directory (tramp-fuse-local-file-name dir) parents)))
;; File name helper functions.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index da7641774f..66f4de989d 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1560,27 +1560,13 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(defun tramp-gvfs-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (setq dir (directory-file-name (expand-file-name dir)))
- (with-parsed-tramp-file-name dir nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists dir))
- (tramp-flush-directory-properties v localname)
+ (tramp-skeleton-make-directory dir parents
(save-match-data
- (let ((ldir (file-name-directory dir)))
- ;; Make missing directory parts. "gvfs-mkdir -p ..." does not
- ;; work robust.
- (when (and parents (not (file-directory-p ldir)))
- (make-directory ldir parents))
- ;; Just do it.
- (or (when-let ((mkdir-succeeded
- (and
- (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
- (tramp-gvfs-info dir))))
- (set-file-modes dir (default-file-modes))
- mkdir-succeeded)
- (and parents (file-directory-p dir))
- (tramp-error v 'file-error "Couldn't make directory %s" dir))))))
+ (if (and (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (tramp-gvfs-info dir))
+ (set-file-modes dir (default-file-modes))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
(defun tramp-gvfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6087f16431..a5327e428a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2559,19 +2559,10 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists dir))
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
+ (tramp-skeleton-make-directory dir parents
(tramp-barf-unless-okay
v (format "%s -m %#o %s"
- (if parents "mkdir -p" "mkdir")
- (default-file-modes)
+ "mkdir" (default-file-modes)
(tramp-shell-quote-argument localname))
"Couldn't make directory %s" dir)))
@@ -2829,7 +2820,7 @@ the result will be a local, non-Tramp, file name."
(when (zerop (length name)) (setq name "."))
;; On MS Windows, some special file names are not returned properly
;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
- ;; there could be the falso positive "/:".
+ ;; there could be the false positive "/:".
(if (or (and (eq system-type 'windows-nt)
(string-match-p
(tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index cd73b9b8ec..b51f42deb4 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1172,30 +1172,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (setq dir (directory-file-name (expand-file-name dir)))
- (unless (file-name-absolute-p dir)
- (setq dir (expand-file-name dir default-directory)))
- (with-parsed-tramp-file-name dir nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists dir))
- (let* ((ldir (file-name-directory dir)))
- ;; Make missing directory parts.
- (when (and parents
- (tramp-smb-get-share v)
- (not (file-directory-p ldir)))
- (make-directory ldir parents))
- ;; Just do it.
- (when (file-directory-p ldir)
- (tramp-smb-send-command
- v (if (tramp-smb-get-cifs-capabilities v)
- (format "posix_mkdir %s %o"
- (tramp-smb-shell-quote-localname v) (default-file-modes))
- (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname))
- (unless (file-directory-p dir)
- (tramp-error v 'file-error "Couldn't make directory %s" dir)))))
+ (tramp-skeleton-make-directory dir parents
+ (tramp-smb-send-command
+ v (if (tramp-smb-get-cifs-capabilities v)
+ (format "posix_mkdir %s %o"
+ (tramp-smb-shell-quote-localname v) (default-file-modes))
+ (format "mkdir %s" (tramp-smb-shell-quote-localname v))))
+ (unless (file-directory-p dir)
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))
;; This is not used anymore.
(defun tramp-smb-handle-make-directory-internal (directory)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index fcc27dd834..8774367cef 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -626,18 +626,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-make-directory (dir &optional parents)
"Like `make-directory' for Tramp files."
- (setq dir (expand-file-name dir))
- (with-parsed-tramp-file-name dir nil
- (when (and (null parents) (file-exists-p dir))
- (tramp-error v 'file-already-exists "Directory already exists %s" dir))
- ;; When PARENTS is non-nil, DIR could be a chain of non-existent
- ;; directories a/b/c/... Instead of checking, we simply flush the
- ;; whole cache.
- (tramp-flush-directory-properties
- v (if parents "/" (file-name-directory localname)))
+ (tramp-skeleton-make-directory dir parents
(unless (tramp-sudoedit-send-command
- v (if parents '("mkdir" "-p") "mkdir")
- "-m" (format "%#o" (default-file-modes))
+ v "mkdir" "-m" (format "%#o" (default-file-modes))
(tramp-compat-file-name-unquote localname))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index ca8963fbf5..acbd50dc0f 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3537,6 +3537,27 @@ BODY is the backend specific code."
;; Trigger the `file-missing' error.
(signal 'error nil)))))
+(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body)
+ "Skeleton for `tramp-*-handle-make-directory'.
+BODY is the backend specific code."
+ ;; Since Emacs 29.1, PARENTS isn't propagated to the handlers
+ ;; anymore. And the return values are specified since then as well.
+ (declare (indent 2) (debug t))
+ `(let* ((dir (directory-file-name (expand-file-name ,dir)))
+ (par (file-name-directory dir)))
+ (with-parsed-tramp-file-name dir nil
+ (when (and (null ,parents) (file-exists-p dir))
+ (tramp-error v 'file-already-exists dir))
+ ;; Make missing directory parts.
+ (when ,parents
+ (unless (file-directory-p par)
+ (make-directory par ,parents)))
+ ;; Just do it.
+ (if (file-exists-p dir) t
+ (tramp-flush-file-properties v localname)
+ ,@body
+ nil))))
+
(defmacro tramp-skeleton-set-file-modes-times-uid-gid
(filename &rest body)
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
@@ -5418,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/ChangeLog.1 b/lisp/org/ChangeLog.1
index 4f51c6a1eb..e72526c3ed 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -10418,7 +10418,7 @@
* org.el (org-adaptive-fill-function): Remove occasional spurious
space character when auto-filling.
- * org.el (org-mode): Call external initalizers. Now both filling
+ * org.el (org-mode): Call external initializers. Now both filling
code and comments code have their own independent part in org.el.
(org-setup-filling): Rename from `org-set-autofill-regexps'.
(org-setup-comments-handling): New function.
@@ -15589,7 +15589,7 @@
* ob-python.el (org-babel-python-evaluate-session): Introduced a
new local function for sending input with a slight delay to allow
- pythong to re-draw the prompt. No longer removing newlines inside
+ python to re-draw the prompt. No longer removing newlines inside
code block bodies (was due to a defective regexp).
2011-07-28 Bastien Guerry <bzg@gnu.org>
@@ -17320,7 +17320,7 @@
* ob-lisp.el (org-babel-execute:lisp): Turn vectors into lists
before reading by elisp.
- (org-bable-lisp-vector-to-list): Stub of a vector->list function,
+ (org-babel-lisp-vector-to-list): Stub of a vector->list function,
should be replaced with a cl-vector->el-vector function.
2011-07-28 Eric Schulte <schulte.eric@gmail.com>
@@ -29935,7 +29935,7 @@
inserted at the correct position.
* org-publish.el (org-publish-project-alist)
- (org-publish-projects, org-publish-org-index): Change default anme
+ (org-publish-projects, org-publish-org-index): Change default name
for the index of file names to "sitemap.org".
* org-latex.el (org-export-latex-tables):
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 71c242ea65..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
@@ -7260,18 +7272,18 @@ Each element indicates the latest
`org-element--cache-change-tic' when
change did not contain gaps.")
;;;###autoload
-(defun org-element-cache-reset (&optional all no-persistance)
+(defun org-element-cache-reset (&optional all no-persistence)
"Reset cache in current buffer.
When optional argument ALL is non-nil, reset cache in all Org
buffers.
-When optional argument NO-PERSISTANCE is non-nil, do not try to update
+When optional argument NO-PERSISTENCE is non-nil, do not try to update
the cache persistence in the buffer."
(interactive "P")
(dolist (buffer (if all (buffer-list) (list (current-buffer))))
(org-with-base-buffer buffer
(when (and org-element-use-cache (derived-mode-p 'org-mode))
;; Only persist cache in file buffers.
- (when (and (buffer-file-name) (not no-persistance))
+ (when (and (buffer-file-name) (not no-persistence))
(when (not org-element-cache-persistent)
(org-persist-unregister 'org-element--headline-cache
(current-buffer))
(org-persist-unregister 'org-element--cache (current-buffer)))
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index 0effa13a1d..b3ee17ccdf 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -517,7 +517,7 @@ content of these blocks will still be treated as Org
syntax."
(defface org-agenda-structure-filter '((t (:inherit (org-warning
org-agenda-structure))))
"Face used for the current type of task filter in the agenda.
It inherits from `org-agenda-structure' so it can adapt to
-it (e.g. if that is assigned a diffent font height or family)."
+it (e.g. if that is assigned a different font height or family)."
:group 'org-faces)
(defface org-agenda-date '((t (:inherit org-agenda-structure)))
diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el
index ffa689d4fa..c4d78496e5 100644
--- a/lisp/org/org-fold-core.el
+++ b/lisp/org/org-fold-core.el
@@ -145,7 +145,7 @@
;; All the folding specs can be specified by symbol representing their
;; name. However, this is not always convenient, especially if the
-;; same spec can be used for fold different syntaxical structures.
+;; same spec can be used for fold different syntactical structures.
;; Any folding spec can be additionally referenced by a symbol listed
;; in the spec's `:alias' folding spec property. For example, Org
;; mode's `org-fold-outline' folding spec can be referenced as any
@@ -189,9 +189,9 @@
;; all the processing related to buffer modifications.
;; The library also provides a way to unfold the text after some
-;; destructive changes breaking syntaxical structure of the buffer.
+;; destructive changes breaking syntactical structure of the buffer.
;; For example, Org mode automatically reveals folded drawers when the
-;; drawer becomes syntaxically incorrect:
+;; drawer becomes syntactically incorrect:
;; ------- before modification -------
;; :DRAWER:<begin fold>
;; Some folded text inside drawer
@@ -321,7 +321,7 @@ following symbols:
functions relying on this package might not be able to unfold the
edited text. For example, removed leading stars from a folded
headline in Org mode will break visibility cycling since Org mode
- will not be avare that the following folded text belonged to
+ will not be aware that the following folded text belonged to
headline.
- `ignore-modification-checks': Do not try to detect insertions in the
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/outline.el b/lisp/outline.el
index 53bfc4d556..c2b33b4c58 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -1868,6 +1868,7 @@ With a prefix argument, show headings up to that LEVEL."
(defvar-keymap outline-navigation-repeat-map
+ :repeat t
"C-b" #'outline-backward-same-level
"b" #'outline-backward-same-level
"C-f" #'outline-forward-same-level
@@ -1879,14 +1880,8 @@ With a prefix argument, show headings up to that LEVEL."
"C-u" #'outline-up-heading
"u" #'outline-up-heading)
-(dolist (command '(outline-backward-same-level
- outline-forward-same-level
- outline-next-visible-heading
- outline-previous-visible-heading
- outline-up-heading))
- (put command 'repeat-map 'outline-navigation-repeat-map))
-
(defvar-keymap outline-editing-repeat-map
+ :repeat t
"C-v" #'outline-move-subtree-down
"v" #'outline-move-subtree-down
"C-^" #'outline-move-subtree-up
@@ -1896,12 +1891,6 @@ With a prefix argument, show headings up to that LEVEL."
"C-<" #'outline-promote
"<" #'outline-promote)
-(dolist (command '(outline-move-subtree-down
- outline-move-subtree-up
- outline-demote
- outline-promote))
- (put command 'repeat-map 'outline-editing-repeat-map))
-
(provide 'outline)
(provide 'noutline)
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 cf941236f8..50b951888a 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.
@@ -556,15 +572,144 @@ the semicolon. This function skips the semicolon."
`treesit-defun-type-regexp' defines what constructs to indent."
(interactive "*")
- (let ((orig-point (point-marker)))
- ;; If `treesit-beginning-of-defun' returns nil, we are not in a
- ;; defun, so don't indent anything.
- (when (treesit-beginning-of-defun)
- (let ((start (point)))
- (treesit-end-of-defun)
- (indent-region start (point))))
+ (when-let ((orig-point (point-marker))
+ (node (treesit-defun-at-point)))
+ (indent-region (treesit-node-start node)
+ (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))
+ (when (equal (treesit-node-type node) "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
@@ -587,6 +732,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.
@@ -596,13 +742,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)
@@ -623,13 +781,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))
@@ -637,37 +788,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))
@@ -675,11 +812,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/cc-engine.el b/lisp/progmodes/cc-engine.el
index edb873f5a6..2198f3115a 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -7757,7 +7757,7 @@ multi-line strings (but not C++, for example)."
(1- (match-end 1)) ; 1- For the inserted ".
eoll))))
- ;; ...and clear `syntax-table' text propertes from the
+ ;; ...and clear `syntax-table' text properties from the
;; following raw strings.
(c-depropertize-ml-strings-in-region (point) (1+ eoll)))
;; Remove the temporary string delimiter.
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/eglot.el b/lisp/progmodes/eglot.el
index ce4ca4f3d9..15cb1b6fad 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -190,6 +190,7 @@ chosen (interactively or automatically)."
'("pylsp" "pyls" ("pyright-langserver"
"--stdio") "jedi-language-server")))
((js-json-mode json-mode json-ts-mode)
. ,(eglot-alternatives
'(("vscode-json-language-server" "--stdio")
+
("vscode-json-languageserver" "--stdio")
("json-languageserver" "--stdio"))))
((js-mode js-ts-mode tsx-ts-mode
typescript-ts-mode typescript-mode)
. ("typescript-language-server" "--stdio"))
@@ -907,6 +908,8 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
do (with-demoted-errors "[eglot] shutdown all: %s"
(cl-loop for s in ss do (eglot-shutdown s nil nil
preserve-buffers)))))
+(defvar eglot--servers-by-xrefed-file (make-hash-table :test 'equal))
+
(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
;; Turn off `eglot--managed-mode' where appropriate.
@@ -925,6 +928,9 @@ PRESERVE-BUFFERS as in `eglot-shutdown', which see."
(setf (gethash (eglot--project server) eglot--servers-by-project)
(delq server
(gethash (eglot--project server) eglot--servers-by-project)))
+ (maphash (lambda (f s)
+ (when (eq s server) (remhash f eglot--servers-by-xrefed-file)))
+ eglot--servers-by-xrefed-file)
(cond ((eglot--shutdown-requested server)
t)
((not (eglot--inhibit-autoreconnect server))
@@ -1056,9 +1062,6 @@ be guessed."
(put 'eglot-lsp-context 'variable-documentation
"Dynamically non-nil when searching for projects in LSP context.")
-(defvar eglot--servers-by-xrefed-file
- (make-hash-table :test 'equal :weakness 'value))
-
(defun eglot--current-project ()
"Return a project object for Eglot's LSP purposes.
This relies on `project-current' and thus on
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index a19abf77e5..51afb7e485 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -269,7 +269,7 @@ Scrolling: SPC DEL RET
Text Searches: Inside Topic: Use Emacs search functions
Exit: [q]uit or mouse button 3 will kill the frame
-When the hep text is a source file, the following commands are available
+When the help text is a source file, the following commands are available
Fontification: [F]ontify the buffer like source code
Jump: [h] to function doclib header
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 cbcca81baa..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,91 +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)))
- `(("Class" . ,(js--treesit-imenu-1 class-tree))
- ("Variable" . ,(js--treesit-imenu-1 var-tree))
- ("Function" . ,(js--treesit-imenu-1 func-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
@@ -3853,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
@@ -3885,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/project.el b/lisp/progmodes/project.el
index 559da6dd64..c263379847 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1040,12 +1040,14 @@ by the user at will."
(setq substrings (cons "./" substrings))))
(new-collection (project--file-completion-table substrings))
(abbr-cpd (abbreviate-file-name common-parent-directory))
+ (abbr-cpd-length (length abbr-cpd))
(relname (cl-letf ((history-add-new-input nil)
((symbol-value hist)
(mapcan
(lambda (s)
(and (string-prefix-p abbr-cpd s)
- (list (substring s (length abbr-cpd)))))
+ (not (eq abbr-cpd-length (length s)))
+ (list (substring s abbr-cpd-length))))
(symbol-value hist))))
(project--completing-read-strict prompt
new-collection
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index bdc9e6fa78..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
@@ -4540,7 +4559,7 @@ Commands that must finish the tracking session are listed
in
(when (and python-pdbtrack-tracked-buffer
;; Empty input is sent by C-d or `comint-send-eof'
(or (string-empty-p input)
- ;; "n some text" is "n" command for pdb. Split input and get
firs part
+ ;; "n some text" is "n" command for pdb. Split input and get
first part
(let* ((command (car (split-string (string-trim input) " "))))
(setq python-pdbtrack-prev-command-continue
(or (member command python-pdbtrack-continue-command)
@@ -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 fa51597697..a4aa61905e 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -212,7 +212,7 @@ It should match the part after \"def\" and until \"=\".")
:safe 'booleanp)
(defcustom ruby-indent-level 2
- "Indentation of Ruby statements."
+ "Number of spaces for each indentation step in `ruby-mode'."
:type 'integer
:safe 'integerp)
@@ -268,6 +268,23 @@ Only has effect when `ruby-use-smie' is t."
:safe 'booleanp
:version "24.4")
+(defcustom ruby-method-params-indent t
+ "Indentation of multiline method parameters.
+
+When t, the parameters list is indented to the method name.
+
+When a number, indent the parameters list this many columns
+against the beginning of the method (the \"def\" keyword).
+
+The value nil means the same as 0.
+
+Only has effect when `ruby-use-smie' is t."
+ :type '(choice (const :tag "Indent to the method name" t)
+ (number :tag "Indent specified number of columns against def")
+ (const :tag "Indent to def" nil))
+ :safe (lambda (val) (or (memq val '(t nil)) (numberp val)))
+ :version "29.1")
+
(defcustom ruby-deep-arglist t
"Deep indent lists in parenthesis when non-nil.
Also ignores spaces after parenthesis when `space'.
@@ -660,9 +677,12 @@ This only affects the output of the command
`ruby-toggle-block'."
(unless (or (eolp) (forward-comment 1))
(cons 'column (current-column)))))
('(:before . " @ ")
- (save-excursion
- (skip-chars-forward " \t")
- (cons 'column (current-column))))
+ (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))
('(:before . ".")
(if (smie-rule-sibling-p)
@@ -1879,7 +1899,7 @@ or `gem' statement around point."
(setq feature-name (read-string "Feature name: " init))))
(let ((out
(substring
- (shell-command-to-string (concat "gem which " feature-name))
+ (shell-command-to-string (concat "gem which " (shell-quote-argument
feature-name)))
0 -1)))
(if (string-match-p "\\`ERROR" out)
(user-error "%s" out)
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 33e8d98ce3..e382239fc8 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -368,6 +368,13 @@ This property can override the value of this variable."
(defcustom repeat-keep-prefix nil
"Whether to keep the prefix arg of the previous command when repeating."
:type 'boolean
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when repeat-mode
+ (if repeat-keep-prefix
+ (add-hook 'pre-command-hook 'repeat-pre-hook)
+ (remove-hook 'pre-command-hook 'repeat-pre-hook))))
:group 'repeat
:version "28.1")
@@ -392,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"
@@ -419,7 +427,11 @@ When Repeat mode is enabled, and the command symbol has
the property named
See `describe-repeat-maps' for a list of all repeatable commands."
:global t :group 'repeat
(if (not repeat-mode)
- (remove-hook 'post-command-hook 'repeat-post-hook)
+ (progn
+ (remove-hook 'pre-command-hook 'repeat-pre-hook)
+ (remove-hook 'post-command-hook 'repeat-post-hook))
+ (when repeat-keep-prefix
+ (add-hook 'pre-command-hook 'repeat-pre-hook))
(add-hook 'post-command-hook 'repeat-post-hook)
(let* ((keymaps nil)
(commands (all-completions
@@ -431,15 +443,21 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
(length commands)
(length (delete-dups keymaps))))))
-(defvar repeat--prev-mb '(0)
- "Previous minibuffer state.")
-
(defun repeat--command-property (property)
(or (and (symbolp this-command)
(get this-command property))
(and (symbolp real-this-command)
(get real-this-command property))))
+(defun repeat-get-map ()
+ "Return a transient map for keys repeatable after the current command."
+ (when repeat-mode
+ (let ((rep-map (or repeat-map (repeat--command-property 'repeat-map))))
+ (when rep-map
+ (when (and (symbolp rep-map) (boundp rep-map))
+ (setq rep-map (symbol-value rep-map)))
+ rep-map))))
+
(defun repeat-check-key (key map)
"Check if the last key is suitable to activate the repeating MAP."
(let* ((prop (repeat--command-property 'repeat-check-key))
@@ -449,50 +467,61 @@ See `describe-repeat-maps' for a list of all repeatable
commands."
;; Try without modifiers:
(lookup-key map (vector (event-basic-type key))))))
+(defvar repeat--prev-mb '(0)
+ "Previous minibuffer state.")
+
+(defun repeat-check-map (map)
+ "Decides whether MAP can be used for the next command."
+ (and map
+ ;; Detect changes in the minibuffer state to allow repetitions
+ ;; in the same minibuffer, but not when the minibuffer is activated
+ ;; in the middle of repeating sequence (bug#47566).
+ (or (< (minibuffer-depth) (car repeat--prev-mb))
+ (eq current-minibuffer-command (cdr repeat--prev-mb)))
+ (repeat-check-key last-command-event map)
+ t))
+
+(defun repeat-pre-hook ()
+ "Function run before commands to handle repeatable keys."
+ (when (and repeat-mode repeat-keep-prefix repeat-in-progress
+ (not prefix-arg) current-prefix-arg)
+ (let ((map (repeat-get-map)))
+ ;; Only when repeat-post-hook will activate the same map
+ (when (repeat-check-map map)
+ ;; Optimize to use less logic in the function `repeat-get-map'
+ ;; for the next call: when called again from `repeat-post-hook'
+ ;; it will use the variable `repeat-map'.
+ (setq repeat-map map)
+ ;; Preserve universal argument
+ (setq prefix-arg current-prefix-arg)))))
+
(defun repeat-post-hook ()
"Function run after commands to set transient keymap for repeatable keys."
(let ((was-in-progress repeat-in-progress))
(setq repeat-in-progress nil)
- (when repeat-mode
- (let ((rep-map (or repeat-map (repeat--command-property 'repeat-map))))
- (when rep-map
- (when (and (symbolp rep-map) (boundp rep-map))
- (setq rep-map (symbol-value rep-map)))
- (let ((map (copy-keymap rep-map)))
-
- (when (and
- ;; Detect changes in the minibuffer state to allow
repetitions
- ;; in the same minibuffer, but not when the minibuffer is
activated
- ;; in the middle of repeating sequence (bug#47566).
- (or (< (minibuffer-depth) (car repeat--prev-mb))
- (eq current-minibuffer-command (cdr repeat--prev-mb)))
- (or (not repeat-keep-prefix) prefix-arg)
- (repeat-check-key last-command-event map))
-
- ;; Messaging
- (unless prefix-arg
- (funcall repeat-echo-function map))
-
- ;; Adding an exit key
- (when repeat-exit-key
- (define-key map (if (key-valid-p repeat-exit-key)
- (kbd repeat-exit-key)
- repeat-exit-key)
- 'ignore))
-
- (when (and repeat-keep-prefix (not prefix-arg))
- (setq prefix-arg current-prefix-arg))
-
- (setq repeat-in-progress t)
- (let ((exitfun (set-transient-map map)))
- (repeat--exit)
- (setq repeat-exit-function exitfun)
-
- (let* ((prop (repeat--command-property 'repeat-exit-timeout))
- (timeout (unless (eq prop 'no) (or prop
repeat-exit-timeout))))
- (when timeout
- (setq repeat-exit-timer
- (run-with-idle-timer timeout nil
#'repeat-exit))))))))))
+ (let ((map (repeat-get-map)))
+ (when (repeat-check-map map)
+ ;; Messaging
+ (funcall repeat-echo-function map)
+
+ ;; Adding an exit key
+ (when repeat-exit-key
+ (setq map (copy-keymap map))
+ (define-key map (if (key-valid-p repeat-exit-key)
+ (kbd repeat-exit-key)
+ repeat-exit-key)
+ 'ignore))
+
+ (setq repeat-in-progress t)
+ (repeat--exit)
+ (let ((exitfun (set-transient-map map)))
+ (setq repeat-exit-function exitfun)
+
+ (let* ((prop (repeat--command-property 'repeat-exit-timeout))
+ (timeout (unless (eq prop 'no) (or prop
repeat-exit-timeout))))
+ (when timeout
+ (setq repeat-exit-timer
+ (run-with-idle-timer timeout nil #'repeat-exit)))))))
(setq repeat-map nil)
(setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command))
@@ -582,6 +611,7 @@ Used in `repeat-mode'."
(push s (alist-get (get s 'repeat-map) keymaps)))))
(with-help-window (help-buffer)
(with-current-buffer standard-output
+ (setq-local outline-regexp "[*]+")
(insert "A list of keymaps used by commands with the symbol property
`repeat-map'.\n")
(dolist (keymap (sort keymaps (lambda (a b)
diff --git a/lisp/replace.el b/lisp/replace.el
index 302cb65543..cebe779ae4 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1692,7 +1692,7 @@ contents of the line; it normally shows the line number.
\(For
multiline matches, the prefix column shows the line number for the
first line and whitespace for the rest of the lines.\)
If this face will display the same as the default face, the prefix
-column will not be highlighted speciall."
+column will not be highlighted specially."
:type 'face
:group 'matching
:version "24.4")
diff --git a/lisp/server.el b/lisp/server.el
index 8f4ca4cbc6..8bd622346e 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1502,7 +1502,7 @@ so don't mark these buffers specially, just visit them
normally."
minibuffer-auto-raise))
(filen (car file))
(obuf (get-file-buffer filen)))
- (add-to-history 'file-name-history filen)
+ (file-name-history--add filen)
(if (null obuf)
(progn
(run-hooks 'pre-command-hook)
diff --git a/lisp/shell.el b/lisp/shell.el
index dadbdcbc03..727f2aa0dd 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -395,12 +395,10 @@ Useful for shells like zsh that has this feature."
(defvar-keymap shell-repeat-map
:doc "Keymap to repeat shell key sequences. Used in `repeat-mode'."
+ :repeat t
"C-f" #'shell-forward-command
"C-b" #'shell-backward-command)
-(put #'shell-forward-command 'repeat-map 'shell-repeat-map)
-(put #'shell-backward-command 'repeat-map 'shell-repeat-map)
-
(defcustom shell-mode-hook '()
"Hook for customizing Shell mode."
:type 'hook
diff --git a/lisp/simple.el b/lisp/simple.el
index f85428ca74..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))
@@ -10053,6 +10063,8 @@ PREFIX is the string that represents this modifier in
an event type symbol."
event-type
(cons event-type (cdr event)))))))
+;; This is what makes "C-x @" followed by [hsmaSc] work even though
+;; you won't find any (define-key ctl-x-map "@" ...) binding.
(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
diff --git a/lisp/sort.el b/lisp/sort.el
index d04f075abd..b66d6453d2 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -86,7 +86,7 @@ second key. If PREDICATE is nil, comparison is done with `<'
if
the keys are numbers, with `compare-buffer-substrings' if the
keys are cons cells (the car and cdr of each cons cell are taken
as start and end positions), and with `string<' otherwise."
- ;; Heuristically try to avoid messages if sorting a small amt of text.
+ ;; Heuristically try to avoid messages if sorting a small amount of text.
(let ((messages (> (- (point-max) (point-min)) 50000)))
(save-excursion
(if messages (message "Finding sort keys..."))
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 e142eaa810..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.
@@ -1576,16 +1596,18 @@ in the current Emacs session, then this function may
return nil."
;; Use `window-point' for the case when the current buffer
;; is temporarily switched to some other buffer (bug#50256)
(let* ((pos (window-point))
- (posn (posn-at-point pos)))
- (if (null posn) ;; `pos' is "out of sight".
- (list (selected-window) pos '(0 . 0) 0)
- ;; If `pos' is inside a chunk of text hidden by an `invisible'
- ;; or `display' property, `posn-at-point' returns the position
- ;; that *is* visible, whereas `event--posn-at-point' is used
- ;; when we have a keyboard event, whose position is `point' even
- ;; if that position is invisible.
- (setf (nth 5 posn) pos)
- posn)))
+ (posn (posn-at-point pos (if (minibufferp (current-buffer))
+ (minibuffer-window)))))
+ (cond ((null posn) ;; `pos' is "out of sight".
+ (setq posn (list (selected-window) pos '(0 . 0) 0)))
+ ;; If `pos' is inside a chunk of text hidden by an `invisible'
+ ;; or `display' property, `posn-at-point' returns the position
+ ;; that *is* visible, whereas `event--posn-at-point' is used
+ ;; when we have a keyboard event, whose position is `point' even
+ ;; if that position is invisible.
+ ((> (length posn) 5)
+ (setf (nth 5 posn) pos)))
+ posn))
(defun event-start (event)
"Return the starting position of EVENT.
@@ -4848,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)))))
@@ -4858,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.
@@ -6084,14 +6109,8 @@ command is called from a keyboard macro?"
;; Skip special forms (from non-compiled code).
(and frame (null (car frame)))
;; Skip also `interactive-p' (because we don't want to know if
- ;; interactive-p was called interactively but if it's caller was)
- ;; and `byte-code' (idem; this appears in subexpressions of things
- ;; like condition-case, which are wrapped in a separate bytecode
- ;; chunk).
- ;; FIXME: For lexical-binding code, this is much worse,
- ;; because the frames look like "byte-code -> funcall -> #[...]",
- ;; which is not a reliable signature.
- (memq (nth 1 frame) '(interactive-p 'byte-code))
+ ;; interactive-p was called interactively but if it's caller was).
+ (eq (nth 1 frame) 'interactive-p)
;; Skip package-specific stack-frames.
(let ((skip (run-hook-with-args-until-success
'called-interactively-p-functions
@@ -6909,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 065116d512..7433f5c8e5 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1029,7 +1029,7 @@ This variable has effect only when `tab-bar-auto-width'
is non-nil."
:initialize #'custom-initialize-default
:set (lambda (sym val)
(set-default sym val)
- (setq tab-bar--fixed-width-hash nil))
+ (setq tab-bar--auto-width-hash nil))
:group 'tab-bar
:version "29.1")
@@ -1048,17 +1048,17 @@ tab bar might wrap to the second line when it
shouldn't.")
tab-bar-tab-group-inactive)
"Resize tabs only with these faces.")
-(defvar tab-bar--fixed-width-hash nil
+(defvar tab-bar--auto-width-hash nil
"Memoization table for `tab-bar-auto-width'.")
(defun tab-bar-auto-width (items)
"Return tab-bar items with resized tab names."
- (unless tab-bar--fixed-width-hash
- (define-hash-table-test 'tab-bar--fixed-width-hash-test
+ (unless tab-bar--auto-width-hash
+ (define-hash-table-test 'tab-bar--auto-width-hash-test
#'equal-including-properties
#'sxhash-equal-including-properties)
- (setq tab-bar--fixed-width-hash
- (make-hash-table :test 'tab-bar--fixed-width-hash-test)))
+ (setq tab-bar--auto-width-hash
+ (make-hash-table :test 'tab-bar--auto-width-hash-test)))
(let ((tabs nil) ;; list of resizable tabs
(non-tabs "") ;; concatenated names of non-resizable tabs
(width 0)) ;; resize tab names to this width
@@ -1086,7 +1086,7 @@ tab bar might wrap to the second line when it shouldn't.")
(setf (nth 2 item)
(with-memoization (gethash (list (selected-frame)
width (nth 2 item))
- tab-bar--fixed-width-hash)
+ tab-bar--auto-width-hash)
(let* ((name (nth 2 item))
(len (length name))
(close-p (get-text-property (1- len) 'close-tab name))
@@ -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))
@@ -2654,18 +2655,16 @@ When `switch-to-buffer-obey-display-actions' is non-nil,
(defvar-keymap tab-bar-switch-repeat-map
:doc "Keymap to repeat tab switch key sequences \\`C-x t o o O'.
Used in `repeat-mode'."
+ :repeat t
"o" #'tab-next
"O" #'tab-previous)
-(put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
-(put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
(defvar-keymap tab-bar-move-repeat-map
:doc "Keymap to repeat tab move key sequences \\`C-x t m m M'.
Used in `repeat-mode'."
+ :repeat t
"m" #'tab-move
"M" #'tab-bar-move-tab-backward)
-(put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
-(put 'tab-bar-move-tab-backward 'repeat-map 'tab-bar-move-repeat-map)
(provide 'tab-bar)
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/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index ee94cc5d69..51dedddf3a 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -2096,8 +2096,8 @@ may require a restart of Emacs in order to become
effective."
(defcustom reftex-allow-detached-macro-args nil
"Non-nil means, allow arguments of macros to be detached by whitespace.
-When this is t, `aaa' will be considered as argument of \\bb in the following
-construct: \\bbb [xxx] {aaa}."
+When this is t, `aaa' will be considered as argument of \\bbb in
+the following construct: \\bbb [xxx] {aaa}."
:group 'reftex-miscellaneous-configurations
:type 'boolean)
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 1f366807ce..4af555fb8e 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
@@ -141,6 +145,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 +175,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 +224,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 +298,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 +322,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 +878,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 +1126,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 _)
@@ -1183,7 +1218,7 @@ no-node
\(n-p-gp NODE-TYPE PARENT-TYPE GRANDPARENT-TYPE)
- Checks that NODE, its parent, and its grandparent's type.
+ Checks for NODE's, its parent's, and its grandparent's type.
\(query QUERY)
@@ -1229,7 +1264,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 +1597,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 +1659,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 +1682,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 +1746,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 +1761,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 +1779,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,85 +1802,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)
- (treesit-search-forward-goto node "" t t t)
- node))
- (node-after (if (<= (treesit-node-end node) pos)
- (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
@@ -1758,25 +1901,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)
@@ -1790,13 +1931,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))
@@ -1817,9 +1958,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))))
@@ -1829,9 +1970,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)))))
@@ -1840,6 +1981,158 @@ function is called recursively."
;; Counter equal to 0 means we successfully stepped ARG steps.
(if (eq counter 0) pos nil)))
+;; TODO: In corporate into thing-at-point.
+(defun treesit-thing-at-point (pattern tactic)
+ "Return the thing node at point or nil if none is found.
+
+\"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)
+ (treesit--thing-unpack-pattern pattern))
+ (`(,_ ,next ,parent)
+ (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 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)
@@ -1897,6 +2190,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.
@@ -1924,7 +2222,27 @@ before calling this function."
(keymap-set (current-local-map) "<remap> <beginning-of-defun>"
#'treesit-beginning-of-defun)
(keymap-set (current-local-map) "<remap> <end-of-defun>"
- #'treesit-end-of-defun)))
+ #'treesit-end-of-defun)
+ ;; `end-of-defun' will not work completely correctly in nested
+ ;; defuns due to its implementation. However, many lisp programs
+ ;; use `beginning/end-of-defun', so we should still set
+ ;; `beginning/end-of-defun-function' so they still mostly work.
+ ;; This is also what `cc-mode' does: rebind user commands and set
+ ;; 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))
+ ;; 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
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
index 56787f7c5e..737eea32c6 100644
--- a/lisp/url/url-future.el
+++ b/lisp/url/url-future.el
@@ -53,7 +53,7 @@
(define-inline url-future-errored-p (url-future)
(inline-quote (eq (url-future-status ,url-future) 'error)))
-(define-inline url-future-cancelled-p (url-future)
+(define-inline url-future-canceled-p (url-future)
(inline-quote (eq (url-future-status ,url-future) 'cancel)))
(defun url-future-finish (url-future &optional status)
@@ -96,5 +96,8 @@
(signal 'error 'url-future-already-done)
(url-future-finish url-future 'cancel)))
+(define-obsolete-function-alias 'url-future-cancelled-p
+ #'url-future-canceled-p "30.1")
+
(provide 'url-future)
;;; url-future.el ends here
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/vc/vc-git.el b/lisp/vc/vc-git.el
index 9f27f759d3..671be66bbe 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1020,40 +1020,67 @@ It is based on `log-edit-mode', and has Git-specific
extensions."
;; message. Handle also remote files.
(if (eq system-type 'windows-nt)
(let ((default-directory (file-name-directory file1)))
- (make-nearby-temp-file "git-msg")))))
+ (make-nearby-temp-file "git-msg"))))
+ to-stash)
(when vc-git-patch-string
(unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet"))
- ;; Check that all staged changes also exist in the patch.
- ;; This is needed to allow adding/removing files that are
- ;; currently staged to the index. So remove the whole file diff
- ;; from the patch because commit will take it from the index.
+ ;; Check that what's already staged is compatible with what
+ ;; we want to commit (bug#60126).
+ ;;
+ ;; 1. If the changes to a file in the index are identical to
+ ;; the changes to that file we want to commit, remove the
+ ;; changes from our patch, and let the commit take them
+ ;; from the index. This is necessary for adding and
+ ;; removing files to work.
+ ;;
+ ;; 2. If the changes to a file in the index are different to
+ ;; changes to that file we want to commit, then we have to
+ ;; unstage the changes or abort.
+ ;;
+ ;; 3. If there are changes to a file in the index but we don't
+ ;; want to commit any changes to that file, we need to
+ ;; stash those changes before committing.
(with-temp-buffer
(vc-git-command (current-buffer) t nil "diff" "--cached")
(goto-char (point-min))
- (let ((pos (point)) file-diff file-beg)
+ (let ((pos (point)) file-name file-header file-diff file-beg)
(while (not (eobp))
+ (when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)")
+ (string= (match-string 1) (match-string 2)))
+ (setq file-name (match-string 1)))
(forward-line 1) ; skip current "diff --git" line
+ (setq file-header (buffer-substring pos (point)))
(search-forward "diff --git" nil 'move)
(move-beginning-of-line 1)
(setq file-diff (buffer-substring pos (point)))
- (if (and (setq file-beg (string-search
- file-diff vc-git-patch-string))
- ;; Check that file diff ends with an empty string
- ;; or the beginning of the next file diff.
- (string-match-p "\\`\\'\\|\\`diff --git"
- (substring
- vc-git-patch-string
- (+ file-beg (length file-diff)))))
- (setq vc-git-patch-string
- (string-replace file-diff "" vc-git-patch-string))
- (user-error "Index not empty"))
+ (cond ((and (setq file-beg (string-search
+ file-diff vc-git-patch-string))
+ ;; Check that file diff ends with an empty string
+ ;; or the beginning of the next file diff.
+ (string-match-p "\\`\\'\\|\\`diff --git"
+ (substring
+ vc-git-patch-string
+ (+ file-beg (length file-diff)))))
+ (setq vc-git-patch-string
+ (string-replace file-diff "" vc-git-patch-string)))
+ ((string-match (format "^%s" (regexp-quote file-header))
+ vc-git-patch-string)
+ (if (and file-name
+ (yes-or-no-p
+ (format "Unstage already-staged changes to %s?"
+ file-name)))
+ (vc-git-command nil 0 file-name "reset" "-q" "--")
+ (user-error "Index not empty")))
+ (t (push file-name to-stash)))
(setq pos (point))))))
- (let ((patch-file (make-nearby-temp-file "git-patch")))
- (with-temp-file patch-file
- (insert vc-git-patch-string))
- (unwind-protect
- (vc-git-command nil 0 patch-file "apply" "--cached")
- (delete-file patch-file))))
+ (unless (string-empty-p vc-git-patch-string)
+ (let ((patch-file (make-nearby-temp-file "git-patch")))
+ (with-temp-file patch-file
+ (insert vc-git-patch-string))
+ (unwind-protect
+ (vc-git-command nil 0 patch-file "apply" "--cached")
+ (delete-file patch-file))))
+ (when to-stash (vc-git--stash-staged-changes files)))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
@@ -1079,7 +1106,58 @@ It is based on `log-edit-mode', and has Git-specific
extensions."
args)
(unless vc-git-patch-string
(if only (list "--only" "--") '("-a"))))))
- (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))))
+ (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))
+ (when to-stash
+ (let ((cached (make-nearby-temp-file "git-cached")))
+ (unwind-protect
+ (progn (with-temp-file cached
+ (vc-git-command t 0 nil "stash" "show" "-p"))
+ (vc-git-command nil 0 cached "apply" "--cached"))
+ (delete-file cached))
+ (vc-git-command nil 0 nil "stash" "drop")))))
+
+(defun vc-git--stash-staged-changes (files)
+ "Stash only the staged changes to FILES."
+ ;; This is necessary because even if you pass a list of file names
+ ;; to 'git stash push', it will stash any and all staged changes.
+ (unless (zerop
+ (vc-git-command nil t files "diff" "--cached" "--quiet"))
+ (cl-flet
+ ((git-string (&rest args)
+ (string-trim-right
+ (with-output-to-string
+ (apply #'vc-git-command standard-output 0 nil args)))))
+ (let ((cached (make-nearby-temp-file "git-cached"))
+ (message "Previously staged changes")
+ tree)
+ ;; Use a temporary index to create a tree object corresponding
+ ;; to the staged changes to FILES.
+ (unwind-protect
+ (progn
+ (with-temp-file cached
+ (vc-git-command t 0 files "diff" "--cached" "--"))
+ (let* ((index (make-nearby-temp-file "git-index"))
+ (process-environment
+ (cons (format "GIT_INDEX_FILE=%s" index)
+ process-environment)))
+ (unwind-protect
+ (progn
+ (vc-git-command nil 0 nil "read-tree" "HEAD")
+ (vc-git-command nil 0 cached "apply" "--cached")
+ (setq tree (git-string "write-tree")))
+ (delete-file index))))
+ (delete-file cached))
+ ;; Prepare stash commit object, which has a special structure.
+ (let* ((tree-commit (git-string "commit-tree" "-m" message
+ "-p" "HEAD" tree))
+ (stash-commit (git-string "commit-tree" "-m" message
+ "-p" "HEAD" "-p" tree-commit
+ tree)))
+ ;; Push the new stash entry.
+ (vc-git-command nil 0 nil "update-ref" "--create-reflog"
+ "-m" message "refs/stash" stash-commit)
+ ;; Unstage the changes we've now stashed.
+ (vc-git-command nil 0 files "reset" "--"))))))
(defun vc-git-find-revision (file rev buffer)
(let* (process-file-side-effects
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 690c907c77..130214b840 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3369,7 +3369,7 @@ If nil, no default will be used. This option may be set
locally."
(declare-function message--name-table "message" (orig-string))
(declare-function mml-attach-buffer "mml"
- (buffer &optional type description disposition))
+ (buffer &optional type description disposition filename))
(declare-function log-view-get-marked "log-view" ())
(defun vc-default-prepare-patch (_backend rev)
@@ -3410,6 +3410,19 @@ of the current file."
(and-let* ((file (buffer-file-name)))
(vc-working-revision file)))))
+(defun vc--subject-to-file-name (subject)
+ "Generate a file name for a patch with subject line SUBJECT."
+ (let* ((stripped
+ (replace-regexp-in-string "\\`\\[.*PATCH.*\\]\\s-*" ""
+ subject))
+ (truncated (if (length> stripped 50)
+ (substring stripped 0 50)
+ stripped)))
+ (concat
+ (string-trim (replace-regexp-in-string "\\W" "-" truncated)
+ "-+" "-+")
+ ".patch")))
+
;;;###autoload
(defun vc-prepare-patch (addressee subject revisions)
"Compose an Email sending patches for REVISIONS to ADDRESSEE.
@@ -3420,7 +3433,7 @@ revision, with SUBJECT derived from each revision subject.
When invoked with a numerical prefix argument, use the last N
revisions.
When invoked interactively in a Log View buffer with
-marked revisions, use those these."
+marked revisions, use those."
(interactive
(let ((revs (vc-prepare-patch-prompt-revisions)) to)
(require 'message)
@@ -3466,11 +3479,17 @@ marked revisions, use those these."
(rfc822-goto-eoh)
(forward-line)
(save-excursion
- (dolist (patch patches)
- (mml-attach-buffer (buffer-name (plist-get patch :buffer))
- "text/x-patch"
- (plist-get patch :subject)
- "attachment")))
+ (let ((i 0))
+ (dolist (patch patches)
+ (let* ((patch-subject (plist-get patch :subject))
+ (filename
+ (vc--subject-to-file-name patch-subject)))
+ (mml-attach-buffer
+ (buffer-name (plist-get patch :buffer))
+ "text/x-patch"
+ patch-subject
+ "attachment"
+ (format "%04d-%s" (cl-incf i) filename))))))
(open-line 2)))))
(defun vc-default-responsible-p (_backend _file)
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 25ea07e9db..558be1841a 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -2093,6 +2093,17 @@ resultant list will be returned."
t))
+(defun whitespace--clone ()
+ "Hook function run after `make-indirect-buffer' and `clone-buffer'."
+ (when (whitespace-style-face-p)
+ (setq-local whitespace-bob-marker
+ (copy-marker (marker-position whitespace-bob-marker)
+ (marker-insertion-type whitespace-bob-marker)))
+ (setq-local whitespace-eob-marker
+ (copy-marker (marker-position whitespace-eob-marker)
+ (marker-insertion-type whitespace-eob-marker)))))
+
+
(defun whitespace-color-on ()
"Turn on color visualization."
(when (whitespace-style-face-p)
@@ -2111,6 +2122,8 @@ resultant list will be returned."
;; The -1 ensures that it runs before any
;; `font-lock-mode' hook functions.
-1 t)
+ (add-hook 'clone-buffer-hook #'whitespace--clone nil t)
+ (add-hook 'clone-indirect-buffer-hook #'whitespace--clone nil t)
;; Add whitespace-mode color into font lock.
(setq
whitespace-font-lock-keywords
@@ -2204,6 +2217,8 @@ resultant list will be returned."
(remove-hook 'before-change-functions #'whitespace-buffer-changed t)
(remove-hook 'after-change-functions #'whitespace--update-bob-eob
t)
+ (remove-hook 'clone-buffer-hook #'whitespace--clone t)
+ (remove-hook 'clone-indirect-buffer-hook #'whitespace--clone t)
(font-lock-remove-keywords nil whitespace-font-lock-keywords)
(font-lock-flush)))
@@ -2268,10 +2283,11 @@ Highlighting those lines can be distracting.)"
(save-excursion (goto-char whitespace-point)
(line-beginning-position)))))
(when (= p 1)
- ;; See the comment in `whitespace--update-bob-eob' for why this
- ;; text property is added here.
- (put-text-property 1 whitespace-bob-marker
- 'font-lock-multiline t))
+ (with-silent-modifications
+ ;; See the comment in `whitespace--update-bob-eob' for why
+ ;; this text property is added here.
+ (put-text-property 1 whitespace-bob-marker
+ 'font-lock-multiline t)))
(when (< p e)
(set-match-data (list p e))
(goto-char e))))
@@ -2292,10 +2308,11 @@ about to start typing, and if they do, that line and
previous
empty lines will no longer be EoB empty lines. Highlighting
those lines can be distracting.)"
(when (= limit (1+ (buffer-size)))
- ;; See the comment in `whitespace--update-bob-eob' for why this
- ;; text property is added here.
- (put-text-property whitespace-eob-marker limit
- 'font-lock-multiline t))
+ (with-silent-modifications
+ ;; See the comment in `whitespace--update-bob-eob' for why this
+ ;; text property is added here.
+ (put-text-property whitespace-eob-marker limit
+ 'font-lock-multiline t)))
(let ((b (max (point) whitespace-eob-marker
whitespace-bob-marker ; See comment in the bob func.
(save-excursion (goto-char whitespace-point)
@@ -2437,8 +2454,9 @@ purposes)."
(save-match-data
(when (looking-at whitespace-empty-at-bob-regexp)
(set-marker whitespace-bob-marker (match-end 1))
- (put-text-property (match-beginning 1) (match-end 1)
- 'font-lock-multiline t))))
+ (with-silent-modifications
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-multiline t)))))
(when (or (null end)
(>= end (save-excursion
(goto-char whitespace-eob-marker)
@@ -2451,8 +2469,9 @@ purposes)."
(when (whitespace--looking-back
whitespace-empty-at-eob-regexp)
(set-marker whitespace-eob-marker (match-beginning 1))
- (put-text-property (match-beginning 1) (match-end 1)
- 'font-lock-multiline t)))))))))
+ (with-silent-modifications
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-multiline t))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/lisp/window.el b/lisp/window.el
index a4a8421881..5dd5b80883 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -10561,26 +10561,23 @@ displaying that processes's buffer."
(defvar-keymap other-window-repeat-map
:doc "Keymap to repeat `other-window' key sequences.
Used in `repeat-mode'."
+ :repeat t
"o" #'other-window
"O" (lambda ()
(interactive)
(setq repeat-map 'other-window-repeat-map)
(other-window -1)))
-(put 'other-window 'repeat-map 'other-window-repeat-map)
(defvar-keymap resize-window-repeat-map
:doc "Keymap to repeat window resizing commands.
Used in `repeat-mode'."
+ :repeat t
;; Standard keys:
"^" #'enlarge-window
"}" #'enlarge-window-horizontally
"{" #'shrink-window-horizontally
;; Additional keys:
"v" #'shrink-window)
-(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
-(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
-(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
-(put 'shrink-window 'repeat-map 'resize-window-repeat-map)
(defvar-keymap window-prefix-map
:doc "Keymap for subcommands of \\`C-x w'."
diff --git a/lisp/winner.el b/lisp/winner.el
index c8354b18be..aed57aa037 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -330,12 +330,10 @@ You may want to include buffer names such as *Help*,
*Apropos*,
(defvar-keymap winner-repeat-map
:doc "Keymap to repeat winner key sequences. Used in `repeat-mode'."
+ :repeat t
"<left>" #'winner-undo
"<right>" #'winner-redo)
-(put #'winner-undo 'repeat-map 'winner-repeat-map)
-(put #'winner-redo 'repeat-map 'winner-repeat-map)
-
;;;###autoload
(define-minor-mode winner-mode
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/alloc.c b/src/alloc.c
index a9eff612de..1d11051072 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7487,7 +7487,7 @@ DEFUN ("memory-info", Fmemory_info, Smemory_info, 0, 0, 0,
All values are in Kbytes. If there is no swap space,
last two values are zero. If the system is not supported
or memory information can't be obtained, return nil.
-If `default-directory’ is remote, return memory information of the
+If `default-directory' is remote, return memory information of the
respective remote host. */)
(void)
{
diff --git a/src/data.c b/src/data.c
index f8b728a480..e6be07179b 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2630,6 +2630,7 @@ bool-vector. IDX starts at 0. */)
}
else if (RECORDP (array))
{
+ CHECK_IMPURE (array, XVECTOR (array));
if (idxval < 0 || idxval >= PVSIZE (array))
args_out_of_range (array, idx);
ASET (array, idxval, newelt);
diff --git a/src/dispextern.h b/src/dispextern.h
index df6134e68f..e6c4270beb 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -107,7 +107,7 @@ typedef struct
{
int width, height; /* size of image */
char *data; /* pointer to image data */
- int bytes_per_line; /* accelarator to next line */
+ int bytes_per_line; /* accelerator to next line */
int bits_per_pixel; /* bits per pixel (ZPixmap) */
} *Emacs_Pix_Container;
typedef Emacs_Pix_Container Emacs_Pixmap;
@@ -1712,7 +1712,7 @@ struct face
/* Non-zero means characters in this face have a box of that
thickness around them. Vertical (left and right) and horizontal
- (top and bottom) borders size can be set separatedly using an
+ (top and bottom) borders size can be set separately using an
associated list of two ints in the form
(vertical_size . horizontal_size). In case one of the value is
negative, its absolute value indicates the thickness, and the
diff --git a/src/dispnew.c b/src/dispnew.c
index 5a9ba8909e..b845acdcbc 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3188,7 +3188,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-module.h.in b/src/emacs-module.h.in
index d485de5aa1..c51d482d8a 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -116,7 +116,7 @@ enum emacs_funcall_exit
/* Function has signaled an error using `signal'. */
emacs_funcall_exit_signal = 1,
- /* Function has exit using `throw'. */
+ /* Function has exited using `throw'. */
emacs_funcall_exit_throw = 2
};
diff --git a/src/emacs.c b/src/emacs.c
index d156b77d95..ee606181d7 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2918,6 +2918,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/fileio.c b/src/fileio.c
index e7c2af8142..66ce6b3088 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5376,12 +5376,16 @@ write_region (Lisp_Object start, Lisp_Object end,
Lisp_Object filename,
{
/* Transfer data and metadata to disk, retrying if interrupted.
fsync can report a write failure here, e.g., due to disk full
- under NFS. But ignore EINVAL, which means fsync is not
- supported on this file. */
+ under NFS. But ignore EINVAL (and EBADF on Windows), which
+ means fsync is not supported on this file. */
while (fsync (desc) != 0)
if (errno != EINTR)
{
- if (errno != EINVAL)
+ if (errno != EINVAL
+#ifdef WINDOWSNT
+ && errno != EBADF
+#endif
+ )
ok = 0, save_errno = errno;
break;
}
diff --git a/src/frame.h b/src/frame.h
index dcd32036b8..f29cc249ea 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1010,6 +1010,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/haikufns.c b/src/haikufns.c
index 5717d0354f..ea12a14488 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -3245,7 +3245,7 @@ syms_of_haikufns (void)
DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors,
doc: /* Vector of UI colors that Emacs can look up from the
system.
-If this is set up incorrectly, Emacs can crash when encoutering an
+If this is set up incorrectly, Emacs can crash when encountering an
invalid color. */);
Vhaiku_allowed_ui_colors = Qnil;
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/itree.c b/src/itree.c
index 688d5c8247..5079e2389f 100644
--- a/src/itree.c
+++ b/src/itree.c
@@ -85,7 +85,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
this narrowing is O(K*log(N)) where K is the size of the result
set. If we are interested in finding the node in a range with the
smallest END, we might have to examine all K nodes in that range.
- In the case of the *-overlay-channge functions, K may well be equal
+ In the case of the *-overlay-change functions, K may well be equal
to N.
Ideally, a tree based data structure for overlays would have
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 518c2e6f99..3fadd228d2 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 6cbdfed1f5..e07a019b46 100644
--- a/src/process.c
+++ b/src/process.c
@@ -6795,10 +6795,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 9fa88b48dc..d168ff02b6 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
@@ -927,11 +933,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 +968,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 +981,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 +1000,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
@@ -1762,7 +1787,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 +1803,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 +2070,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 +2105,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 +2188,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 +2289,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 +2312,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 +2395,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 +2434,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;
@@ -2637,8 +2696,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 +2756,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 +3028,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 +3039,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 +3096,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 +3207,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 +3218,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 +3267,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");
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/window.c b/src/window.c
index 90fa6ac2df..cd43919a7d 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1649,7 +1649,8 @@ check_window_containing (struct window *w, void
*user_data)
set *PART to the id of that element.
If there is no window under X, Y return nil and leave *PART
- unmodified. TOOL_BAR_P means detect tool-bar windows.
+ unmodified. TOOL_BAR_P means detect tool-bar windows, and
+ TAB_BAR_P means detect tab-bar windows.
This function was previously implemented with a loop cycling over
windows with Fnext_window, and starting with the frame's selected
diff --git a/src/xdisp.c b/src/xdisp.c
index e8df230ef8..db6dd3fab6 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++;
}
@@ -33250,7 +33258,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;
@@ -33411,7 +33419,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/xfaces.c b/src/xfaces.c
index 0189e61212..823c1d93d0 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -7279,7 +7279,7 @@ syms_of_xfaces (void)
DEFVAR_BOOL ("face-filters-always-match", face_filters_always_match,
doc: /* Non-nil means that face filters are always deemed to match.
This variable is intended for use only by code that evaluates
-the "specifity" of a face specification and should be let-bound
+the "specificity" of a face specification and should be let-bound
only for this purpose. */);
DEFVAR_LISP ("face--new-frame-defaults", Vface_new_frame_defaults,
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 a1acfa8074..1eef8e7a72 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -4597,7 +4597,7 @@ x_dnd_send_position (struct frame *f, Window target,
Window toplevel,
maintained by the original author of the protocol specifies it
for all versions. Since at least one program supports these
flags, but uses protocol v4 (and not v5), set them for all
- protocool versions. */
+ protocol versions. */
if (button >= 4 && button <= 7)
{
msg.xclient.data.l[1] |= (1 << 10);
@@ -7645,6 +7645,46 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
#endif
}
+/* Generate a premultiplied pixel value for COLOR with ALPHA applied
+ on the given display. COLOR will be modified. The display must
+ use a visual that supports an alpha channel.
+
+ This is possibly dead code on builds which do not support
+ XRender. */
+
+#ifndef USE_CAIRO
+
+static unsigned long
+x_premultiply_pixel (struct x_display_info *dpyinfo,
+ XColor *color, double alpha)
+{
+ unsigned long pixel;
+
+ eassert (dpyinfo->alpha_bits);
+
+ /* Multiply the RGB channels. */
+ color->red *= alpha;
+ color->green *= alpha;
+ color->blue *= alpha;
+
+ /* First, allocate a fully opaque pixel. */
+ pixel = x_make_truecolor_pixel (dpyinfo, color->red,
+ color->green,
+ color->blue);
+
+ /* Next, erase the alpha component. */
+ pixel &= ~dpyinfo->alpha_mask;
+
+ /* And add an alpha channel. */
+ pixel |= (((unsigned long) (alpha * 65535)
+ >> (16 - dpyinfo->alpha_bits))
+ << dpyinfo->alpha_offset);
+
+ return pixel;
+}
+
+#endif
+
static void
x_draw_fringe_bitmap (struct window *w, struct glyph_row *row,
struct draw_fringe_bitmap_params *p)
@@ -7734,18 +7774,15 @@ x_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
if (FRAME_DISPLAY_INFO (f)->alpha_bits
&& f->alpha_background < 1.0)
{
+ /* Extend the background color with an alpha channel
+ according to f->alpha_background. */
bg.pixel = background;
x_query_colors (f, &bg, 1);
- bg.red *= f->alpha_background;
- bg.green *= f->alpha_background;
- bg.blue *= f->alpha_background;
- background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f),
- bg.red, bg.green, bg.blue);
- background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask;
- background |= (((unsigned long) (f->alpha_background * 0xffff)
- >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits))
- << FRAME_DISPLAY_INFO (f)->alpha_offset);
+ background
+ = x_premultiply_pixel (FRAME_DISPLAY_INFO (f),
+ &bg,
+ f->alpha_background);
}
/* Draw the bitmap. I believe these small pixmaps can be cached
@@ -8894,7 +8931,11 @@ x_color_cells (Display *dpy, int *ncells)
/* On frame F, translate pixel colors to RGB values for the NCOLORS
- colors in COLORS. Use cached information, if available. */
+ colors in COLORS. Use cached information, if available.
+
+ Pixel values are in unsigned normalized format, meaning that
+ extending missing bits is done straightforwardly without any
+ complex colorspace conversions. */
void
x_query_colors (struct frame *f, XColor *colors, int ncolors)
@@ -8942,6 +8983,7 @@ x_query_colors (struct frame *f, XColor *colors, int
ncolors)
colors[i].green = (g * gmult) >> 16;
colors[i].blue = (b * bmult) >> 16;
}
+
return;
}
@@ -8984,16 +9026,10 @@ x_query_frame_background_color (struct frame *f, XColor
*bgcolor)
{
bg.pixel = background;
x_query_colors (f, &bg, 1);
- bg.red *= f->alpha_background;
- bg.green *= f->alpha_background;
- bg.blue *= f->alpha_background;
- background = x_make_truecolor_pixel (FRAME_DISPLAY_INFO (f),
- bg.red, bg.green, bg.blue);
- background &= ~FRAME_DISPLAY_INFO (f)->alpha_mask;
- background |= (((unsigned long) (f->alpha_background * 0xffff)
- >> (16 - FRAME_DISPLAY_INFO (f)->alpha_bits))
- << FRAME_DISPLAY_INFO (f)->alpha_offset);
+ background
+ = x_premultiply_pixel (FRAME_DISPLAY_INFO (f),
+ &bg, f->alpha_background);
}
#endif
}
@@ -21707,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;
@@ -26264,8 +26300,10 @@ x_error_handler (Display *display, XErrorEvent *event)
static void NO_INLINE
x_error_quitter (Display *display, XErrorEvent *event)
{
- char buf[256], buf1[400 + INT_STRLEN_BOUND (int)
- + INT_STRLEN_BOUND (unsigned long)];
+ char buf[256], buf1[800 + INT_STRLEN_BOUND (int)
+ + INT_STRLEN_BOUND (unsigned long)
+ + INT_STRLEN_BOUND (XID)
+ + INT_STRLEN_BOUND (int)];
/* Ignore BadName errors. They can happen because of fonts
or colors that are not defined. */
@@ -26278,8 +26316,12 @@ x_error_quitter (Display *display, XErrorEvent *event)
XGetErrorText (display, event->error_code, buf, sizeof (buf));
sprintf (buf1, "X protocol error: %s on protocol request %d\n"
- "Serial no: %lu\n", buf, event->request_code,
- event->serial);
+ "Serial no: %lu\n"
+ "Failing resource ID (if any): 0x%lx\n"
+ "Minor code: %d\n"
+ "This is a bug! Please report this to bug-gnu-emacs@gnu.org!\n",
+ buf, event->request_code, event->serial, event->resourceid,
+ event->minor_code);
x_connection_closed (display, buf1, false);
}
@@ -28435,7 +28477,10 @@ x_make_frame_invisible (struct frame *f)
error ("Can't notify window manager of window withdrawal");
}
- XSync (FRAME_X_DISPLAY (f), False);
+ /* Don't perform the synchronization if the network connection is
+ slow, and the user says it is unwanted. */
+ if (NILP (Vx_lax_frame_positioning))
+ XSync (FRAME_X_DISPLAY (f), False);
/* We can't distinguish this from iconification
just by the event that we get from the server.
@@ -28446,8 +28491,7 @@ x_make_frame_invisible (struct frame *f)
SET_FRAME_ICONIFIED (f, false);
if (CONSP (frame_size_history))
- frame_size_history_plain
- (f, build_string ("x_make_frame_invisible"));
+ frame_size_history_plain (f, build_string ("x_make_frame_invisible"));
unblock_input ();
}
@@ -29894,13 +29938,17 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
{
char *vendor = ServerVendor (dpy);
- /* Temporarily hide the partially initialized terminal. */
+ /* Temporarily hide the partially initialized terminal.
+ Use safe_call so that if a signal happens, a partially
+ initialized display (and display connection) is not
+ kept around. */
terminal_list = terminal->next_terminal;
unblock_input ();
- kset_system_key_alist
- (terminal->kboard,
- call1 (Qvendor_specific_keysyms,
- vendor ? build_string (vendor) : empty_unibyte_string));
+ kset_system_key_alist (terminal->kboard,
+ safe_call1 (Qvendor_specific_keysyms,
+ (vendor
+ ? build_string (vendor)
+ : empty_unibyte_string)));
block_input ();
terminal->next_terminal = terminal_list;
terminal_list = terminal;
@@ -31970,6 +32018,7 @@ too slow, which is usually true when the X server is
located over a
network connection with high latency. Doing so will make frame
creation and placement faster at the cost of reducing the accuracy of
frame placement via frame parameters, `set-frame-position', and
-`set-frame-size'. */);
+`set-frame-size', along with the actual state of a frame after
+`x_make_frame_invisible'. */);
Vx_lax_frame_positioning = Qnil;
}
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/cus-edit-tests.el b/test/lisp/cus-edit-tests.el
index 0ef5168109..31ba68b410 100644
--- a/test/lisp/cus-edit-tests.el
+++ b/test/lisp/cus-edit-tests.el
@@ -83,7 +83,14 @@
(ert-deftest test-setopt ()
(should (= (setopt cus-edit-test-foo1 1) 1))
(should (= cus-edit-test-foo1 1))
- (should-error (setopt cus-edit-test-foo1 :foo)))
-
+ (let* ((text-quoting-style 'grave)
+ (warn-txt
+ (with-current-buffer (get-buffer-create "*Warnings*")
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ (setopt cus-edit-test-foo1 :foo)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (should (string-search "Value `:foo' does not match type number"
+ warn-txt))))
(provide 'cus-edit-tests)
;;; cus-edit-tests.el ends here
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-extpipe-tests.el
b/test/lisp/eshell/em-extpipe-tests.el
index 04e7827942..a2646a0296 100644
--- a/test/lisp/eshell/em-extpipe-tests.el
+++ b/test/lisp/eshell/em-extpipe-tests.el
@@ -42,7 +42,7 @@
(shell-command-switch "-c"))
;; Strip `eshell-trap-errors'.
(should (equal ,expected
- (cadr (eshell-parse-command input))))))
+ (cadadr (eshell-parse-command input))))))
(with-substitute-for-temp (&rest body)
;; Substitute name of an actual temporary file and/or
;; buffer into `input'. The substitution logic is
diff --git a/test/lisp/eshell/em-script-tests.el
b/test/lisp/eshell/em-script-tests.el
index b837d464cc..f720f697c6 100644
--- a/test/lisp/eshell/em-script-tests.el
+++ b/test/lisp/eshell/em-script-tests.el
@@ -35,21 +35,43 @@
;;; Tests:
(ert-deftest em-script-test/source-script ()
- "Test sourcing script with no argumentss"
+ "Test sourcing a simple script."
(ert-with-temp-file temp-file :text "echo hi"
(with-temp-eshell
(eshell-match-command-output (format "source %s" temp-file)
"hi\n"))))
-(ert-deftest em-script-test/source-script-arg-vars ()
- "Test sourcing script with $0, $1, ... variables"
+(ert-deftest em-script-test/source-script/redirect ()
+ "Test sourcing a script and redirecting its output."
+ (ert-with-temp-file temp-file
+ :text "echo hi\necho bye"
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "source %s > #<%s>" temp-file bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "hibye")))))
+
+(ert-deftest em-script-test/source-script/redirect/dev-null ()
+ "Test sourcing a script and redirecting its output, including to /dev/null."
+ (ert-with-temp-file temp-file
+ :text "echo hi\necho bad > /dev/null\necho bye"
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "source %s > #<%s>" temp-file bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "hibye")))))
+
+(ert-deftest em-script-test/source-script/arg-vars ()
+ "Test sourcing script with $0, $1, ... variables."
(ert-with-temp-file temp-file :text "printnl $0 \"$1 $2\""
(with-temp-eshell
(eshell-match-command-output (format "source %s one two" temp-file)
(format "%s\none two\n" temp-file)))))
-(ert-deftest em-script-test/source-script-all-args-var ()
- "Test sourcing script with the $* variable"
+(ert-deftest em-script-test/source-script/all-args-var ()
+ "Test sourcing script with the $* variable."
(ert-with-temp-file temp-file :text "printnl $*"
(with-temp-eshell
(eshell-match-command-output (format "source %s" temp-file)
diff --git a/test/lisp/eshell/em-tramp-tests.el
b/test/lisp/eshell/em-tramp-tests.el
index 6cc35ecdb1..936397d886 100644
--- a/test/lisp/eshell/em-tramp-tests.el
+++ b/test/lisp/eshell/em-tramp-tests.el
@@ -23,37 +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-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-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-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."
@@ -89,23 +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-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-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."
@@ -142,22 +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-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-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..cc40dde355 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,28 @@ 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"))
+ (let ((eshell-test-value t))
+ (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev"
+ "sey"))
+ (let ((eshell-test-value nil))
+ (eshell-command-result-equal "if $eshell-test-value {echo yes} | rev"
+ nil)))
+
+(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"))
+ (let ((eshell-test-value t))
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} {echo no} | rev"
+ "sey"))
+ (let ((eshell-test-value nil))
+ (eshell-command-result-equal
+ "if $eshell-test-value {echo yes} {echo no} | rev"
+ "on")))
+
(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 37b234eaf0..0f09afa19e 100644
--- a/test/lisp/eshell/esh-io-tests.el
+++ b/test/lisp/eshell/esh-io-tests.el
@@ -146,6 +146,45 @@
(should (equal (buffer-string) "new"))
(should (equal eshell-test-value "new")))))
+(ert-deftest esh-io-test/redirect-subcommands ()
+ "Check that redirecting subcommands applies to all subcommands."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command (format "{echo foo; echo bar} > #<%s>" bufname)))
+ (should (equal (buffer-string) "foobar"))))
+
+(ert-deftest esh-io-test/redirect-subcommands/override ()
+ "Check that redirecting subcommands applies to all subcommands.
+Include a redirect to another location in the subcommand to
+ensure only its statement is redirected."
+ (eshell-with-temp-buffer bufname "old"
+ (eshell-with-temp-buffer bufname-2 "also old"
+ (with-temp-eshell
+ (eshell-insert-command
+ (format "{echo foo; echo bar > #<%s>; echo baz} > #<%s>"
+ bufname-2 bufname)))
+ (should (equal (buffer-string) "bar")))
+ (should (equal (buffer-string) "foobaz"))))
+
+(ert-deftest esh-io-test/redirect-subcommands/dev-null ()
+ "Check that redirecting subcommands applies to all subcommands.
+Include a redirect to /dev/null to ensure it only applies to its
+statement."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command
+ (format "{echo foo; echo bar > /dev/null; echo baz} > #<%s>"
+ bufname)))
+ (should (equal (buffer-string) "foobaz"))))
+
+(ert-deftest esh-io-test/redirect-subcommands/interpolated ()
+ "Check that redirecting interpolated subcommands applies to all subcommands."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-insert-command
+ (format "echo ${echo foo; echo bar} > #<%s>" bufname)))
+ (should (equal (buffer-string) "foobar"))))
+
;; Redirecting specific handles
@@ -262,24 +301,55 @@ 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"))
+ (eshell-command-result-equal "{echo foo; echo bar} | rev"
+ "raboof"))
+
;; Virtual targets
-(ert-deftest esh-io-test/virtual-dev-eshell ()
+(ert-deftest esh-io-test/virtual/dev-null ()
+ "Check that redirecting to /dev/null works."
+ (with-temp-eshell
+ (eshell-match-command-output "echo hi > /dev/null" "\\`\\'")))
+
+(ert-deftest esh-io-test/virtual/dev-null/multiple ()
+ "Check that redirecting to /dev/null works alongside other redirections."
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "echo new > /dev/null > #<%s>" bufname) "\\`\\'"))
+ (should (equal (buffer-string) "new")))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "echo new > #<%s> > /dev/null" bufname) "\\`\\'"))
+ (should (equal (buffer-string) "new"))))
+
+(ert-deftest esh-io-test/virtual/dev-eshell ()
"Check that redirecting to /dev/eshell works."
(with-temp-eshell
(eshell-match-command-output "echo hi > /dev/eshell" "hi")))
-(ert-deftest esh-io-test/virtual-dev-kill ()
+(ert-deftest esh-io-test/virtual/dev-kill ()
"Check that redirecting to /dev/kill works."
(with-temp-eshell
(eshell-insert-command "echo one > /dev/kill")
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/gnus/mml-sec-resources/trustlist.txt
b/test/lisp/gnus/mml-sec-resources/trustlist.txt
index f886572d28..947ec52619 100644
--- a/test/lisp/gnus/mml-sec-resources/trustlist.txt
+++ b/test/lisp/gnus/mml-sec-resources/trustlist.txt
@@ -2,7 +2,7 @@
# well as empty lines are ignored. Lines have a length limit but this
# is not a serious limitation as the format of the entries is fixed and
# checked by gpg-agent. A non-comment line starts with optional white
-# space, followed by the SHA-1 fingerpint in hex, followed by a flag
+# space, followed by the SHA-1 fingerprint in hex, followed by a flag
# which may be one of 'P', 'S' or '*' and optionally followed by a list of
# other flags. The fingerprint may be prefixed with a '!' to mark the
# key as not trusted. You should give the gpg-agent a HUP or run the
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 79b2fc803d..d7f4576335 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2857,6 +2857,7 @@ This checks also `file-name-as-directory',
`file-name-directory',
This tests also `file-directory-p' and `file-accessible-directory-p'."
(skip-unless (tramp--test-enabled))
+ ;; Since Emacs 29.1, `make-directory' has defined return values.
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo/bar" tmp-name1))
@@ -2865,7 +2866,9 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(unwind-protect
(progn
(with-file-modes unusual-file-mode-1
- (make-directory tmp-name1))
+ (if (tramp--test-emacs29-p)
+ (should-not (make-directory tmp-name1))
+ (make-directory tmp-name1)))
(should-error
(make-directory tmp-name1)
:type 'file-already-exists)
@@ -2878,15 +2881,19 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(make-directory tmp-name2)
:type 'file-error)
(with-file-modes unusual-file-mode-2
- (make-directory tmp-name2 'parents))
+ (if (tramp--test-emacs29-p)
+ (should-not (make-directory tmp-name2 'parents))
+ (make-directory tmp-name2 'parents)))
(should (file-directory-p tmp-name2))
(should (file-accessible-directory-p tmp-name2))
(when (tramp--test-supports-set-file-modes-p)
(should (equal (format "%#o" unusual-file-mode-2)
(format "%#o" (file-modes tmp-name2)))))
;; If PARENTS is non-nil, `make-directory' shall not
- ;; signal an error when DIR exists already.
- (make-directory tmp-name2 'parents))
+ ;; signal an error when DIR exists already. It returns t.
+ (if (tramp--test-emacs29-p)
+ (should (make-directory tmp-name2 'parents))
+ (make-directory tmp-name2 'parents)))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
diff --git
a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
index fa328438cb..6d3f478595 100644
--- a/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/fontify-punctuation-vars.pl
@@ -1,4 +1,4 @@
-# The following Perl punctiation variables contain characters which
+# The following Perl punctuation variables contain characters which
# are classified as string delimiters in the syntax table. The mode
# should not be confused by these.
# The corresponding tests check that two consecutive '#' characters
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 1bb206e704..96615c1938 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -114,7 +114,7 @@ end of the statement."
;;; Fontification tests
(ert-deftest cperl-test-fontify-punct-vars ()
- "Test fontification of Perl's punctiation variables.
+ "Test fontification of Perl's punctuation variables.
Perl has variable names containing unbalanced quotes for the list
separator $\" and pre- and postmatch $` and $'. A reference to
these variables, for example \\$\", should not cause the dollar
diff --git
a/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb
new file mode 100644
index 0000000000..2b66579739
--- /dev/null
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-method-params-indent.rb
@@ -0,0 +1,18 @@
+class C
+ def self.foo(
+ baz,
+ bar
+ ) =
+ what
+
+ def foo=(
+ baz,
+ bar
+ )
+ hello
+ end
+end
+
+# Local Variables:
+# ruby-method-params-indent: 0
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 2451edaee2..6a69d9db78 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -538,3 +538,7 @@ class Bar
baz
end
end
+
+# Local Variables:
+# ruby-method-params-indent: t
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 9be01dc78f..560f780285 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -943,16 +943,20 @@ VALUES-PLIST is a list with alternating index and value
elements."
"Blub#bye"
"Blub#hiding")))))
-(ert-deftest ruby--indent/converted-from-manual-test ()
- :tags '(:expensive-test)
- ;; Converted from manual test.
- (let ((buf (find-file-noselect (ert-resource-file "ruby.rb"))))
- (unwind-protect
- (with-current-buffer buf
- (let ((orig (buffer-string)))
- (indent-region (point-min) (point-max))
- (should (equal (buffer-string) orig))))
- (kill-buffer buf))))
+(defmacro ruby-deftest-indent (file)
+ `(ert-deftest ,(intern (format "ruby-indent-test/%s" file)) ()
+ ;; :tags '(:expensive-test)
+ (let ((buf (find-file-noselect (ert-resource-file ,file))))
+ (unwind-protect
+ (with-current-buffer buf
+ (let ((orig (buffer-string)))
+ ;; Indent and check that we get the original text.
+ (indent-region (point-min) (point-max))
+ (should (equal (buffer-string) orig))))
+ (kill-buffer buf)))))
+
+(ruby-deftest-indent "ruby.rb")
+(ruby-deftest-indent "ruby-method-params-indent.rb")
(ert-deftest ruby--test-chained-indentation ()
(with-temp-buffer
diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el
index 1382d00359..06c6f748a2 100644
--- a/test/lisp/repeat-tests.el
+++ b/test/lisp/repeat-tests.el
@@ -76,27 +76,27 @@
"C-x w a b a c"
'((1 a) (1 b) (1 a)) "c")
(repeat-tests--check
- "M-C-a b a c"
+ "C-M-a b a c"
'((1 a) (1 b) (1 a)) "c")
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a)) "bac")
(unwind-protect
(progn
(put 'repeat-tests-call-a 'repeat-check-key 'no)
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a) (1 b) (1 a)) "c"))
(put 'repeat-tests-call-a 'repeat-check-key nil)))
(let ((repeat-check-key nil))
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a) (1 b) (1 a)) "c")
(unwind-protect
(progn
(put 'repeat-tests-call-a 'repeat-check-key t)
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a)) "bac"))
(put 'repeat-tests-call-a 'repeat-check-key nil))))))
@@ -125,15 +125,17 @@
(repeat-tests--check
"C-2 C-x w a C-3 c"
'((2 a)) "ccc"))
- ;; TODO: fix and uncomment
- ;; (let ((repeat-keep-prefix t))
- ;; (repeat-tests--check
- ;; "C-2 C-x w a b a b c"
- ;; '((2 a) (2 b) (2 a) (2 b)) "c")
- ;; (repeat-tests--check
- ;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c"
- ;; '((2 a) (12 b) (12 a) (34 b)) "c"))
- )))
+ ;; Fixed in bug#51281 and bug#55986
+ (let ((repeat-keep-prefix t))
+ ;; Re-enable to take effect.
+ (repeat-mode -1) (repeat-mode +1)
+ (repeat-tests--check
+ "C-2 C-x w a b a b c"
+ '((2 a) (2 b) (2 a) (2 b)) "c")
+ ;; (repeat-tests--check
+ ;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c"
+ ;; '((2 a) (12 b) (12 a) (34 b)) "c")
+ ))))
;; TODO: :tags '(:expensive-test) for repeat-exit-timeout
diff --git a/test/lisp/url/url-future-tests.el
b/test/lisp/url/url-future-tests.el
index 5083fc5aba..ec1796f767 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -52,7 +52,7 @@
(should (equal (url-future-cancel tocancel) tocancel))
(should-error (url-future-call tocancel))
(should (null url-future-tests--saver))
- (should (url-future-cancelled-p tocancel))))
+ (should (url-future-canceled-p tocancel))))
(provide 'url-future-tests)
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 fb53543c9e..d72748cd0c 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -327,6 +327,84 @@ buffer's content."
"«:whitespace-empty:\n"
"»")))))
+(ert-deftest whitespace-tests--empty-bob-eob-modified ()
+ "Regression test for Bug#60066."
+ (whitespace-tests--with-test-buffer '()
+ (insert "\nx\n\n")
+ (goto-char 2)
+ (set-buffer-modified-p nil)
+ (let ((whitespace-style '(face empty)))
+ (whitespace-mode 1)
+ (should (not (buffer-modified-p))))))
+
+(ert-deftest whitespace-tests--indirect-clone-breaks-base-markers ()
+ "Specific regression test for Bug#59618."
+ (whitespace-tests--with-test-buffer '(face empty)
+ (insert "\nx\n\n")
+ (let ((base (current-buffer))
+ ;; `unwind-protect' is not used to clean up `indirect'
+ ;; because the buffer should only be killed on success.
+ (indirect (clone-indirect-buffer (buffer-name) nil)))
+ (should (eq (marker-buffer whitespace-bob-marker) base))
+ (should (eq (marker-buffer whitespace-eob-marker) base))
+ (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
+ ;; buffer's markers to point inside the indirect buffer because
+ ;; the indirect buffer erroneously shared marker objects with
+ ;; the base buffer. Killing the indirect buffer would then
+ ;; invalidate those markers (make them point nowhere).
+ (kill-buffer indirect)
+ (should (eq (marker-buffer whitespace-bob-marker) base))
+ (should (eq (marker-buffer whitespace-eob-marker) base)))))
+
+(defun whitespace-tests--check-markers (buf bpos epos)
+ (with-current-buffer buf
+ (should (eq (marker-buffer whitespace-bob-marker) buf))
+ (should (eq (marker-position whitespace-bob-marker) bpos))
+ (should (eq (marker-buffer whitespace-eob-marker) buf))
+ (should (eq (marker-position whitespace-eob-marker) epos))))
+
+(ert-deftest whitespace-tests--indirect-clone-markers ()
+ "Test `whitespace--clone' on indirect clones."
+ (whitespace-tests--with-test-buffer '(face empty)
+ (insert "\nx\n\n")
+ (let ((base (current-buffer))
+ ;; `unwind-protect' is not used to clean up `indirect'
+ ;; because the buffer should only be killed on success.
+ (indirect (clone-indirect-buffer nil nil)))
+ (whitespace-tests--check-markers base 2 4)
+ (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'.
+ (execute-kbd-macro (kbd "z RET M-< a"))
+ (whitespace-tests--check-markers indirect 1 8))
+ (kill-buffer indirect)
+ ;; When the buffer was modified above, the new "a" character at
+ ;; the beginning moved the base buffer's markers by one. Emacs
+ ;; did not run the base buffer's `after-change-functions' after
+ ;; the indirect buffer was edited (Bug#46982), so the end result
+ ;; is just the shift by one.
+ (whitespace-tests--check-markers base 3 5))))
+
+(ert-deftest whitespace-tests--regular-clone-markers ()
+ "Test `whitespace--clone' on regular clones."
+ (whitespace-tests--with-test-buffer '(face empty)
+ (insert "\nx\n\n")
+ (let ((orig (current-buffer))
+ ;; `unwind-protect' is not used to clean up `clone' because
+ ;; the buffer should only be killed on success.
+ (clone (clone-buffer)))
+ (whitespace-tests--check-markers orig 2 4)
+ (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))
+ (kill-buffer clone)
+ (whitespace-tests--check-markers orig 2 4))))
+
(provide 'whitespace-tests)
;;; whitespace-tests.el ends here
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))