[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/comp-static-data 12a62f4713c 1/2: Merge branch 'master' into scr
|
From: |
Vibhav Pant |
|
Subject: |
scratch/comp-static-data 12a62f4713c 1/2: Merge branch 'master' into scratch/comp-static-data |
|
Date: |
Fri, 27 Jan 2023 16:06:39 -0500 (EST) |
branch: scratch/comp-static-data
commit 12a62f4713ca67fcc9354c9d99e9eb5ecdef0b6f
Merge: b67b328d6ab 18fbcce9757
Author: Vibhav Pant <vibhavp@gmail.com>
Commit: Vibhav Pant <vibhavp@gmail.com>
Merge branch 'master' into scratch/comp-static-data
---
admin/notes/tree-sitter/build-module/build.sh | 17 +-
build-aux/update-copyright | 4 +-
configure.ac | 7 +-
doc/emacs/custom.texi | 49 +-
doc/emacs/files.texi | 5 +
doc/emacs/maintaining.texi | 9 +-
doc/emacs/mini.texi | 10 +-
doc/emacs/misc.texi | 177 ++++---
doc/emacs/modes.texi | 18 +-
doc/emacs/programs.texi | 61 +++
doc/emacs/text.texi | 28 +-
doc/lispref/files.texi | 11 +-
doc/lispref/functions.texi | 14 +
doc/lispref/help.texi | 18 +-
doc/lispref/keymaps.texi | 18 +-
doc/lispref/minibuf.texi | 12 +-
doc/lispref/modes.texi | 22 +-
doc/lispref/os.texi | 10 +
doc/lispref/parsing.texi | 73 ++-
doc/lispref/positions.texi | 34 ++
doc/lispref/strings.texi | 4 +-
doc/lispref/symbols.texi | 17 +
doc/misc/eglot.texi | 2 +-
doc/misc/erc.texi | 47 +-
doc/misc/eshell.texi | 144 ++++--
doc/misc/eww.texi | 7 +-
doc/misc/gnus.texi | 11 -
doc/misc/htmlfontify.texi | 13 +-
doc/misc/newsticker.texi | 9 +-
doc/misc/org.org | 15 +-
doc/misc/tramp.texi | 7 +-
etc/NEWS | 94 +++-
etc/NEWS.29 | 252 +++++----
etc/PROBLEMS | 12 +
etc/refcards/orgcard.tex | 2 +-
lib-src/Makefile.in | 13 +-
lib/filename.h | 2 +-
lib/gnulib.mk.in | 9 +-
lib/malloc/scratch_buffer.h | 2 +-
lib/malloc/scratch_buffer_grow.c | 2 +-
lib/malloc/scratch_buffer_grow_preserve.c | 2 +-
lib/malloc/scratch_buffer_set_array_size.c | 2 +-
lib/mktime-internal.h | 2 +-
lib/mktime.c | 2 +-
lib/qcopy-acl.c | 36 +-
lib/regex.c | 2 +-
lib/regex.h | 2 +-
lib/timegm.c | 2 +-
lib/verify.h | 8 +-
lisp/align.el | 3 +-
lisp/apropos.el | 266 +++++-----
lisp/calendar/appt.el | 2 +-
lisp/calendar/diary-lib.el | 5 +-
lisp/char-fold.el | 18 +-
lisp/cus-start.el | 1 +
lisp/dired.el | 2 +-
lisp/doc-view.el | 2 +-
lisp/emacs-lisp/advice.el | 2 +-
lisp/emacs-lisp/byte-opt.el | 3 +
lisp/emacs-lisp/bytecomp.el | 14 +-
lisp/emacs-lisp/cl-macs.el | 2 +-
lisp/emacs-lisp/comp.el | 32 +-
lisp/emacs-lisp/ert-x.el | 2 +-
lisp/emacs-lisp/macroexp.el | 13 +-
lisp/emacs-lisp/package-vc.el | 8 +-
lisp/emacs-lisp/pp.el | 12 +-
lisp/emacs-lisp/warnings.el | 8 +-
lisp/erc/erc-common.el | 13 +-
lisp/erc/erc-compat.el | 4 +-
lisp/erc/erc-networks.el | 6 +
lisp/erc/erc-track.el | 12 +-
lisp/erc/erc.el | 35 +-
lisp/eshell/em-basic.el | 3 +-
lisp/eshell/em-cmpl.el | 2 +-
lisp/eshell/em-elecslash.el | 2 +-
lisp/eshell/em-hist.el | 6 +-
lisp/eshell/em-prompt.el | 119 +++--
lisp/eshell/em-rebind.el | 6 +-
lisp/eshell/esh-arg.el | 5 +-
lisp/eshell/esh-io.el | 6 +-
lisp/eshell/esh-mode.el | 58 ++-
lisp/eshell/esh-proc.el | 31 +-
lisp/eshell/esh-var.el | 22 +-
lisp/files.el | 55 +-
lisp/find-dired.el | 6 +-
lisp/font-lock.el | 9 +-
lisp/frame.el | 2 +-
lisp/htmlfontify.el | 24 +-
lisp/icomplete.el | 4 +-
lisp/international/mule.el | 7 +-
lisp/keymap.el | 15 +-
lisp/ldefs-boot.el | 79 ++-
lisp/ls-lisp.el | 18 +-
lisp/mail/rmail.el | 18 +-
lisp/mh-e/mh-e.el | 5 +-
lisp/minibuffer.el | 2 +-
lisp/net/ange-ftp.el | 10 +-
lisp/net/eww.el | 11 +-
lisp/net/newst-ticker.el | 69 ++-
lisp/net/rcirc.el | 3 +-
lisp/net/tramp-adb.el | 22 +-
lisp/net/tramp-archive.el | 10 +-
lisp/net/tramp-cmds.el | 2 +-
lisp/net/tramp-compat.el | 70 ++-
lisp/net/tramp-crypt.el | 9 +-
lisp/net/tramp-fuse.el | 8 +-
lisp/net/tramp-gvfs.el | 41 +-
lisp/net/tramp-rclone.el | 3 +-
lisp/net/tramp-sh.el | 198 +++----
lisp/net/tramp-smb.el | 130 ++---
lisp/net/tramp-sshfs.el | 1 +
lisp/net/tramp-sudoedit.el | 100 +---
lisp/net/tramp.el | 250 ++++++---
lisp/org/ob-core.el | 16 +-
lisp/org/ob-ruby.el | 5 +-
lisp/org/ob-shell.el | 2 +-
lisp/org/org-agenda.el | 17 +-
lisp/org/org-clock.el | 30 +-
lisp/org/org-element.el | 4 +-
lisp/org/org-fold-core.el | 21 +-
lisp/org/org-macs.el | 11 +-
lisp/org/org-mouse.el | 4 +-
lisp/org/org-persist.el | 7 +-
lisp/org/org-table.el | 11 +-
lisp/org/org-version.el | 4 +-
lisp/org/org.el | 26 +-
lisp/org/ox-odt.el | 2 +-
lisp/org/ox.el | 5 +-
lisp/outline.el | 55 +-
lisp/pcomplete.el | 29 +-
lisp/proced.el | 104 ++--
lisp/progmodes/c-ts-common.el | 247 +++++++++
lisp/progmodes/c-ts-mode.el | 576 +++++++++++++--------
lisp/progmodes/cc-defs.el | 22 +
lisp/progmodes/cc-engine.el | 388 +++++++++-----
lisp/progmodes/cc-fonts.el | 70 ++-
lisp/progmodes/cc-mode.el | 40 +-
lisp/progmodes/cc-vars.el | 3 +-
lisp/progmodes/cmake-ts-mode.el | 8 +-
lisp/progmodes/csharp-mode.el | 20 +-
lisp/progmodes/dockerfile-ts-mode.el | 16 +-
lisp/progmodes/eglot.el | 33 +-
lisp/progmodes/go-ts-mode.el | 156 ++++--
lisp/progmodes/gud.el | 5 +-
lisp/progmodes/hideif.el | 374 +++++++++----
lisp/progmodes/java-ts-mode.el | 59 ++-
lisp/progmodes/js.el | 88 +++-
lisp/progmodes/json-ts-mode.el | 6 +
lisp/progmodes/project.el | 15 +-
lisp/progmodes/python.el | 41 +-
lisp/progmodes/ruby-mode.el | 180 ++++---
lisp/progmodes/ruby-ts-mode.el | 299 +++++++----
lisp/progmodes/rust-ts-mode.el | 14 +-
lisp/progmodes/typescript-ts-mode.el | 140 +++--
lisp/progmodes/xref.el | 5 +-
lisp/replace.el | 6 +-
lisp/reveal.el | 18 +-
lisp/simple.el | 170 ++++--
lisp/sqlite-mode.el | 4 +
lisp/startup.el | 2 +-
lisp/subr.el | 21 +-
lisp/textmodes/css-mode.el | 4 +-
lisp/textmodes/html-ts-mode.el | 134 +++++
lisp/textmodes/paragraphs.el | 15 +-
lisp/textmodes/reftex-cite.el | 2 +-
lisp/textmodes/toml-ts-mode.el | 5 +-
lisp/textmodes/yaml-ts-mode.el | 6 +-
lisp/treesit.el | 237 ++++++---
lisp/use-package/use-package-core.el | 2 +-
lisp/use-package/use-package.el | 2 +-
lisp/vc/diff-mode.el | 14 +-
lisp/vc/vc-bzr.el | 4 +-
lisp/vc/vc-dir.el | 8 +-
lisp/vc/vc-dispatcher.el | 10 +-
lisp/vc/vc-git.el | 20 +-
lisp/vc/vc.el | 20 +-
lisp/window.el | 18 +-
lisp/woman.el | 60 +--
lisp/xt-mouse.el | 22 +-
lwlib/Makefile.in | 2 +-
m4/acl.m4 | 8 +-
m4/assert_h.m4 | 4 +-
m4/clock_time.m4 | 15 +-
m4/euidaccess.m4 | 11 +-
m4/getrandom.m4 | 11 +-
m4/gettime.m4 | 31 +-
m4/gnulib-common.m4 | 2 +-
m4/gnulib-comp.m4 | 9 +
m4/nanosleep.m4 | 12 +-
m4/pthread_sigmask.m4 | 15 +-
m4/timer_time.m4 | 15 +-
m4/utimens.m4 | 6 +-
m4/xattr.m4 | 53 ++
msdos/autogen/Makefile.in | 6 +-
msdos/sed1v2.inp | 8 +-
msdos/sed3v2.inp | 5 +-
msdos/sedlibmk.inp | 3 +-
src/Makefile.in | 13 +-
src/buffer.c | 10 +-
src/callint.c | 12 +-
src/ccl.c | 2 +-
src/coding.c | 8 +-
src/doc.c | 34 +-
src/fns.c | 25 +-
src/gnutls.c | 4 +
src/insdel.c | 17 +-
src/keyboard.c | 2 +-
src/pgtkfns.c | 2 +-
src/pgtkterm.c | 3 +-
src/print.c | 9 +-
src/regex-emacs.c | 2 +-
src/treesit.c | 228 +++++---
src/treesit.h | 1 +
src/w32.c | 45 +-
src/w32fns.c | 44 +-
src/w32heap.c | 4 +-
src/xfaces.c | 2 +-
src/xterm.c | 190 ++++++-
src/xterm.h | 17 +
test/Makefile.in | 6 +-
test/lisp/erc/erc-scenarios-base-association.el | 49 ++
.../erc-scenarios-base-compat-rename-bouncer.el | 4 +-
test/lisp/erc/erc-scenarios-base-local-modules.el | 105 +++-
test/lisp/erc/erc-scenarios-base-netid-samenet.el | 4 +-
.../erc/erc-scenarios-base-upstream-recon-soju.el | 7 +-
.../erc/erc-scenarios-base-upstream-recon-znc.el | 7 +-
test/lisp/erc/erc-services-tests.el | 9 +-
test/lisp/erc/erc-tests.el | 41 +-
.../resources/base/netid/bouncer/barnet-again.eld | 10 +-
.../resources/base/netid/bouncer/foonet-again.eld | 10 +-
test/lisp/erc/resources/erc-d/erc-d-t.el | 2 +-
.../erc/resources/networks/merge-server/track.eld | 44 ++
test/lisp/eshell/em-prompt-tests.el | 120 +++++
test/lisp/eshell/esh-proc-tests.el | 13 +
test/lisp/eshell/esh-var-tests.el | 165 +++---
test/lisp/eshell/eshell-tests.el | 15 +-
test/lisp/international/mule-tests.el | 66 +++
test/lisp/net/tramp-archive-tests.el | 20 +-
test/lisp/net/tramp-tests.el | 220 +++++---
test/lisp/proced-tests.el | 17 +
.../progmodes/c-ts-mode-resources/filling.erts | 198 +++++++
.../progmodes/c-ts-mode-resources/indent-bsd.erts | 93 ++++
.../lisp/progmodes/c-ts-mode-resources/indent.erts | 242 +++++++++
test/lisp/progmodes/c-ts-mode-tests.el | 39 ++
.../progmodes/java-ts-mode-resources/indent.erts | 44 ++
.../progmodes/java-ts-mode-resources/movement.erts | 154 ++++++
test/lisp/progmodes/java-ts-mode-tests.el | 35 ++
test/lisp/progmodes/python-tests.el | 10 +
.../ruby-mode-resources/ruby-method-call-indent.rb | 9 +
test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb | 94 ++++
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 2 +-
test/lisp/progmodes/ruby-ts-mode-tests.el | 17 +
.../typescript-ts-mode-resources/indent.erts | 73 +++
test/lisp/progmodes/typescript-ts-mode-tests.el | 31 ++
test/manual/indent/octave.m | 2 +-
test/src/buffer-tests.el | 46 +-
test/src/coding-tests.el | 30 +-
test/src/keymap-tests.el | 33 ++
test/src/undo-tests.el | 72 +++
259 files changed, 7402 insertions(+), 2833 deletions(-)
diff --git a/admin/notes/tree-sitter/build-module/build.sh
b/admin/notes/tree-sitter/build-module/build.sh
index f0962940287..9dc674237ca 100755
--- a/admin/notes/tree-sitter/build-module/build.sh
+++ b/admin/notes/tree-sitter/build-module/build.sh
@@ -3,12 +3,17 @@
lang=$1
topdir="$PWD"
-if [ $(uname) == "Darwin" ]
-then
- soext="dylib"
-else
- soext="so"
-fi
+case $(uname) in
+ "Darwin")
+ soext="dylib"
+ ;;
+ *"MINGW"*)
+ soext="dll"
+ ;;
+ *)
+ soext="so"
+ ;;
+esac
echo "Building ${lang}"
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index ce919bac727..99196fceef6 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -137,7 +137,7 @@
eval 'exec perl -wSx -0777 -pi "$0" "$@"'
if 0;
-my $VERSION = '2020-04-04.15:07'; # UTC
+my $VERSION = '2023-01-11.04:24'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
@@ -280,7 +280,7 @@ if (defined $stmt_re)
}
# Replace the old copyright statement.
- s/$stmt_re/$stmt_wrapped/;
+ s/$stmt_re/$stmt_wrapped/g;
}
}
else
diff --git a/configure.ac b/configure.ac
index 7833ed3e464..fc17dbd8318 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1139,6 +1139,7 @@ AS_IF([test $gl_gcc_warnings = no],
# clang is unduly picky about some things.
if test "$emacs_cv_clang" = yes; then
+ gl_WARN_ADD([-Wno-bitwise-instead-of-logical])
gl_WARN_ADD([-Wno-missing-braces])
gl_WARN_ADD([-Wno-null-pointer-arithmetic])
gl_WARN_ADD([-Wno-implicit-const-int-float-conversion])
@@ -6361,7 +6362,7 @@ fi
# it temporarily reverts them to their pre-pkg-config values,
# because gnulib needs to work with both src (which uses the
# pkg-config stuff) and lib-src (which does not). For example, gnulib
-# may need to determine whether LIB_CLOCK_GETTIME should contain -lrt,
+# may need to determine whether CLOCK_TIME_LIB should contain -lrt,
# and it therefore needs to run in an environment where LIBS does not
# already contain -lrt merely because 'pkg-config --libs' printed '-lrt'
# for some package unrelated to lib-src.
@@ -6553,7 +6554,9 @@ if test "${HAVE_GTK}" = "yes"; then
fi
if test $USE_ACL -ne 0; then
- ACL_SUMMARY="yes $LIB_ACL"
+ ACL_SUMMARY="yes"
+ test "$LIB_ACL" && ACL_SUMMARY="$ACL_SUMMARY $LIB_ACL"
+ test "$LIB_XATTR" && ACL_SUMMARY="$ACL_SUMMARY $LIB_XATTR"
else
ACL_SUMMARY=no
fi
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 91df15a21d7..ee818a74b57 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -1887,23 +1887,31 @@ command is less work to invoke when you really want to.
you can specify them in your initialization file by writing Lisp code.
@xref{Init File}, for a description of the initialization file.
-@findex kbd
- There are several ways to write a key binding using Lisp. The
-simplest is to use the @code{kbd} function, which converts a textual
-representation of a key sequence---similar to how we have written key
-sequences in this manual---into a form that can be passed as an
-argument to @code{keymap-global-set}. For example, here's how to bind
-@kbd{C-z} to the @code{shell} command (@pxref{Interactive Shell}):
+@findex keymap-global-set
+ The recommended way to write a key binding using Lisp is to use
+either the @code{keymap-global-set} or the @code{keymap-set}
+functions. For example, here's how to bind @kbd{C-z} to the
+@code{shell} command in the global keymap (@pxref{Interactive Shell}):
@example
(keymap-global-set "C-z" 'shell)
@end example
+@cindex key sequence syntax
@noindent
-The single-quote before the command name, @code{shell}, marks it as a
+The first argument to @code{keymap-global-set} describes the key
+sequence. It is a string made of a series of characters separated
+by spaces, with each character corresponding to a key. Keys with
+modifiers can be specified by prepending the modifier, such as
+@samp{C-} for Control, or @samp{M-} for Meta. Special keys, such as
+@key{TAB} and @key{RET}, can be specified within angle brackets as in
+@kbd{@key{TAB}} and @kbd{@key{RET}}.
+
+ The single-quote before the command name that is being bound to the
+key sequence, @code{shell} in the above example, marks it as a
constant symbol rather than a variable. If you omit the quote, Emacs
-would try to evaluate @code{shell} as a variable. This probably
-causes an error; it certainly isn't what you want.
+would try to evaluate @code{shell} as a variable. This will probably
+cause an error; it certainly isn't what you want.
Here are some additional examples, including binding function keys
and mouse events:
@@ -1920,6 +1928,27 @@ and mouse events:
Language and coding systems may cause problems with key bindings for
non-@acronym{ASCII} characters. @xref{Init Non-ASCII}.
+@findex global-set-key
+@findex define-key
+ Alternatively, you can use the low level functions @code{define-key}
+and @code{global-set-key}. For example, to bind @kbd{C-z} to the
+@code{shell} command, as in the above example, using these low-level
+functions, use:
+
+@example
+(global-set-key (kbd "C-z") 'shell)
+@end example
+
+@findex kbd
+@noindent
+There are various ways to specify the key sequence but the simplest is
+to use the function @code{kbd} as shown in the example above.
+@code{kbd} takes a single string argument that is a textual
+representation of a key sequence, and converts it into a form suitable
+for low-level functions such as @code{global-set-key}. For more
+details about binding keys using Lisp, @pxref{Keymaps,,, elisp, The
+Emacs Lisp Reference Manual}.
+
@findex keymap-set
@findex keymap-unset
As described in @ref{Local Keymaps}, major modes and minor modes can
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 6a9103d3a09..42e252c417b 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -1888,6 +1888,11 @@ following in the Trash directory:
liable to also delete this @code{.dir-locals.el} file, so this should
only be done if you delete files from the Trash directory manually.
+@vindex remote-file-name-inhibit-delete-by-moving-to-trash
+ If the variable @code{remote-file-name-inhibit-delete-by-moving-to-trash}
+is non-@code{nil}, remote files are never moved to the Trash. They
+are deleted instead.
+
@ifnottex
If a file is under version control (@pxref{Version Control}), you
should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 8c77ded55d3..5191bb2918d 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1331,11 +1331,18 @@ point is on a directory entry, mark all files in that
directory tree
listed files and directories.
@findex vc-dir-mark-by-regexp
-@item %
+@item % m
+@itemx * %
You can use this command to mark files by regexp
(@code{vc-dir-mark-by-regexp}). If given a prefix, unmark files
instead.
+@findex vc-dir-mark-registered-files
+@item * r
+You can use this command to mark files that are in one of registered
+states, including edited, added or removed.
+(@code{vc-dir-mark-registered-files}).
+
@item G
Add the file under point to the list of files that the VC should
ignore (@code{vc-dir-ignore}). For instance, if the VC is Git, it
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 6fb312ec321..898d9e904f6 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -953,12 +953,14 @@ File ‘foo.el’ exists; overwrite? (y or n)
@end smallexample
@cindex yes or no prompt
+@vindex yes-or-no-prompt
The second type of yes-or-no query is typically employed if giving
the wrong answer would have serious consequences; it thus features a
-longer prompt ending with @samp{(yes or no)}. For example, if you
-invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer with
-unsaved changes, Emacs activates the minibuffer with a prompt like
-this:
+longer prompt ending with @samp{(yes or no)} (or the value of
+@code{yes-or-no-prompt} if you've customized that). For example, if
+you invoke @kbd{C-x k} (@code{kill-buffer}) on a file-visiting buffer
+with unsaved changes, Emacs activates the minibuffer with a prompt
+like this:
@smallexample
Buffer foo.el modified; kill anyway? (yes or no)
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index c706b727e6f..88d4188d144 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2702,40 +2702,16 @@ when point is on the first byte of a multibyte sequence
in the file.
@cindex restore session
@cindex remember editing session
@cindex reload files
-@cindex desktop
-@vindex desktop-restore-frames
- Use the desktop library to save the state of Emacs from one session
-to another. Once you save the Emacs @dfn{desktop}---the buffers,
-their file names, major modes, buffer positions, and so on---then
-subsequent Emacs sessions reload the saved desktop. By default,
-the desktop also tries to save the frame and window configuration.
-To disable this, set @code{desktop-restore-frames} to @code{nil}.
-(See that variable's documentation for some related options
-that you can customize to fine-tune this behavior.)
-
-@vindex desktop-files-not-to-save
-Information about buffers visiting remote files is not saved by
-default. Customize the variable @code{desktop-files-not-to-save} to
-change this.
-
-@vindex frameset-filter-alist
- When the desktop restores the frame and window configuration, it
-uses the recorded values of frame parameters, disregarding any
-settings for those parameters you have in your init file (@pxref{Init
-File}). This means that frame parameters such as fonts and faces for
-the restored frames will come from the desktop file, where they were
-saved when you exited your previous Emacs session; any settings for
-those parameters in your init file will be ignored. To disable this,
-customize the value of @code{frameset-filter-alist} to filter out the
-frame parameters you don't want to be restored.
+@cindex desktop configuration
+ You can use the desktop library to save the state of Emacs from one
+session to another. The saved Emacs @dfn{desktop configuration}
+includes the buffers, their file names, major modes, buffer positions,
+window and frame configuration, and some important global variables.
-@findex desktop-save
@vindex desktop-save-mode
- You can save the desktop manually with the command @kbd{M-x
-desktop-save}. You can also enable automatic saving of the desktop
-when you exit Emacs, and automatic restoration of the last saved
-desktop when Emacs starts: use the Customization buffer (@pxref{Easy
+@findex desktop-save-mode
+ To enable this feature, use the Customization buffer (@pxref{Easy
Customization}) to set @code{desktop-save-mode} to @code{t} for future
sessions, or add this line in your init file (@pxref{Init File}):
@@ -2743,51 +2719,34 @@ sessions, or add this line in your init file
(@pxref{Init File}):
(desktop-save-mode 1)
@end example
-@findex desktop-change-dir
-@findex desktop-revert
@vindex desktop-path
+@vindex desktop-auto-save-timeout
If you turn on @code{desktop-save-mode} in your init file, then when
-Emacs starts, it looks for a saved desktop in the current directory.
-(More precisely, it looks in the directories specified by
-@code{desktop-path}, and uses the first desktop it finds.)
-Thus, you can have separate saved desktops in different directories,
-and the starting directory determines which one Emacs reloads. You
-can save the current desktop and reload one saved in another directory
-by typing @kbd{M-x desktop-change-dir}. Typing @kbd{M-x
-desktop-revert} reverts to the desktop previously reloaded.
-
- Specify the option @samp{--no-desktop} on the command line when you
-don't want it to reload any saved desktop. This turns off
-@code{desktop-save-mode} for the current session. Starting Emacs with
-the @samp{--no-init-file} option also disables desktop reloading,
-since it bypasses the init file, where @code{desktop-save-mode} is
-usually turned on.
-
-@vindex desktop-restore-eager
- By default, all the buffers in the desktop are restored in one go.
-However, this may be slow if there are a lot of buffers in the
-desktop. You can specify the maximum number of buffers to restore
-immediately with the variable @code{desktop-restore-eager}; the
-remaining buffers are restored lazily, when Emacs is idle.
-
-@findex desktop-clear
-@vindex desktop-globals-to-clear
-@vindex desktop-clear-preserve-buffers-regexp
- Type @kbd{M-x desktop-clear} to empty the Emacs desktop. This kills
-all buffers except for internal ones, and clears the global variables
-listed in @code{desktop-globals-to-clear}. If you want this to
-preserve certain buffers, customize the variable
-@code{desktop-clear-preserve-buffers-regexp}, whose value is a regular
-expression matching the names of buffers not to kill.
+Emacs starts, it looks for a saved desktop in @code{desktop-path}
+(which defaults to @code{user-emacs-directory} and then your home
+directory) and uses the first desktop it finds. While Emacs runs with
+@code{desktop-save-mode} turned on, it by default auto-saves the
+desktop whenever any of the desktop configuration changes. The
+variable @code{desktop-auto-save-timeout} determines how frequently
+Emacs checks for modifications to your desktop. The desktop is also
+saved when you exit Emacs.
- If you want to save minibuffer history from one session to
-another, use the @code{savehist} library.
+@cindex disable restoring of desktop configuration
+ Specify the option @samp{--no-desktop} on the Emacs command line
+when you don't want it to reload any saved desktop configurations.
+This turns off @code{desktop-save-mode} for the current session.
+Starting Emacs with the @samp{--no-init-file} option also disables
+desktop reloading, since it bypasses the init file, where
+@code{desktop-save-mode} is usually turned on.
-@vindex desktop-auto-save-timeout
- While Emacs runs with @code{desktop-save-mode} turned on, it by
-default auto-saves the desktop whenever any of it changes. The
-variable @code{desktop-auto-save-timeout} determines how frequently
-Emacs checks for modifications to your desktop.
+@findex desktop-change-dir
+@findex desktop-revert
+ You can have separate saved desktop configurations in different
+directories; starting Emacs from a directory where you have a saved
+desktop configuration will restore that configuration. You can save
+the current desktop and reload the one saved in another directory by
+typing @kbd{M-x desktop-change-dir}. Typing @kbd{M-x desktop-revert}
+reverts to the previously reloaded desktop.
@vindex desktop-load-locked-desktop
The file in which Emacs saves the desktop is locked while the
@@ -2798,12 +2757,13 @@ will by default ask you whether to use the locked
desktop file. You
can avoid the question by customizing the variable
@code{desktop-load-locked-desktop} to either @code{nil}, which means
never load the desktop in this case, or @code{t}, which means load the
-desktop without asking. Finally, the @code{check-pid} value means to
-load the file if the Emacs process that has locked the desktop is not
-running on the local machine. This should not be used in
-circumstances where the locking Emacs might still be running on
-another machine. This could be the case in multi-user environments
-where your home directory is mounted remotely using NFS or similar.
+desktop without asking. You can also customize the variable to the
+special value @code{check-pid}, which means to load the file if the
+Emacs process that has locked the desktop is not running on the local
+machine. This should not be used in circumstances where the locking
+Emacs might still be running on another machine, which could be the
+case in multi-user environments where your home directory is mounted
+remotely using NFS or similar.
@cindex desktop restore in daemon mode
When Emacs starts in daemon mode, it cannot ask you any questions,
@@ -2813,10 +2773,67 @@ the desktop in daemon mode is somewhat problematic for
other reasons:
e.g., the daemon cannot use GUI features, so parameters such as frame
position, size, and decorations cannot be restored. For that reason,
you may wish to delay restoring the desktop in daemon mode until the
-first client connects, by calling @code{desktop-read} in a hook
-function that you add to @code{server-after-make-frame-hook}
+first client connects, by calling @code{desktop-read} (see below) in a
+hook function that you add to @code{server-after-make-frame-hook}
(@pxref{Creating Frames,,, elisp, The Emacs Lisp Reference Manual}).
+@findex desktop-save
+@findex desktop-read
+ Whenever you want, you can use the command @kbd{M-x desktop-save} to
+force immediate saving of the current desktop. This is useful either
+if you do not want to use the automatic desktop restoration, and thus
+don't turn on @code{desktop-save-mode}, or when you have made
+significant changes to the desktop, and want to make sure the
+configuration doesn't get lost if Emacs or your system crashes. You
+can use @kbd{M-x desktop-read} to restore a previously-saved desktop
+if the current Emacs session didn't load any desktop yet.
+
+@vindex desktop-restore-frames
+ By default, the desktop tries to save and restore the frame and
+window configuration. To disable this, set
+@code{desktop-restore-frames} to @code{nil}. (See that variable's
+documentation for some related options that you can customize to
+fine-tune this behavior.)
+
+@vindex frameset-filter-alist
+ When the desktop restores the frame and window configuration, it
+uses the recorded values of frame parameters, disregarding any
+settings for those parameters you have in your init file (@pxref{Init
+File}). This means that frame parameters such as fonts and faces for
+the restored frames will come from the desktop file, where they were
+saved when you exited your previous Emacs session; any settings for
+those parameters in your init file will be ignored. To disable this,
+customize the value of @code{frameset-filter-alist} to filter out the
+frame parameters you don't want to be restored; they will then be set
+according to your customizations in the init file.
+
+@vindex desktop-files-not-to-save
+ Information about buffers visiting remote files is not saved by
+default. Customize the variable @code{desktop-files-not-to-save} to
+change this.
+
+@vindex desktop-restore-eager
+ By default, all the buffers in the desktop are restored in one go.
+However, this may be slow if there are a lot of buffers in the
+desktop. You can specify the maximum number of buffers to restore
+immediately with the variable @code{desktop-restore-eager}; the
+remaining buffers are restored lazily, when Emacs is idle.
+
+@findex desktop-clear
+@vindex desktop-globals-to-clear
+@vindex desktop-clear-preserve-buffers-regexp
+ Type @kbd{M-x desktop-clear} to empty the Emacs desktop; this can be
+useful, for example, if you want to switch to another desktop by
+invoking @kbd{M-x desktop-read} next. The @code{desktop-clear}
+command kills all buffers except for internal ones, and clears the
+global variables listed in @code{desktop-globals-to-clear}. If you
+want it to preserve certain buffers, customize the variable
+@code{desktop-clear-preserve-buffers-regexp}, whose value is a regular
+expression matching the names of buffers not to kill.
+
+ If you want to save minibuffer history from one session to
+another, use the @code{savehist} library.
+
@node Recursive Edit
@section Recursive Editing Levels
@cindex recursive editing level
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index d0eacce0842..0e4b15fb514 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -429,11 +429,19 @@ For example, one element normally found in the list has
the form
@code{(@t{"\\.c\\'"} . c-mode)}, and it is responsible for selecting C
mode for files whose names end in @file{.c}. (Note that @samp{\\} is
needed in Lisp syntax to include a @samp{\} in the string, which must
-be used to suppress the special meaning of @samp{.} in regexps.) If
-the element has the form @code{(@var{regexp} @var{mode-function}
-@var{flag})} and @var{flag} is non-@code{nil}, then after calling
-@var{mode-function}, Emacs discards the suffix that matched
-@var{regexp} and searches the list again for another match.
+be used to suppress the special meaning of @samp{.} in regexps.)
+
+@cindex backup files, choosing a major mode
+@cindex encrypted files, choosing a major mode
+If the element has the form @w{@code{(@var{regexp} @var{mode-function}
+@var{flag})}} and @var{flag} is non-@code{nil}, then after calling
+@var{mode-function} (if it is non-@code{nil}), Emacs discards the
+suffix that matched @var{regexp} and searches the list again for
+another match. This ``recursive extension stripping'' is used for
+files which have multiple extensions, and the ``outer'' extension
+hides the ``inner'' one that actually specifies the right mode. For
+example, backup files and GPG-encrypted files with @file{.gpg}
+extension use this feature.
@vindex auto-mode-case-fold
On GNU/Linux and other systems with case-sensitive file names, Emacs
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 44cad5a148e..065ed1c51f7 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -163,6 +163,7 @@ Emacs we use it for all languages.
* Left Margin Paren:: An open-paren or similar opening delimiter
starts a defun if it is at the left margin.
* Moving by Defuns:: Commands to move over or mark a major definition.
+* Moving by Sentences:: Commands to move over certain code units.
* Imenu:: Making buffer indexes as menus.
* Which Function:: Which Function mode shows which function you are in.
@end menu
@@ -254,6 +255,66 @@ they do their standard jobs in a way better fitting a
particular
language. Other major modes may replace any or all of these key
bindings for that purpose.
+@node Moving by Sentences
+@subsection Moving by Sentences
+@cindex sentences, in programming languages
+
+ These commands move point or set up the region based on units of
+code, also called @dfn{sentences}. Even though sentences are usually
+considered when writing human languages, Emacs can use the same
+commands to move over certain constructs in programming languages
+(@pxref{Sentences}, @pxref{Moving by Defuns}). In a programming
+language a sentence is usually a complete language construct smaller
+than defuns, but larger than sexps (@pxref{List Motion,,, elisp, The
+Emacs Lisp Reference Manual}). What exactly is a sentence in this
+case depends on the programming language, but usually it is a complete
+statement, such as a variable definition and initialization, or a
+conditional statement. An example of a sentence in the C language
+could be
+
+@example
+int x = 5;
+@end example
+
+@noindent
+or in the JavaScript language it could look like
+
+@example
+@group
+const thing = () => console.log("Hi");
+@end group
+@group
+const foo = [1] == '1'
+ ? "No way"
+ : "...";
+@end group
+
+@end example
+
+@table @kbd
+@item M-a
+Move to beginning of current or preceding sentence
+(@code{backward-sentence}).
+@item M-e
+Move to end of current or following sentence (@code{forward-sentence}).
+@end table
+
+@cindex move to beginning or end of sentence
+@cindex sentence, move to beginning or end
+@kindex M-a @r{(programming modes)}
+@kindex M-e @r{(programming modes)}
+@findex backward-sentence @r{(programming modes)}
+@findex forward-sentence @r{(programming modes)}
+ The commands to move to the beginning and end of the current
+sentence are @kbd{M-a} (@code{backward-sentence}) and @kbd{M-e}
+(@code{forward-sentence}). If you repeat one of these commands, or
+use a positive numeric argument, each repetition moves to the next
+sentence in the direction of motion.
+
+ @kbd{M-a} with a negative argument @minus{}@var{n} moves forward
+@var{n} times to the next end of a sentence. Likewise, @kbd{M-e} with
+a negative argument moves back to the start of a sentence.
+
@node Imenu
@subsection Imenu
@cindex index of buffer definitions
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 8fbf731a4f7..78e89d8031a 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -253,6 +253,10 @@ value of @code{sentence-end-double-space}.
of a sentence. Set the variable @code{sentence-end-without-period} to
@code{t} in such cases.
+ Even though the above mentioned sentence movement commands are based
+on human languages, other Emacs modes can set these command to get
+similar functionality (@pxref{Moving by Sentences}).
+
@node Paragraphs
@section Paragraphs
@cindex paragraphs
@@ -958,8 +962,6 @@ hooks.
@cindex invisible lines
@findex outline-mode
-@findex outline-minor-mode
-@vindex outline-minor-mode-prefix
@vindex outline-mode-hook
Outline mode is a major mode derived from Text mode, which is
specialized for editing outlines. It provides commands to navigate
@@ -982,6 +984,19 @@ previous visible line. Killing the ellipsis at the end of
a visible
line really kills all the following invisible text associated with the
ellipsis.
+@menu
+* Outline Minor Mode:: Outline mode to use with other major modes.
+* Outline Format:: What the text of an outline looks like.
+* Outline Motion:: Special commands for moving through outlines.
+* Outline Visibility:: Commands to control what is visible.
+* Outline Views:: Outlines and multiple views.
+* Foldout:: Folding means zooming in on outlines.
+@end menu
+
+@node Outline Minor Mode
+@subsection Outline Minor Mode
+
+@findex outline-minor-mode
Outline minor mode is a buffer-local minor mode which provides the
same commands as the major mode, Outline mode, but can be used in
conjunction with other major modes. You can type @kbd{M-x
@@ -990,6 +1005,7 @@ buffer, or use a file-local variable setting to enable it
in a
specific file (@pxref{File Variables}).
@kindex C-c @@ @r{(Outline minor mode)}
+@vindex outline-minor-mode-prefix
The major mode, Outline mode, provides special key bindings on the
@kbd{C-c} prefix. Outline minor mode provides similar bindings with
@kbd{C-c @@} as the prefix; this is to reduce the conflicts with the
@@ -1014,14 +1030,6 @@ outline heading lines. @kbd{TAB} cycles hiding, showing
the
sub-heading, and showing all for the current section. @kbd{S-@key{TAB}}
does the same for the entire buffer.
-@menu
-* Outline Format:: What the text of an outline looks like.
-* Outline Motion:: Special commands for moving through outlines.
-* Outline Visibility:: Commands to control what is visible.
-* Outline Views:: Outlines and multiple views.
-* Foldout:: Folding means zooming in on outlines.
-@end menu
-
@node Outline Format
@subsection Format of Outlines
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 91643530f7f..ad01e0f2886 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1871,6 +1871,11 @@ no prefix argument is given, and @code{nil} otherwise.
See also @code{delete-directory} in @ref{Create/Delete Dirs}.
@end deffn
+@defopt remote-file-name-inhibit-delete-by-moving-to-trash
+If this variable is non-@code{nil}, remote files are never moved to
+the Trash. They are deleted instead.
+@end defopt
+
@cindex file permissions, setting
@cindex permissions, file
@cindex file modes, setting
@@ -3385,7 +3390,8 @@ first, before handlers for jobs such as remote file
access.
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
@code{file-symlink-p}, @code{file-system-info},
-@code{file-truename}, @code{file-writable-p},
+@code{file-truename}, @code{file-user-uid},
+@code{file-writable-p},
@code{find-backup-file-name},@*
@code{get-file-buffer},
@code{insert-directory},
@@ -3446,7 +3452,8 @@ first, before handlers for jobs such as remote file
access.
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
@code{file-symlink-p}, @code{file-system-info},
-@code{file-truename}, @code{file-writable-p},
+@code{file-truename}, @code{file-user-uid},
+@code{file-writable-p},
@code{find-backup-file-name},
@code{get-file-buffer},
@code{insert-directory},
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 3a8eddb93ea..f5572e447d3 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -685,6 +685,20 @@ Here are some examples:
@end group
@end example
+@cindex defining functions dynamically
+Most Emacs functions are part of the source code of Lisp programs, and
+are defined when the Emacs Lisp reader reads the program source before
+executing it. However, you can also define functions dynamically at
+run time, e.g., by generating @code{defun} calls when your program's
+code is executed. If you do this, be aware that Emacs's Help
+commands, such as @kbd{C-h f}, which present in the @file{*Help*}
+buffer a button to jump to the function's definition, might be unable
+to find the source code because generating a function dynamically
+usually looks very different from the usual static calls to
+@code{defun}. You can make the job of finding the code which
+generates such functions easier by using the @code{definition-name}
+property, @pxref{Standard Properties}.
+
@cindex override existing functions
@cindex redefine existing functions
Be careful not to redefine existing functions unintentionally.
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index de5ed76c7f7..59b6b6dab1d 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -69,14 +69,14 @@ Variables}. The string is stored in the variable's
@cindex @file{DOC} (documentation) file
Sometimes, Emacs does not keep documentation strings in memory.
There are two such circumstances. Firstly, to save memory, the
-documentation for preloaded functions and variables (including
-primitives) is kept in a file named @file{DOC}, in the directory
-specified by @code{doc-directory} (@pxref{Accessing Documentation}).
-Secondly, when a function or variable is loaded from a byte-compiled
-file, Emacs avoids loading its documentation string (@pxref{Docs and
-Compilation}). In both cases, Emacs looks up the documentation string
-from the file only when needed, such as when the user calls @kbd{C-h
-f} (@code{describe-function}) for a function.
+documentation for primitive functions (@pxref{What Is a Function}) and
+built-in variables is kept in a file named @file{DOC}, in the
+directory specified by @code{doc-directory} (@pxref{Accessing
+Documentation}). Secondly, when a function or variable is loaded from
+a byte-compiled file, Emacs avoids loading its documentation string
+(@pxref{Docs and Compilation}). In both cases, Emacs looks up the
+documentation string from the file only when needed, such as when the
+user calls @kbd{C-h f} (@code{describe-function}) for a function.
Documentation strings can contain special @dfn{key substitution
sequences}, referring to key bindings which are looked up only when
@@ -303,7 +303,7 @@ for in the directory @code{doc-directory}. Usually
@var{filename} is
@defvar doc-directory
This variable holds the name of the directory which should contain the
file @code{"DOC"} that contains documentation strings for
-built-in and preloaded functions and variables.
+built-in functions and variables.
In most cases, this is the same as @code{data-directory}. They may be
different when you run Emacs from the directory where you built it,
diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi
index 1c548af1990..7876780dcd4 100644
--- a/doc/lispref/keymaps.texi
+++ b/doc/lispref/keymaps.texi
@@ -1378,7 +1378,8 @@ Binding Conventions}).
or if @var{key} is not a valid key.
@var{key} is a string representing a single key or a series of key
-strokes. Key strokes are separated by a single space character.
+strokes, and must satisfy @code{key-valid-p}. Key strokes are
+separated by a single space character.
Each key stroke is either a single character, or the name of an
event, surrounded by angle brackets. In addition, any key stroke
@@ -1413,6 +1414,7 @@ The only keys that have a special shorthand syntax are
@kbd{NUL},
The modifiers have to be specified in alphabetical order:
@samp{A-C-H-M-S-s}, which is @samp{Alt-Control-Hyper-Meta-Shift-super}.
+@findex keymap-set
@defun keymap-set keymap key binding
This function sets the binding for @var{key} in @var{keymap}. (If
@var{key} is more than one event long, the change is actually made
@@ -3079,13 +3081,13 @@ the menu. To put it elsewhere in the menu, use
@code{keymap-set-after}:
@defun keymap-set-after map key binding &optional after
Define a binding in @var{map} for @var{key}, with value @var{binding},
just like @code{define-key}, but position the binding in @var{map} after
-the binding for the event @var{after}. The argument @var{key} should be
-of length one---a vector or string with just one element. But
-@var{after} should be a single event type---a symbol or a character, not
-a sequence. The new binding goes after the binding for @var{after}. If
-@var{after} is @code{t} or is omitted, then the new binding goes last, at
-the end of the keymap. However, new bindings are added before any
-inherited keymap.
+the binding for the event @var{after}. The argument @var{key} should
+represent a single menu item or key, and @var{after} should be a
+single event type---a symbol or a character, not a sequence. The new
+binding goes after the binding for @var{after}. If @var{after} is
+@code{t} or is omitted, then the new binding goes last, at the end of
+the keymap. However, new bindings are added before any inherited
+keymap.
Here is an example:
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 18125c372ce..4b957a68401 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -312,7 +312,7 @@ to @code{regexp-history}.
@cindex @code{case-fold}, text property
@findex read-regexp-case-fold-search
-The user can use the @kbd{M-c} command to indicate whether case
+The user can use the @kbd{M-s c} command to indicate whether case
folding should be on or off. If the user has used this command, the
returned string will have the text property @code{case-fold} set to
either @code{fold} or @code{inhibit-fold}. It is up to the caller of
@@ -2233,10 +2233,12 @@ minibuffer. It returns @code{t} if the user enters
@samp{yes},
@code{nil} if the user types @samp{no}. The user must type @key{RET} to
finalize the response. Upper and lower case are equivalent.
-@code{yes-or-no-p} starts by displaying @var{prompt} in the minibuffer,
-followed by @w{@samp{(yes or no) }}. The user must type one of the
-expected responses; otherwise, the function responds @samp{Please answer
-yes or no.}, waits about two seconds and repeats the request.
+@vindex yes-or-no-prompt
+@code{yes-or-no-p} starts by displaying @var{prompt} in the
+minibuffer, followed by the value of @code{yes-or-no-prompt} @w{(default
+@samp{(yes or no) })}. The user must type one of the expected
+responses; otherwise, the function responds @w{@samp{Please answer yes or
+no.}}, waits about two seconds and repeats the request.
@code{yes-or-no-p} requires more work from the user than
@code{y-or-n-p} and is appropriate for more crucial decisions.
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index b2dd294ea28..fe5eb8a1b8d 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -4926,8 +4926,7 @@ the current line to @var{matcher}; if it returns
non-@code{nil}, this
rule is applicable. Then Emacs passes the node to @var{anchor}, which
returns a buffer position. Emacs takes the column number of that
position, adds @var{offset} to it, and the result is the indentation
-column for the current line. @var{offset} can be an integer or a
-variable whose value is an integer.
+column for the current line.
The @var{matcher} and @var{anchor} are functions, and Emacs provides
convenient defaults for them.
@@ -4936,17 +4935,20 @@ Each @var{matcher} or @var{anchor} is a function that
takes three
arguments: @var{node}, @var{parent}, and @var{bol}. The argument
@var{bol} is the buffer position whose indentation is required: the
position of the first non-whitespace character after the beginning of
-the line. The argument @var{node} is the largest (highest-in-tree)
-node that starts at that position; and @var{parent} is the parent of
-@var{node}. However, when that position is in a whitespace or inside
-a multi-line string, no node can start at that position, so
+the line. The argument @var{node} is the largest node that starts at
+that position (and is not a root node); and @var{parent} is the parent
+of @var{node}. However, when that position is in a whitespace or
+inside a multi-line string, no node can start at that position, so
@var{node} is @code{nil}. In that case, @var{parent} would be the
smallest node that spans that position.
-Emacs finds @var{bol}, @var{node} and @var{parent} and
-passes them to each @var{matcher} and @var{anchor}. @var{matcher}
-should return non-@code{nil} if the rule is applicable, and
-@var{anchor} should return a buffer position.
+@var{matcher} should return non-@code{nil} if the rule is applicable,
+and @var{anchor} should return a buffer position.
+
+@var{offset} can be an integer, a variable whose value is an integer,
+or a function that returns an integer. If it is a function, it is
+passed @var{node}, @var{parent}, and @var{bol}, like matchers and
+anchors.
@end defvar
@defvar treesit-simple-indent-presets
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 3be7036f637..bca62a7a8de 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1277,6 +1277,16 @@ This function returns the real @acronym{UID} of the user.
This function returns the effective @acronym{UID} of the user.
@end defun
+@defun file-user-uid
+This function returns the connection-local value for the user's
+effective @acronym{UID}. If @code{default-directory} is local, this
+is equivalent to @code{user-uid}, but for remote files (@pxref{Remote
+Files, , , emacs, The GNU Emacs Manual}), it will return the
+@acronym{UID} for the user associated with that remote connection; if
+the remote connection has no associated user, it will instead return
+-1.
+@end defun
+
@cindex GID
@defun group-gid
This function returns the effective @acronym{GID} of the Emacs process.
diff --git a/doc/lispref/parsing.texi b/doc/lispref/parsing.texi
index 9635427f940..cebb59b6501 100644
--- a/doc/lispref/parsing.texi
+++ b/doc/lispref/parsing.texi
@@ -540,11 +540,15 @@ This function returns the list of @var{parser}'s notifier
functions.
Here's some terminology and conventions we use when documenting
tree-sitter functions.
-We talk about a node being ``smaller'' or ``larger'', and ``lower'' or
-``higher''. A smaller and lower node is lower in the syntax tree and
-therefore spans a smaller portion of buffer text; a larger and higher
-node is higher up in the syntax tree, it contains many smaller nodes
-as its children, and therefore spans a larger portion of text.
+A node in a syntax tree spans some portion of the program text in the
+buffer. We say that a node is ``smaller'' or ``larger'' than another
+if it spans, respectively, a smaller or larger portion of buffer text
+than the other node. Since nodes that are deeper (``lower'') in the
+tree are children of the nodes that are ``higher'' in the tree, it
+follows that a lower node will always be smaller than a node that is
+higher in the node hierarchy. A node that is higher up in the syntax
+tree contains one or more smaller nodes as its children, and therefore
+spans a larger portion of buffer text.
When a function cannot find a node, it returns @code{nil}. For
convenience, all functions that take a node as argument and return
@@ -925,9 +929,13 @@ Here are some predicates on tree-sitter nodes:
Checks if @var{object} is a tree-sitter syntax node.
@end defun
+@cindex compare tree-sitter syntax nodes
+@cindex tree-sitter nodes, comparing
@defun treesit-node-eq node1 node2
-Checks if @var{node1} and @var{node2} are the same node in a syntax
-tree.
+Checks if @var{node1} and @var{node2} refer to the same node in a
+tree-sitter syntax tree. This function uses the same equivalence
+metric as @code{equal}. You can also compare nodes using @code{equal}
+(@pxref{Equality Predicates}).
@end defun
@heading Property information
@@ -1684,26 +1692,48 @@ integration for a major mode.
A major mode supporting tree-sitter features should roughly follow
this pattern:
-@c FIXME: Update this part once we settle on the exact format.
@example
@group
(define-derived-mode woomy-mode prog-mode "Woomy"
"A mode for Woomy programming language."
- ;; Shared setup.
- ...
- (cond
- ;; Tree-sitter setup.
- ((treesit-ready-p 'woomy)
+ (when (treesit-ready-p 'woomy)
(setq-local treesit-variables ...)
- (treesit-major-mode-setup))
- ;; Non-tree-sitter setup.
- (t
- ...)))
+ ...
+ (treesit-major-mode-setup)))
@end group
@end example
-First, the major mode should use @code{treesit-ready-p} to determine
-whether tree-sitter can be activated in this mode.
+@code{treesit-ready-p} automatically emits a warning if conditions for
+enabling tree-sitter aren't met.
+
+If a tree-sitter major mode shares setup with their ``native''
+counterpart, they can create a ``base mode'' that contains the common
+setup, like this:
+
+@example
+@group
+(define-derived-mode woomy--base-mode prog-mode "Woomy"
+ "An internal mode for Woomy programming language."
+ (common-setup)
+ ...)
+@end group
+
+@group
+(define-derived-mode woomy-mode woomy--base-mode "Woomy"
+ "A mode for Woomy programming language."
+ (native-setup)
+ ...)
+@end group
+
+@group
+(define-derived-mode woomy-ts-mode woomy--base-mode "Woomy"
+ "A mode for Woomy programming language."
+ (when (treesit-ready-p 'woomy)
+ (setq-local treesit-variables ...)
+ ...
+ (treesit-major-mode-setup)))
+@end group
+@end example
@defun treesit-ready-p language &optional quiet
This function checks for conditions for activating tree-sitter. It
@@ -1714,15 +1744,12 @@ language grammar for @var{language} is available on the
system
This function emits a warning if tree-sitter cannot be activated. If
@var{quiet} is @code{message}, the warning is turned into a message;
-if @var{quiet} is @code{nil}, no warning or message is displayed.
+if @var{quiet} is @code{t}, no warning or message is displayed.
If all the necessary conditions are met, this function returns
non-@code{nil}; otherwise it returns @code{nil}.
@end defun
-Next, the major mode should set up tree-sitter variables and call
-@code{treesit-major-mode-setup}.
-
@defun treesit-major-mode-setup
This function activates some tree-sitter features for a major mode.
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index f3824436246..838877b6282 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -858,6 +858,40 @@ top-level defuns, if the value is @code{nested},
navigation functions
recognize nested defuns.
@end defvar
+@defvar treesit-sentence-type-regexp
+The value of this variable is a regexp matching the node type of sentence
+nodes. (For ``node'' and ``node type'', @pxref{Parsing Program Source}.)
+@end defvar
+
+@findex treesit-forward-sentence
+@findex forward-sentence
+@findex backward-sentence
+If Emacs is compiled with tree-sitter, it can use the tree-sitter
+parser information to move across syntax constructs. Since what
+exactly is considered a sentence varies between languages, a major
+mode should set @code{treesit-sentence-type-regexp} to determine that.
+Then the mode can get navigation-by-sentence functionality for free,
+by using @code{forward-sentence} and
+@code{backward-sentence}(@pxref{Moving by Sentences,,, emacs, The
+extensible self-documenting text editor}).
+
+@defvar treesit-sexp-type-regexp
+The value of this variable is a regexp matching the node type of sexp
+nodes. (For ``node'' and ``node type'', @pxref{Parsing Program
+Source}.)
+@end defvar
+
+@findex treesit-forward-sexp
+@findex forward-sexp@r{, and tree-sitter}
+@findex backward-sexp@r{, and tree-sitter}
+If Emacs is compiled with tree-sitter, it can use the tree-sitter
+parser information to move across syntax constructs. Since what
+exactly is considered a sexp varies between languages, a major mode
+should set @code{treesit-sexp-type-regexp} to determine that. Then
+the mode can get navigation-by-sexp functionality for free, by using
+@code{forward-sexp} and @code{backward-sexp}(@pxref{Moving by
+Sentences,,, emacs, The extensible self-documenting text editor}).
+
@node Skipping Characters
@subsection Skipping Characters
@cindex skipping characters
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index ca18f0a9cc1..3d86a87516b 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -911,8 +911,8 @@ This function returns a new string containing one character,
@end defun
@defun string-to-char string
- This function returns the first character in @var{string}. This
-mostly identical to @code{(aref string 0)}, except that it returns 0
+ This function returns the first character in @var{string}. This is
+mostly identical to @w{@code{(aref string 0)}}, except that it returns 0
if the string is empty. (The value is also 0 when the first character
of @var{string} is the null character, @acronym{ASCII} code 0.) This
function may be eliminated in the future if it does not seem useful
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index 183367c0cda..5b53cbe310a 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -555,6 +555,23 @@ value, saved value, customized-but-unsaved value, and
themed values.
Do not set them directly; they are managed by @code{defcustom} and
related functions. @xref{Variable Definitions}.
+@item definition-name
+This property is used to find the definition of a symbol in the source
+code, when it might be hard to find the definition by textual search
+of the source file. For example, a @code{define-derived-mode}
+(@pxref{Derived Modes}) might define a mode-specific function or a
+variable implicitly; or your Lisp program might generate a run-time
+call to @code{defun} to define a function (@pxref{Defining
+Functions}). In these and similar cases, the @code{definition-name}
+property of the symbol should be another symbol whose definition can
+be found by textual search and whose code defines the original symbol.
+In the example with @code{define-derived-mode}, the value of this
+property of the functions and variables it defines should be the mode
+symbol. The Emacs Help commands such as @kbd{C-h f} (@pxref{Help,,,
+emacs, The GNU Emacs Manual}) use this property to show the definition
+of a symbol via a button in the @file{*Help*} buffer where the
+symbol's documentation is shown.
+
@item disabled
If the value is non-@code{nil}, the named function is disabled as a
command. @xref{Disabling Commands}.
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 253bf169ccb..56151b5482f 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -1104,7 +1104,7 @@ troubleshoot Eglot problems. It also provides guidelines
for
reporting Eglot bugs in a way that facilitates their resolution.
When you encounter problems with Eglot, try first using the commands
-@kbd{M-x eglot-events-server} and @kbd{M-x eglot-stderr-buffer}. They
+@kbd{M-x eglot-events-buffer} and @kbd{M-x eglot-stderr-buffer}. They
pop up special buffers that can be used to inspect the communications
between the Eglot and language server. In many cases, this will
indicate the problems or at least provide a hint.
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 23cdcbff575..8030dfa4bb7 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -539,36 +539,55 @@ 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.
+@anchor{Local Modules}
@subheading Local Modules
@cindex local modules
All modules operate as minor modes under the hood, and some newer ones
may be defined as buffer-local. These so-called ``local modules'' are
a work in progress and their behavior and interface are subject to
-change. As of ERC 5.5, the only practical differences are
+change. As of ERC 5.5, the only practical differences are as follows:
@enumerate
@item
-``Control variables,'' like @code{erc-sasl-mode}, are stateful across
-IRC sessions and override @code{erc-module} membership when influencing
-module activation in new sessions.
+``Control variables,'' like @code{erc-sasl-mode}, retain their values
+across IRC sessions and override @code{erc-module} membership when
+influencing module activation.
@item
Removing a local module from @code{erc-modules} via Customize not only
disables its mode but also kills its control variable in all ERC
buffers.
@item
-``Mode toggles,'' like @code{erc-sasl-mode} and
-@code{erc-sasl-enable}, behave differently relative to each other and
-to their global counterparts. (More on this just below.)
+``Mode toggles,'' like @code{erc-sasl-mode} and the complementary
+@code{erc-sasl-enable}/@code{erc-sasl-disable} pairing, behave
+differently than their global counterparts.
@end enumerate
-By default, all local-mode toggles, like @code{erc-sasl-mode}, only
-affect the current buffer, but their ``non-mode'' variants, such as
-@code{erc-sasl-enable}, operate on all buffers belonging to a
-connection when called interactively. Keep in mind that whether
-enabled or not, a module may effectively be ``inert'' in certain types
-of buffers, such as queries and channels. Whatever the case, a local
-toggle never mutates @code{erc-modules}.
+In target buffers, a local module's activation state survives
+``reassociation'' by default, but modules themselves always have the
+final say. For example, a module may reset all instances of itself in
+its network context upon reconnecting. Moreover, the value of a mode
+variable may be meaningless in buffers that its module has no interest
+in. For example, the value of @code{erc-sasl-mode} doesn't matter in
+target buffers and may even remain non-@code{nil} after SASL has been
+disabled for the current connection (and vice versa).
+
+When it comes to server buffers, a module's activation state only
+persists for sessions revived via the automatic reconnection mechanism
+or a manual @samp{/reconnect} issued at the prompt. In other words,
+this doesn't apply to sessions revived by an entry-point command, such
+as @code{erc-tls}, because such commands always ensure a clean slate
+by looking only to @code{erc-modules}. Although a session revived in
+this manner may indeed harvest other information from a previous
+server buffer, it simply doesn't care which modules might have been
+active during that connection.
+
+Lastly, a local mode's toggle command, like @code{erc-sasl-mode}, only
+affects the current buffer, but its ``non-mode'' cousins, like
+@code{erc-sasl-enable} and @code{erc-sasl-disable}, operate on all
+buffers belonging to their connection (when called interactively).
+And unlike global toggles, none of these ever mutates
+@code{erc-modules}.
@c PRE5_4: Document every option of every module in its own subnode
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index fc7d52eb711..57a2020fdca 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -64,10 +64,11 @@ modify this GNU manual.''
Eshell is a shell-like command interpreter implemented in Emacs Lisp.
It invokes no external processes except for those requested by the
-user. It is intended to be an alternative to the IELM (@pxref{Lisp
Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor})
-REPL for Emacs @emph{and} with an interface similar to command shells
-such as @command{bash}, @command{zsh}, @command{rc}, or
-@command{4dos}.
+user. It is intended to be an alternative to the IELM (@pxref{Lisp
+Interaction, Emacs Lisp Interaction, , emacs, The Emacs Editor})
+REPL@footnote{Short for ``Read-Eval-Print Loop''.} for Emacs
+@emph{and} with an interface similar to command shells such as
+@command{bash}, @command{zsh}, @command{rc}, or @command{4dos}.
@c This manual is updated to release 2.4 of Eshell.
@insertcopying
@@ -193,6 +194,13 @@ In a command shell, everything is done by invoking
commands. This
chapter covers command invocations in Eshell, including the command
history and invoking commands in a script file.
+Unlike regular system shells, Eshell never invokes kernel functions
+directly, such as @code{exec(3)}. Instead, it uses the Lisp functions
+available in the Emacs Lisp library. It does this by transforming the
+input line into a callable Lisp form.@footnote{To see the Lisp form
+that will be invoked, type this as the Eshell prompt:
+@kbd{eshell-parse-command 'echo hello'}}
+
@menu
* Invocation::
* Arguments::
@@ -207,23 +215,16 @@ history and invoking commands in a script file.
@node Invocation
@section Invocation
-Unlike regular system shells, Eshell never invokes kernel functions
-directly, such as @code{exec(3)}. Instead, it uses the Lisp functions
-available in the Emacs Lisp library. It does this by transforming the
-input line into a callable Lisp form.@footnote{To see the Lisp form that will
be invoked, type: @samp{eshell-parse-command "echo hello"}}
+Eshell is both a command shell and an Emacs Lisp @acronym{REPL}. As a
+result, you can invoke commands in two different ways: in @dfn{command
+form} or in @dfn{lisp form}.
-The command can be either an Elisp function or an external command.
-Eshell looks first for an alias (@pxref{Aliases}) with the same name as the
-command, then a built-in (@pxref{Built-ins}) or a function with the
-same name; if there is no match, it then tries to execute it as an
-external command.
-
-The semicolon (@code{;}) can be used to separate multiple command
-invocations on a single line. You can also separate commands with
-@code{&&} or @code{||}. When using @code{&&}, Eshell will execute the
-second command only if the first succeeds (i.e.@: has an exit
-status of 0); with @code{||}, Eshell will execute the second command
-only if the first fails.
+You can use the semicolon (@code{;}) to separate multiple command
+invocations on a single line, executing each in turn. You can also
+separate commands with @code{&&} or @code{||}. When using @code{&&},
+Eshell will execute the second command only if the first succeeds
+(i.e.@: has an exit status of 0); with @code{||}, Eshell will execute
+the second command only if the first fails.
A command invocation followed by an ampersand (@code{&}) will be run
in the background. Eshell has no job control, so you can not suspend
@@ -232,12 +233,80 @@ the foreground. That said, background processes invoked
from Eshell
can be controlled the same way as any other background process in
Emacs.
+@subsection Command form
+Command form looks much the same as in other shells. A command
+consists of arguments separated by spaces; the first argument is the
+command to run, with any subsequent arguments being passed to that
+command.
+
+@example
+~ $ echo hello
+hello
+@end example
+
+@cindex order of looking for commands
+@cindex command lookup order
+The command can be either an Elisp function or an external command.
+Eshell looks for the command in the following order:
+
+@enumerate
+@item
+As a command alias (@pxref{Aliases})
+
+@item
+As a built-in command (@pxref{Built-ins})
+
+@item
+As an external program
+
+@item
+As an ordinary Lisp function
+@end enumerate
+
+@vindex eshell-prefer-lisp-functions
+If you would prefer to use ordinary Lisp functions over external
+programs, set the option @code{eshell-prefer-lisp-functions} to
+@code{t}. This will swap the lookup order of the last two items.
+
+You can also group command forms together into a subcommand with curly
+braces (@code{@{@}}). This lets you use the output of a subcommand as
+an argument to another command, or within control flow statements
+(@pxref{Control Flow}).
+
+@example
+~ $ echo @{echo hello; echo there@}
+hellothere
+@end example
+
+@subsection Lisp form
+Lisp form looks like ordinary Emacs Lisp code, because that's what it
+is. As a result, you can use any syntax normally available to an
+Emacs Lisp program (@pxref{Top, , , elisp, The Emacs Lisp Reference
+Manual}).
+
+@example
+~ $ (format "hello, %s" user-login-name)
+hello, user
+@end example
+
+In addition, you can @emph{combine} command forms and Lisp forms
+together into single statements, letting you use whatever form is the
+most convenient for expressing your intentions.
+
+@example
+~ $ ls *.patch > (format-time-string "%F.log")
+@end example
+
+This command writes a list of all files matching the glob pattern
+@code{*.patch} (@pxref{Globbing}) to a file named
+@code{@var{current-date}.log} (@pxref{Redirection}).
+
@node Arguments
@section Arguments
-Ordinarily, command arguments are parsed by Eshell as either strings
+Ordinarily, Eshell parses arguments in command form as either strings
or numbers, depending on what the parser thinks they look like. To
-specify an argument of some other data type, you can use an
-@ref{Dollars Expansion, Elisp expression}:
+specify an argument of some other data type, you can use a Lisp form
+(@pxref{Invocation}):
@example
~ $ echo (list 1 2 3)
@@ -354,10 +423,6 @@ eshell/sudo is a compiled Lisp function in `em-tramp.el'.
sudo is an alias, defined as "*sudo $@@*"
@end example
-@vindex eshell-prefer-lisp-functions
-If you would prefer to use the built-in commands instead of the external
-commands, set @code{eshell-prefer-lisp-functions} to @code{t}.
-
Some of the built-in commands have different behavior from their
external counterparts, and some have no external counterpart. Most of
these will print a usage message when given the @code{--help} option.
@@ -923,15 +988,14 @@ For example, you could handle a subset of the options for
the
@node Variables
@section Variables
@vindex eshell-prefer-lisp-variables
-Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{
-Short for ``Read-Eval-Print Loop''.
-} and a command shell, it can refer to variables from two different
-sources: ordinary Emacs Lisp variables, as well as environment
-variables. By default, when using a variable in Eshell, it will first
-look in the list of built-in variables, then in the list of
-environment variables, and finally in the list of Lisp variables. If
-you would prefer to use Lisp variables over environment variables, you
-can set @code{eshell-prefer-lisp-variables} to @code{t}.
+Since Eshell is a combination of an Emacs @acronym{REPL} and a command
+shell, it can refer to variables from two different sources: ordinary
+Emacs Lisp variables, as well as environment variables. By default,
+when using a variable in Eshell, it will first look in the list of
+built-in variables, then in the list of environment variables, and
+finally in the list of Lisp variables. If you would prefer to use
+Lisp variables over environment variables, you can set
+@code{eshell-prefer-lisp-variables} to @code{t}.
You can set variables in a few different ways. To set a Lisp
variable, you can use the command @samp{setq @var{name} @var{value}},
@@ -983,6 +1047,13 @@ whenever you change the current directory to a different
host
the value will automatically update to reflect the search path on that
host.
+@vindex $UID
+@item $UID
+This returns the effective @acronym{UID} for the current user. This
+variable is connection-aware, so when the current directory is remote,
+its value will be @acronym{UID} for the user associated with that
+remote connection.
+
@vindex $_
@item $_
This refers to the last argument of the last command. With a
@@ -1014,6 +1085,7 @@ that are currently visible in the Eshell window. They
are both
copied to the environment, so external commands invoked from
Eshell can consult them to do the right thing.
+@vindex $INSIDE_EMACS
@item $INSIDE_EMACS
This variable indicates to external commands that they are being
invoked from within Emacs so they can adjust their behavior if
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index bc556ed88e2..836eb38503e 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -92,9 +92,10 @@ searched via @code{eww-search-prefix}. The default search
engine is
either prefix the file name with @code{file://} or use the command
@kbd{M-x eww-open-file}.
- If you invoke @code{eww} with a prefix argument, as in @w{@kbd{C-u
-M-x eww}}, it will create a new EWW buffer instead of reusing the
-default one, which is normally called @file{*eww*}.
+ If you invoke @code{eww} or @code{eww-open-file} with a prefix
+argument, as in @w{@kbd{C-u M-x eww}}, they will create a new EWW
+buffer instead of reusing the default one, which is normally called
+@file{*eww*}.
@findex eww-quit
@findex eww-reload
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 3289d66f017..1769b70c9bc 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -12106,17 +12106,6 @@ if they were public groups, you can add the name of
that group to the
Also @pxref{Misc Article} for @code{gnus-inhibit-images}.
-@item gnus-html-cache-directory
-@vindex gnus-html-cache-directory
-Gnus will download and cache images according to how
-@code{gnus-blocked-images} is set. These images will be stored in
-this directory.
-
-@item gnus-html-cache-size
-@vindex gnus-html-cache-size
-When @code{gnus-html-cache-size} bytes have been used in that
-directory, the oldest files will be deleted. The default is 500MB.
-
@item gnus-html-frame-width
@vindex gnus-html-frame-width
The width to use when rendering HTML@. The default is 70.
diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi
index 2c96002fb16..fa45f9361ab 100644
--- a/doc/misc/htmlfontify.texi
+++ b/doc/misc/htmlfontify.texi
@@ -1351,11 +1351,10 @@ Whether or not to split the index @ref{hfy-index-file}
alphabetically
on the first letter of each tag. Useful when the index would otherwise
be large and take a long time to render or be difficult to navigate.
-@item hfy-find-cmd
-@vindex hfy-find-cmd
-@anchor{hfy-find-cmd}
+@item hfy-exclude-file-rules
+@vindex hfy-exclude-file-rules
-The ``find'' command used to harvest a list of files to attempt to fontify.
+Regular expressions to exclude files which shouldn't be fontified.
@item hfy-extn
@vindex hfy-extn
@@ -1545,12 +1544,6 @@ but you should be able to override this.
See: @ref{Customization}
-@item
-A copy of find (e.g., GNU find) that provides the @code{-path} predicate.
-
-You may be able to work around this with a suitable clever shell
-command and the customization entry: @ref{hfy-find-cmd}
-
@item
A copy of sed (e.g., GNU sed).
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index d71895da5db..4a0311cad42 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -307,11 +307,16 @@ news ticker.
@findex newsticker-start-ticker
@findex newsticker-stop-ticker
+@vindex newsticker-ticker-period
Headlines can be displayed in the echo area, either scrolling like
messages in a stock-quote ticker, or just changing. This can be
started with the command @code{newsticker-start-ticker}. It can be
stopped with @code{newsticker-stop-ticker}.
+The ticker by default runs continuously. To only run it once, at a
+specific time interval, set the @code{newsticker-ticker-period}
+variable.
+
@node Navigation
@section Navigation
@@ -542,8 +547,10 @@ are shown in the echo area, i.e., the ``ticker''.
@itemize
@item
@vindex newsticker-display-interval
+@vindex newsticker-ticker-period
@vindex newsticker-scroll-smoothly
-@code{newsticker-ticker-interval} and
+@code{newsticker-ticker-interval},
+@code{newsticker-ticker-period}, and
@code{newsticker-scroll-smoothly} define how headlines are shown in
the echo area.
@end itemize
diff --git a/doc/misc/org.org b/doc/misc/org.org
index ed3eb0626f2..14699e77395 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -1249,11 +1249,12 @@ After the drawer.
#+findex: org-insert-drawer
You can interactively insert a drawer at point by calling
~org-insert-drawer~, which is bound to {{{kbd(C-c C-x d)}}}. With an
-active region, this command puts the region inside the drawer. With
-a prefix argument, this command calls ~org-insert-property-drawer~,
-which creates a =PROPERTIES= drawer right below the current headline.
-Org mode uses this special drawer for storing properties (see
-[[*Properties and Columns]]). You cannot use it for anything else.
+active region, this command puts the region inside the drawer. With a
+prefix argument, this command calls non-interactive function
+~org-insert-property-drawer~, which creates a =PROPERTIES= drawer
+right below the current headline. Org mode uses this special drawer
+for storing properties (see [[*Properties and Columns]]). You cannot use
+it for anything else.
Completion over drawer keywords is also possible using
{{{kbd(M-TAB)}}}[fn:6].
@@ -8787,7 +8788,9 @@ a ~day~, ~week~, ~month~ or ~year~. For weekly agendas,
the default
is to start on the previous Monday (see
~org-agenda-start-on-weekday~). You can also set the start date using
a date shift: =(setq org-agenda-start-day "+10d")= starts the agenda
-ten days from today in the future.
+ten days from today in the future. ~org-agenda-start-on-weekday~
+takes precedence over ~org-agenda-start-day~ in weekly and bi-weekly
+agendas.
Remote editing from the agenda buffer means, for example, that you can
change the dates of deadlines and appointments from the agenda buffer.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 7f66dc9e849..a8a59f982fc 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5215,9 +5215,10 @@ them, @ref{Misc File Ops, Trashing , , emacs}.
@ifnotinfo
them.
@end ifnotinfo
-Remote files are always trashed to the local trash, except remote
-encrypted files (@pxref{Keeping files encrypted}), which are deleted
-anyway.
+Remote files are always trashed to the local trash, except the user
+option @code{remote-file-name-inhibit-delete-by-moving-to-trash} is
+non-@code{nil}, or it is a remote encrypted file (@pxref{Keeping files
+encrypted}), which are deleted anyway.
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
diff --git a/etc/NEWS b/etc/NEWS
index 690e9c3faa9..5b8ab06086c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -45,18 +45,67 @@ example, as part of preview for iconified frames.
** 'write-region-inhibit-fsync' now defaults to t in interactive mode,
as it has in batch mode since Emacs 24.
++++
+** New user option 'remote-file-name-inhibit-delete-by-moving-to-trash'.
+When non-nil, this option suppresses moving remote files to the local
+trash when deleting. Default is nil.
+
++++
+** New user option 'yes-or-no-prompt'.
+This allows the user to customize the prompt that is appended by
+'yes-or-no-p' when asking questions. The default value is
+"(yes or no) ".
+
* Editing Changes in Emacs 30.1
+---
+** New command 'kill-matching-buffers-no-ask'.
+This works like 'kill-matching-buffers', but without asking for
+confirmation.
+
++++
** New helper variable 'transpose-sexps-function'.
Emacs now can set this variable to customize the behavior of the
'transpose-sexps' function.
++++
+** New function 'transpose-sexps-default-function'.
+The previous implementation is moved into its own function, to be
+bound by '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
+Tree-sitter now unconditionally sets 'transpose-sexps-function' for all
+tree-sitter enabled modes. This functionality utilizes the new
'transpose-sexps-function'.
+** Commands and variables to move by program statements
+
+*** New variable 'forward-sentence-function'.
+Major modes can now set this variable to customize the behavior of the
+'forward-sentence' command.
+
+*** New function 'forward-sentence-default-function'.
+The previous implementation of 'forward-sentence' is moved into its
+own function, to be bound by 'forward-sentence-function'.
+
+*** New buffer-local variable 'treesit-sentence-type-regexp'.
+Similarly to 'treesit-defun-type-regexp', this variable is used to
+define "sentences" in tree-sitter enabled modes.
+
+*** New function 'treesit-forward-sentence'.
+All tree-sitter enabled modes that define 'treesit-sentence-type-regexp'
+now set 'forward-sentence-function' to call 'treesit-forward-sentence'.
+
+*** New buffer-local variable 'treesit-sexp-type-regexp'.
+Similarly to 'treesit-defun-type-regexp', this variable is used to
+define "sexps" in tree-sitter enabled modes.
+
+*** New function 'treesit-forward-sexp'.
+Tree-sitter conditionally sets 'forward-sexp-function' for major modes
+that have defined 'treesit-sexp-type-regexp' to enable sexp-related
+motion commands.
+
* Changes in Specialized Modes and Packages in Emacs 30.1
---
@@ -100,6 +149,15 @@ of arguments into a command, such as when defining
aliases. For more
information, see the "(eshell) Dollars Expansion" node in the Eshell
manual.
+---
+*** Eshell now uses 'field' properties in its output.
+In particular, this means that pressing the '<home>' key moves the
+point to the beginning of your input, not the beginning of the whole
+line. If you want to go back to the old behavior, add something like
+this to your configuration:
+
+ (keymap-set eshell-mode-map "<home>" #'eshell-bol-ignoring-prompt)
+
+++
*** 'eshell-read-aliases-list' is now an interactive command.
After manually editing 'eshell-aliases-file', you can use this command
@@ -118,11 +176,35 @@ point is not in a comment or a string. It is by default
bound to
+++
*** New connection method "toolbox".
-This allow accessing system containers provided by Toolbox.
+This allows accessing system containers provided by Toolbox.
+
+** EWW
+
++++
+*** 'eww-open-file' can now display the file in a new buffer.
+By default, the command reuses the "*eww*" buffer, but if called with
+the new argument NEW-BUFFER non-nil, it will use a new buffer instead.
+Interactively, invoke 'eww-open-file' with a prefix argument to
+activate this behavior.
+
+** go-ts-mode
+
++++
+*** New command 'go-ts-mode-docstring'.
+This command adds a docstring comment to the current defun. If a
+comment already exists, point is only moved to the comment. It is
+bound to 'C-c C-d' in 'go-ts-mode'.
* New Modes and Packages in Emacs 30.1
+** New major modes based on the tree-sitter library.
+
++++
+*** New major mode 'html-ts-mode'.
+An optional major mode based on the tree-sitter library for editing
+HTML files.
+
---
** The highly accessible Modus themes collection has six items.
The 'modus-operandi' and 'modus-vivendi' are the main themes that have
@@ -190,6 +272,12 @@ compared reliably at all.
This warning can be suppressed using 'with-suppressed-warnings' with
the warning name 'suspicious'.
++++
+** New function 'file-user-uid'.
+This function is like 'user-uid', but is aware of file name handlers,
+so it will return the remote UID for remote files (or -1 if the
+connection has no associated user).
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index 5901b2718e9..4d199676848 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -25,20 +25,23 @@ applies, and please also update docstrings as needed.
* Installation Changes in Emacs 29.1
---
-** Ahead-of-time native compilation can now be specified via configure.
-Use '--with-native-compilation=aot' to specify that all the Lisp files
+** Ahead-of-time native compilation can now be requested via configure.
+Use '--with-native-compilation=aot' to request that all the Lisp files
in the Emacs tree should be natively compiled ahead of time. (This is
slow on most machines.)
+This feature existed in Emacs 28.1, but was less easy to request.
+
+++
** Emacs can be built with the tree-sitter parsing library.
-This library, together with grammar libraries, provides incremental
-parsing capabilities for several popular programming languages and
-other formatted files. Emacs built with this library offers major
-modes, described elsewhere in this file, that are based on the
-tree-sitter's parsers. If you have the tree-sitter library
-installed, the configure script will automatically include it in the
-build; use '--without-tree-sitter' at configure time to disable that.
+This library, together with separate grammar libraries for each
+language, provides incremental parsing capabilities for several
+popular programming languages and other formatted files. Emacs built
+with this library offers major modes, described elsewhere in this
+file, that are based on the tree-sitter's parsers. If you have the
+tree-sitter library installed, the configure script will automatically
+include it in the build; use '--without-tree-sitter' at configure time
+to disable that.
Emacs modes based on the tree-sitter library require an additional
grammar library for each mode. These grammar libraries provide the
@@ -51,29 +54,31 @@ yourself. Many libraries can be downloaded from the
tree-sitter site:
https://github.com/tree-sitter
-To compile such a library, compile the files "scanner.c" and "parser.c"
-(sometimes named "scanner.cc" and "parser.cc") in the "src" subdirectory
-of the library's source tree using the C or C++ compiler, then link
-these two files into a shared library named "libtree-sitter-LANG.so",
-where LANG is the name of the language supported by the grammar as it
-is expected by the Emacs major mode (for example, "c" for 'c-ts-mode',
-"cpp" for 'c++-ts-mode', "python" for 'python-ts-mode', etc.). Then place
-the shared library you've built in the same directory where you keep
-the other shared libraries used by Emacs, or in the "tree-sitter"
-subdirectory of your 'user-emacs-directory', or in a directory
-mentioned in the variable 'treesit-extra-load-path'.
-
-You only need to install language grammar libraries required by the
-Emacs modes you will use, as Emacs loads these libraries only when the
-corresponding mode is turned on in some buffer for the first time in
-an Emacs session.
-
Emacs provides a user command, 'treesit-install-language-grammar',
that automates the download and build process of a grammar library.
It prompts for the language, the URL of the language grammar's VCS
repository, and then uses the installed C/C++ compiler to build the
library and install it.
+You can also do this manually. To compile such a library after
+cloning its Git repository, compile the files "scanner.c" and
+"parser.c" (sometimes named "scanner.cc" and "parser.cc") in the "src"
+subdirectory of the library's source tree using the C or C++ compiler,
+then link these two files into a shared library named
+"libtree-sitter-LANG.so", where LANG is the name of the language
+supported by the grammar as it is expected by the Emacs major mode
+(for example, "c" for 'c-ts-mode', "cpp" for 'c++-ts-mode', "python"
+for 'python-ts-mode', etc.). Then place the shared library you've
+built in the same directory where you keep the other shared libraries
+used by Emacs, or in the "tree-sitter" subdirectory of your
+'user-emacs-directory', or in a directory mentioned in the variable
+'treesit-extra-load-path'.
+
+You only need to install language grammar libraries required by the
+Emacs modes you will use, as Emacs loads these libraries only when the
+corresponding mode is turned on in some buffer for the first time in
+an Emacs session.
+
+++
** Emacs can be built with built-in support for accessing SQLite databases.
This uses the popular sqlite3 library, and can be disabled by using
@@ -350,6 +355,15 @@ next button, even if the mode has bound it to something
else. This
also means that 'TAB' on a button in an 'outline-minor-mode' heading
will move point instead of collapsing the outline.
+---
+** 'outline-minor-mode-cycle-map' is now parent of 'outline-minor-mode'.
+Instead of adding text property 'keymap' with 'outline-minor-mode-cycle'
+on outline headings in 'outline-minor-mode', the keymap
+'outline-minor-mode-cycle' is now active in the whole buffer.
+But keybindings in 'outline-minor-mode-cycle' still take effect
+only on outline headings because they are bound with the help of
+'outline-minor-mode-cycle--bind' that checks if point is on a heading.
+
---
** 'Info-default-directory-list' is no longer populated at Emacs startup.
If you have code in your init file that removes directories from
@@ -797,10 +811,10 @@ filter/sentinel error has been handled.
** New faces for font-lock.
These faces are primarily meant for use with tree-sitter. They are:
'font-lock-bracket-face', 'font-lock-delimiter-face',
-'font-lock-escape-face', 'font-lock-number-face',
-'font-lock-regexp-face',
-'font-lock-misc-punctuation-face', 'font-lock-operator-face',
-'font-lock-property-face', and 'font-lock-punctuation-face'.
+'font-lock-escape-face', 'font-lock-misc-punctuation-face',
+'font-lock-number-face', 'font-lock-operator-face',
+'font-lock-property-face', and 'font-lock-punctuation-face',
+'font-lock-regexp-face'.
+++
** New face 'variable-pitch-text'.
@@ -1112,6 +1126,12 @@ buffer, and you can use 'RET' to cycle outline
visibility. When
the value is 'in-margins', Outline Minor Mode uses the window margins
for buttons that hide/show outlines.
++++
+*** Buttons and headings now have their own keymaps.
+'outline-button-icon-map', 'outline-overlay-button-map', and
+'outline-inserted-button-map' are now available as defined keymaps
+instead of being anonymous keymaps.
+
** Windows
+++
@@ -1627,6 +1647,20 @@ randomness as before, or to use a bag).
*** New user option 'battery-update-functions'.
This can be used to trigger actions based on the battery status.
+** DocView
+
+---
+*** doc-view can now generate SVG images when viewing PDF files.
+If Emacs is built with SVG support, doc-view can generate SVG files
+when using MuPDF as the converter for PDF files, which generally leads
+to sharper images (especially when zooming), and allows customization
+of background and foreground color of the page via the new user
+options 'doc-view-svg-background' and 'doc-view-svg-foreground'. To
+activate this behavior, set 'doc-view-mupdf-use-svg' to non-nil if
+your Emacs has SVG support. Note that, with some versions of MuPDF,
+SVG generation is known to sometimes produce SVG files that are buggy
+or can take a long time to render.
+
** Enriched Mode
+++
@@ -1652,6 +1686,14 @@ command is installed.
---
*** C++ Mode now supports most of the new features in the C++20 Standard.
+---
+*** In Objective-C Mode, no extra types are recognized by default.
+The default value of 'objc-font-lock-extra-types' has been changed to
+nil, since too many identifiers were getting misfontified as types.
+This may cause some actual types not to get fontified. To get the old
+behavior back, customize the user option to the value suggested in its
+doc string.
+
** Cperl Mode
---
@@ -2044,7 +2086,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,
-does a "push" command afterwards.
+does a "push" command afterwards. Currently supported in Git and Bzr.
+++
*** 'C-x v b' prefix key is used now for branch commands.
@@ -2054,7 +2096,7 @@ The VC Directory buffer now uses the prefix 'b' for these
branch-related
commands.
+++
-*** New command '%' ('vc-dir-mark-by-regexp').
+*** New command 'vc-dir-mark-by-regexp' bound to '% m' and '* %'.
This command marks files based on a regexp. If given a prefix
argument, unmark instead.
@@ -2688,6 +2730,13 @@ some commands and user options are no longer needed and
are now obsolete:
'image-dired-display-window-width-correction',
'image-dired-temp-image-file'.
+** Exif
+
+---
+*** New function 'exif-field'.
+This is a convenience function to extract the field data from
+'exif-parse-file' and 'exif-parse-buffer'.
+
** Bookmarks
---
@@ -2709,13 +2758,6 @@ It is bound to the new command
'bookmark-edit-annotation-cancel'.
This option controls the bitmap used to indicate bookmarks in the
fringe (or nil to disable showing this marker).
-** Exif
-
----
-*** New function 'exif-field'.
-This is a convenience function to extract the field data from
-'exif-parse-file' and 'exif-parse-buffer'.
-
** Xwidget
---
@@ -3156,19 +3198,19 @@ indentation, and navigation by defuns based on parsing
the buffer text
by a tree-sitter parser. Some major modes also offer support for
Imenu and 'which-func'.
-Where major modes already exist in Emacs for editing certain kinds of
-files, the new modes based on tree-sitter are for now entirely
-optional, and you must turn them on manually, or customize
-'auto-mode-alist' to turn them on automatically.
+The new modes based on tree-sitter are for now entirely optional, and
+you must turn them on manually, or load them in your init file, or
+customize 'auto-mode-alist' to turn them on automatically for certain
+files. You can also customize 'major-mode-remap-alist' to
+automatically turn on some tree-sitter based modes for the same files
+for which a "built-in" mode would be turned on. For example:
-Where no major modes previously existed in Emacs for editing the kinds
-of files for which Emacs now provides a tree-sitter based mode, Emacs
-will now try to enable these new modes automatically when you visit
-such files, and will display a warning if the tree-sitter library or
-the parser grammar library is not available. To prevent the warnings,
-either build Emacs with tree-sitter and install the grammar libraries,
-or customize 'auto-mode-alist' to specify some other major mode (or
-even 'fundamental-mode') for those kinds of files.
+ (add-to-list 'major-mode-remap-alist '(ruby-mode . ruby-ts-mode))
+
+If you try these modes and don't like them, you can go back to the
+"built-in" modes by restarting Emacs. But please tell us why you
+didn't like the tree-sitter based modes, so that we could try
+improving them.
Each major mode based on tree-sitter needs a language grammar library,
usually named "libtree-sitter-LANG.so" ("libtree-sitter-LANG.dll" on
@@ -3185,20 +3227,18 @@ We recommend to install these libraries in one of the
standard system
locations (the last place in the above list).
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
+of the above places, the mode will display a warning 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.
+in the TypeScript language.
+++
*** 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.
+in the TypeScript language, with support for TSX.
+++
*** New major mode 'c-ts-mode'.
@@ -3210,6 +3250,11 @@ programs in the C language.
An optional major mode based on the tree-sitter library for editing
programs in the C++ language.
++++
+*** New command 'c-or-c++-ts-mode'.
+A command that automatically guesses the language of a header file,
+and enables either 'c-ts-mode' or 'c++-ts-mode' accordingly.
+
+++
*** New major mode 'java-ts-mode'.
An optional major mode based on the tree-sitter library for editing
@@ -3243,15 +3288,11 @@ 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.
+Dockerfiles.
+++
*** 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'.
@@ -3261,23 +3302,22 @@ files written in TOML, a format for writing
configuration files.
+++
*** 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.
+the Go language.
+++
*** 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".
+files.
+++
*** 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.
+written in YAML.
+++
*** 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.
+the Rust language.
---
*** New major mode 'ruby-ts-mode'.
@@ -3777,7 +3817,7 @@ These function now take an optional comparison PREDICATE
argument.
** 'read-multiple-choice' can now use long-form answers.
+++
-** 'M-c' in 'read-regexp' now toggles case folding.
+** 'M-s c' in 'read-regexp' now toggles case folding.
+++
** 'completing-read' now allows a function as its REQUIRE-MATCH argument.
@@ -4235,6 +4275,24 @@ vectors and strings.
The new 'key' type can be used for options that should be a valid key
according to 'key-valid-p'. The type 'key-sequence' is now obsolete.
++++
+** New function 'define-keymap'.
+This function allows defining a number of keystrokes with one form.
+
++++
+** New macro 'defvar-keymap'.
+This macro allows defining keymap variables more conveniently.
+
+** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap.
+Use ':repeat t' to have all bindings be repeatable or for more
+advanced usage:
+
+ :repeat (:enter (commands ...) :exit (commands ...))
+
+---
+** 'kbd' can now be used in built-in, preloaded libraries.
+It no longer depends on edmacro.el and cl-lib.el.
+
+++
** New substitution in docstrings and 'substitute-command-keys'.
Use \\`KEYSEQ' to insert a literal key sequence "KEYSEQ" (for example
@@ -4244,6 +4302,18 @@ be used only when a key sequence has no corresponding
command, for
example when it is read directly with 'read-key-sequence'. It must be
a valid key sequence according to 'key-valid-p'.
+---
+** 'lookup-key' is more permissive when searching for extended menu items.
+In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking
+for a menu item '[menu-bar Foo-Bar]', first try to find an exact
+match, then look for the lowercased '[menu-bar foo-bar]'.
+
+This has been extended, so that when looking for a menu item with a
+symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for
+an exact match, then the lowercased '[menu-bar foo\ bar]' and finally
+'[menu-bar foo-bar]'. This further improves backwards-compatibility
+when converting menus to use 'easy-menu-define'.
+
+++
** New function 'file-name-split'.
This returns a list of all the components of a file name.
@@ -4312,15 +4382,21 @@ whose matches are to be replaced. If these variables
are nil (which
is the default), 'query-replace' and 'query-replace-regexp' take the
default value from the previous FROM-TO pair.
----
-** New user option 'pp-use-max-width'.
-If non-nil, 'pp' will attempt to limit the line length when formatting
-long lists and vectors.
+** Lisp pretty-printer ('pp')
---
-** New function 'pp-emacs-lisp-code'.
+*** New function 'pp-emacs-lisp-code'.
'pp' formats general Lisp sexps. This function does much the same,
-but applies formatting rules appropriate for Emacs Lisp code.
+but applies formatting rules appropriate for Emacs Lisp code. Note
+that this could currently be quite slow, and is thus appropriate only
+for relatively small code fragments.
+
+---
+*** New user option 'pp-use-max-width'.
+If non-nil, 'pp' and all 'pp-*' commands that format the results, will
+attempt to limit the line length when formatting long lists and
+vectors. This uses 'pp-emacs-lisp-code', and thus could be slow for
+large lists.
+++
** New function 'file-has-changed-p'.
@@ -4437,24 +4513,6 @@ permanent local variables.
** Third 'mapconcat' argument SEPARATOR is now optional.
An explicit nil always meant the empty string, now it can be left out.
-+++
-** New function 'define-keymap'.
-This function allows defining a number of keystrokes with one form.
-
-+++
-** New macro 'defvar-keymap'.
-This macro allows defining keymap variables more conveniently.
-
-** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap.
-Use ':repeat t' to have all bindings be repeatable or for more
-advanced usage:
-
- :repeat (:enter (commands ...) :exit (commands ...))
-
----
-** 'kbd' can now be used in built-in, preloaded libraries.
-It no longer depends on edmacro.el and cl-lib.el.
-
+++
** New function 'image-at-point-p'.
This function returns t if point is on a valid image, and nil
@@ -4478,18 +4536,6 @@ separate glyphs. This takes into account combining
characters and
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.
-In Emacs 28.1, the behavior of 'lookup-key' was changed: when looking
-for a menu item '[menu-bar Foo-Bar]', first try to find an exact
-match, then look for the lowercased '[menu-bar foo-bar]'.
-
-This has been extended, so that when looking for a menu item with a
-symbol containing spaces, as in '[menu-bar Foo\ Bar]', first look for
-an exact match, then the lowercased '[menu-bar foo\ bar]' and finally
-'[menu-bar foo-bar]'. This further improves backwards-compatibility
-when converting menus to use 'easy-menu-define'.
-
** Xwidget
+++
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index d4354e5f7ae..9ef231d4b16 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -628,6 +628,18 @@ To work around the problem, customize the option
'window-adjust-process-window-size-function' to "Do not adjust process
window sizes" (Lisp value 'ignore').
+*** Displaying PDF files in DocView produces an empty buffer.
+
+This can happen if your Emacs is configured to convert PDF to SVG for
+display, and the version of the MuPDF package you have installed has a
+a known bug, whereby it sometimes produces invalid SVG images.
+Version 1.21 of MuPDF is known to be affected.
+
+The solution is either to upgrade or downgrade to a version of MuPDF
+that doesn't have this bug, or to disable conversion of PDF files to
+SVG images by customizing the user option 'doc-view-mupdf-use-svg'.
+Emacs will then convert PDF to PNG images instead.
+
*** In Inferior Python mode, input is echoed and native completion doesn't
work.
<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25753>
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index 04d46756155..093dfceafa7 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,5 +1,5 @@
% Reference Card for Org Mode
-\def\orgversionnumber{9.6}
+\def\orgversionnumber{9.6.1}
\def\versionyear{2021} % latest update
\input emacsver.tex
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index 3f144401d65..5b82cf1151c 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -193,18 +193,18 @@ LIBRESOLV=@LIBRESOLV@
## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL
LIBS_MAIL=@LIBS_MAIL@
## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME
-LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
+CLOCK_TIME_LIB = @CLOCK_TIME_LIB@
## empty or -lbcrypt or -ladvapi32
-LIB_GETRANDOM = @LIB_GETRANDOM@
+GETRANDOM_LIB = @GETRANDOM_LIB@
## Whatever libraries are needed for euidaccess
-LIB_EACCESS=@LIB_EACCESS@
+EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@
## Libraries needed for file_has_acl
FILE_HAS_ACL_LIB=@FILE_HAS_ACL_LIB@
## empty or -lwsock2 for MinGW
LIB_WSOCK32=@LIB_WSOCK32@
## Extra libraries for etags
-LIBS_ETAGS = $(LIB_CLOCK_GETTIME) $(LIB_GETRANDOM)
+LIBS_ETAGS = $(CLOCK_TIME_LIB) $(GETRANDOM_LIB)
HAVE_SECCOMP=@HAVE_SECCOMP@
HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
@@ -426,13 +426,14 @@ pop.o: ${srcdir}/pop.c ${srcdir}/pop.h
${srcdir}/../lib/min-max.h $(config_h)
emacsclient${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(config_h)
$(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< \
$(NTLIB) $(LOADLIBES) \
- $(LIB_WSOCK32) $(LIB_EACCESS) $(FILE_HAS_ACL_LIB) $(LIBS_ECLIENT) \
+ $(LIB_WSOCK32) $(EUIDACCESS_LIBGEN) \
+ $(FILE_HAS_ACL_LIB) $(LIBS_ECLIENT) \
-o $@
emacsclientw${EXEEXT}: ${srcdir}/emacsclient.c $(NTLIB) $(CLIENTRES)
$(config_h)
$(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $(CLIENTRES) -mwindows $< \
$(LOADLIBES) \
- $(LIB_WSOCK32) $(LIB_EACCESS) $(LIBS_ECLIENT) -o $@
+ $(LIB_WSOCK32) $(EUIDACCESS_LIBGEN) $(LIBS_ECLIENT) -o $@
be-resources: ${srcdir}/be_resources.cc ${config_h}
$(AM_V_CXXLD)$(CXX) ${ALL_CXXFLAGS} ${HAIKU_LIBS} $< -o $@
diff --git a/lib/filename.h b/lib/filename.h
index ab77ca2df91..a2400a9dfe3 100644
--- a/lib/filename.h
+++ b/lib/filename.h
@@ -1,5 +1,5 @@
/* Basic filename support macros.
- Copyright (C) 2001-2022 Free Software Foundation, Inc.
+ Copyright (C) 2001-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 0b4e0458a3c..2097850c812 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -204,6 +204,7 @@ CFLAGS_SOUND = @CFLAGS_SOUND@
CHECK_STRUCTS = @CHECK_STRUCTS@
CLIENTRES = @CLIENTRES@
CLIENTW = @CLIENTW@
+CLOCK_TIME_LIB = @CLOCK_TIME_LIB@
CM_OBJ = @CM_OBJ@
COM_ERRLIB = @COM_ERRLIB@
CPP = @CPP@
@@ -238,6 +239,7 @@ ENOLINK_VALUE = @ENOLINK_VALUE@
EOVERFLOW_HIDDEN = @EOVERFLOW_HIDDEN@
EOVERFLOW_VALUE = @EOVERFLOW_VALUE@
ERRNO_H = @ERRNO_H@
+EUIDACCESS_LIBGEN = @EUIDACCESS_LIBGEN@
EXECINFO_H = @EXECINFO_H@
EXEEXT = @EXEEXT@
FILE_HAS_ACL_LIB = @FILE_HAS_ACL_LIB@
@@ -254,6 +256,7 @@ GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
GETLOADAVG_LIBS = @GETLOADAVG_LIBS@
GETOPT_CDEFS_H = @GETOPT_CDEFS_H@
GETOPT_H = @GETOPT_H@
+GETRANDOM_LIB = @GETRANDOM_LIB@
GFILENOTIFY_CFLAGS = @GFILENOTIFY_CFLAGS@
GFILENOTIFY_LIBS = @GFILENOTIFY_LIBS@
GL_CFLAG_ALLOW_WARNINGS = @GL_CFLAG_ALLOW_WARNINGS@
@@ -940,13 +943,13 @@ LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
LIB_EACCESS = @LIB_EACCESS@
LIB_EXECINFO = @LIB_EXECINFO@
LIB_GETRANDOM = @LIB_GETRANDOM@
-LIB_HAS_ACL = @LIB_HAS_ACL@
LIB_MATH = @LIB_MATH@
LIB_NANOSLEEP = @LIB_NANOSLEEP@
LIB_PTHREAD = @LIB_PTHREAD@
LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_TIMER_TIME = @LIB_TIMER_TIME@
LIB_WSOCK32 = @LIB_WSOCK32@
+LIB_XATTR = @LIB_XATTR@
LIMITS_H = @LIMITS_H@
LN_S_FILEONLY = @LN_S_FILEONLY@
LTLIBGMP = @LTLIBGMP@
@@ -960,6 +963,7 @@ MKDIR_P = @MKDIR_P@
MODULES_OBJ = @MODULES_OBJ@
MODULES_SECONDARY_SUFFIX = @MODULES_SECONDARY_SUFFIX@
MODULES_SUFFIX = @MODULES_SUFFIX@
+NANOSLEEP_LIB = @NANOSLEEP_LIB@
NATIVE_COMPILATION_AOT = @NATIVE_COMPILATION_AOT@
NEXT_ASSERT_H = @NEXT_ASSERT_H@
NEXT_AS_FIRST_DIRECTIVE_ASSERT_H = @NEXT_AS_FIRST_DIRECTIVE_ASSERT_H@
@@ -1036,7 +1040,9 @@ PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@
PRIPTR_PREFIX = @PRIPTR_PREFIX@
PROFILING_CFLAGS = @PROFILING_CFLAGS@
PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@
+PTHREAD_SIGMASK_LIB = @PTHREAD_SIGMASK_LIB@
PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@
+QCOPY_ACL_LIB = @QCOPY_ACL_LIB@
RALLOC_OBJ = @RALLOC_OBJ@
RANLIB = @RANLIB@
REPLACE_ACCESS = @REPLACE_ACCESS@
@@ -1223,6 +1229,7 @@ SUBDIR_MAKEFILES_IN = @SUBDIR_MAKEFILES_IN@
SYSTEM_TYPE = @SYSTEM_TYPE@
SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@
TERMCAP_OBJ = @TERMCAP_OBJ@
+TIMER_TIME_LIB = @TIMER_TIME_LIB@
TIME_H_DEFINES_STRUCT_TIMESPEC = @TIME_H_DEFINES_STRUCT_TIMESPEC@
TIME_H_DEFINES_TIME_UTC = @TIME_H_DEFINES_TIME_UTC@
TOOLKIT_LIBW = @TOOLKIT_LIBW@
diff --git a/lib/malloc/scratch_buffer.h b/lib/malloc/scratch_buffer.h
index a9bdcadec21..33fd2b29cd5 100644
--- a/lib/malloc/scratch_buffer.h
+++ b/lib/malloc/scratch_buffer.h
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2022 Free Software Foundation, Inc.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_grow.c b/lib/malloc/scratch_buffer_grow.c
index 9a5e4dbb1eb..a5e8f2f7230 100644
--- a/lib/malloc/scratch_buffer_grow.c
+++ b/lib/malloc/scratch_buffer_grow.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2022 Free Software Foundation, Inc.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_grow_preserve.c
b/lib/malloc/scratch_buffer_grow_preserve.c
index 3fe5a0720ec..c0b5d87b7e4 100644
--- a/lib/malloc/scratch_buffer_grow_preserve.c
+++ b/lib/malloc/scratch_buffer_grow_preserve.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2022 Free Software Foundation, Inc.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/malloc/scratch_buffer_set_array_size.c
b/lib/malloc/scratch_buffer_set_array_size.c
index 89c37a950e9..24c39350ade 100644
--- a/lib/malloc/scratch_buffer_set_array_size.c
+++ b/lib/malloc/scratch_buffer_set_array_size.c
@@ -1,5 +1,5 @@
/* Variable-sized buffer with on-stack default allocation.
- Copyright (C) 2015-2022 Free Software Foundation, Inc.
+ Copyright (C) 2015-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h
index 170764eabc8..709c36bdf56 100644
--- a/lib/mktime-internal.h
+++ b/lib/mktime-internal.h
@@ -1,5 +1,5 @@
/* Internals of mktime and related functions
- Copyright 2016-2022 Free Software Foundation, Inc.
+ Copyright 2016-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@cs.ucla.edu>.
diff --git a/lib/mktime.c b/lib/mktime.c
index 7dc9d67ef9d..94a4320e6ca 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -1,5 +1,5 @@
/* Convert a 'struct tm' to a time_t value.
- Copyright (C) 1993-2022 Free Software Foundation, Inc.
+ Copyright (C) 1993-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Paul Eggert <eggert@twinsun.com>.
diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c
index 883bcf7d588..0f4159b7fd9 100644
--- a/lib/qcopy-acl.c
+++ b/lib/qcopy-acl.c
@@ -23,6 +23,20 @@
#include "acl-internal.h"
+#if USE_XATTR
+
+# include <attr/libattr.h>
+
+/* Returns 1 if NAME is the name of an extended attribute that is related
+ to permissions, i.e. ACLs. Returns 0 otherwise. */
+
+static int
+is_attr_permissions (const char *name, struct error_context *ctx)
+{
+ return attr_copy_action (name, ctx) == ATTR_ACTION_PERMISSIONS;
+}
+
+#endif /* USE_XATTR */
/* Copy access control lists from one file to another. If SOURCE_DESC is
a valid file descriptor, use file descriptor operations, else use
@@ -39,13 +53,33 @@ int
qcopy_acl (const char *src_name, int source_desc, const char *dst_name,
int dest_desc, mode_t mode)
{
- struct permission_context ctx;
int ret;
+#ifdef USE_XATTR
+ /* in case no ACLs present and also to set higher mode bits
+ we chmod before setting ACLs as doing it after could overwrite them
+ (especially true for NFSv4, posix ACL has that ugly "mask" hack that
+ nobody understands) */
+ ret = chmod_or_fchmod (dst_name, dest_desc, mode);
+ /* Rather than fiddling with acls one by one, we just copy the whole ACL
xattrs
+ (Posix or NFSv4). Of course, that won't address ACLs conversion
+ (i.e. posix <-> nfs4) but we can't do it anyway, so for now, we don't care
+ Functions attr_copy_* return 0 in case we copied something OR nothing
+ to copy */
+ if (ret == 0)
+ ret = source_desc <= 0 || dest_desc <= 0
+ ? attr_copy_file (src_name, dst_name, is_attr_permissions, NULL)
+ : attr_copy_fd (src_name, source_desc, dst_name, dest_desc,
+ is_attr_permissions, NULL);
+#else
+ /* no XATTR, so we proceed the old dusty way */
+ struct permission_context ctx;
+
ret = get_permissions (src_name, source_desc, mode, &ctx);
if (ret != 0)
return -2;
ret = set_permissions (&ctx, dst_name, dest_desc);
free_permission_context (&ctx);
+#endif
return ret;
}
diff --git a/lib/regex.c b/lib/regex.c
index ff1176782e4..3beb0deb987 100644
--- a/lib/regex.c
+++ b/lib/regex.c
@@ -1,5 +1,5 @@
/* Extended regular expression matching and search library.
- Copyright (C) 2002-2022 Free Software Foundation, Inc.
+ Copyright (C) 2002-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
Contributed by Isamu Hasegawa <isamu@yamato.ibm.com>.
diff --git a/lib/regex.h b/lib/regex.h
index a7e0bd02757..9ef0252ffff 100644
--- a/lib/regex.h
+++ b/lib/regex.h
@@ -1,6 +1,6 @@
/* Definitions for data structures and routines for the regular
expression library.
- Copyright (C) 1985, 1989-2022 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1989-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/timegm.c b/lib/timegm.c
index a1b19efc392..b47025a0545 100644
--- a/lib/timegm.c
+++ b/lib/timegm.c
@@ -1,6 +1,6 @@
/* Convert UTC calendar time to simple time. Like mktime but assumes UTC.
- Copyright (C) 1994-2022 Free Software Foundation, Inc.
+ Copyright (C) 1994-2023 Free Software Foundation, Inc.
This file is part of the GNU C Library.
The GNU C Library is free software; you can redistribute it and/or
diff --git a/lib/verify.h b/lib/verify.h
index 17d6e78c816..b63cb264321 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -258,7 +258,9 @@ template <int w>
/* @assert.h omit start@ */
-#if 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))
+#if defined __clang_major__ && __clang_major__ < 5
+# define _GL_HAS_BUILTIN_TRAP 0
+#elif 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))
# define _GL_HAS_BUILTIN_TRAP 1
#elif defined __has_builtin
# define _GL_HAS_BUILTIN_TRAP __has_builtin (__builtin_trap)
@@ -266,7 +268,9 @@ template <int w>
# define _GL_HAS_BUILTIN_TRAP 0
#endif
-#if 4 < __GNUC__ + (5 <= __GNUC_MINOR__)
+#if defined __clang_major__ && __clang_major__ < 5
+# define _GL_HAS_BUILTIN_UNREACHABLE 0
+#elif 4 < __GNUC__ + (5 <= __GNUC_MINOR__)
# define _GL_HAS_BUILTIN_UNREACHABLE 1
#elif defined __has_builtin
# define _GL_HAS_BUILTIN_UNREACHABLE __has_builtin (__builtin_unreachable)
diff --git a/lisp/align.el b/lisp/align.el
index 569186d241d..79a75dcec79 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -179,7 +179,8 @@ If nil, then no messages will ever be printed to the
minibuffer."
:type '(choice (const :tag "Align a large region silently" nil) integer)
:group 'align)
-(defcustom align-c++-modes '(c++-mode c-mode java-mode)
+(defcustom align-c++-modes '( c++-mode c-mode java-mode
+ c-ts-mode c++-ts-mode)
"A list of modes whose syntax resembles C/C++."
:type '(repeat symbol)
:group 'align)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index b260d889955..e95f45f1804 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -54,6 +54,8 @@
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(defgroup apropos nil
"Apropos commands for users and programmers."
:group 'help
@@ -193,9 +195,6 @@ property list, WIDGET-DOC is the widget docstring, FACE-DOC
is
the face docstring, and CUS-GROUP-DOC is the custom group
docstring. Each docstring is either nil or a string.")
-(defvar apropos-item ()
- "Current item in or for `apropos-accumulator'.")
-
(defvar apropos-synonyms '(
("find" "open" "edit")
("kill" "cut")
@@ -886,6 +885,38 @@ Optional arg BUFFER (default: current buffer) is the
buffer to check."
(if (consp pattern) "keywords " "")
pattern))))
+(defun apropos--map-preloaded-atoms (f)
+ "Like `mapatoms' but only enumerates functions&vars that are predefined."
+ (let ((preloaded-regexp
+ (concat "\\`"
+ (regexp-quote lisp-directory)
+ (regexp-opt preloaded-file-list)
+ "\\.elc?\\'")))
+ ;; FIXME: I find this regexp approach brittle. Maybe a better
+ ;; option would be find/record the nthcdr of `load-history' which
+ ;; corresponds to the `load-history' state when we dumped.
+ ;; (Then again, maybe an even better approach would be to record the
+ ;; state of the `obarray' when we dumped, which we may also be able to
+ ;; use in `bytecomp' to provide a clean initial environment?)
+ (dolist (x load-history)
+ (when (string-match preloaded-regexp (car x))
+ (dolist (def (cdr x))
+ (cond
+ ((symbolp def) (funcall f def))
+ ((eq 'defun (car-safe def)) (funcall f (cdr def)))))))))
+
+(defun apropos--documentation-add (symbol doc pos)
+ (when (setq doc (apropos-documentation-internal doc))
+ (let ((score (apropos-score-doc doc))
+ (item (cdr (assq symbol apropos-accumulator))))
+ (unless item
+ (push (cons symbol
+ (setq item (list (apropos-score-symbol symbol 2)
+ nil nil)))
+ apropos-accumulator))
+ (setf (nth pos item) doc)
+ (setcar item (+ (car item) score)))))
+
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
"Show symbols whose documentation contains matches for PATTERN.
@@ -894,10 +925,11 @@ or a regexp (using some regexp special characters). If
it is a word,
search for matches for that word as a substring. If it is a list of words,
search for matches for any two (or more) of those words.
-Note that by default this command only searches in the file specified by
-`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument]
prefix,
-or if `apropos-do-all' is non-nil, it searches all currently defined
-documentation strings.
+Note that by default this command only searches in the functions predefined
+at Emacs startup, i.e., the primitives implemented in C or preloaded in the
+Emacs dump image.
+With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, it
searches
+all currently defined documentation strings.
Returns list of symbols and documentation found."
;; The doc used to say that DO-ALL includes key-bindings info in the
@@ -907,40 +939,28 @@ Returns list of symbols and documentation found."
(setq apropos--current (list #'apropos-documentation pattern do-all))
(apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
- (setq apropos-accumulator () apropos-files-scanned ())
- (with-temp-buffer
- (let ((standard-input (current-buffer))
- (apropos-sort-by-scores apropos-documentation-sort-by-scores)
- f v sf sv)
- (apropos-documentation-check-doc-file)
- (if do-all
- (mapatoms
- (lambda (symbol)
- (setq f (apropos-safe-documentation symbol)
- v (get symbol 'variable-documentation))
- (if (integerp v) (setq v nil))
- (setq f (apropos-documentation-internal f)
- v (apropos-documentation-internal v))
- (setq sf (apropos-score-doc f)
- sv (apropos-score-doc v))
- (if (or f v)
- (if (setq apropos-item
- (cdr (assq symbol apropos-accumulator)))
- (progn
- (if f
- (progn
- (setcar (nthcdr 1 apropos-item) f)
- (setcar apropos-item (+ (car apropos-item) sf))))
- (if v
- (progn
- (setcar (nthcdr 2 apropos-item) v)
- (setcar apropos-item (+ (car apropos-item) sv)))))
- (setq apropos-accumulator
- (cons (list symbol
- (+ (apropos-score-symbol symbol 2) sf sv)
- f v)
- apropos-accumulator)))))))
- (apropos-print nil "\n----------------\n" nil t))))
+ (let ((apropos-accumulator ())
+ (apropos-files-scanned ())
+ (delayed (make-hash-table :test #'equal)))
+ (with-temp-buffer
+ (let ((standard-input (current-buffer))
+ (apropos-sort-by-scores apropos-documentation-sort-by-scores)
+ f v)
+ (apropos-documentation-check-doc-file)
+ (funcall
+ (if do-all #'mapatoms #'apropos--map-preloaded-atoms)
+ (lambda (symbol)
+ (setq f (apropos-safe-documentation symbol)
+ v (get symbol 'variable-documentation))
+ (if (integerp v) (setq v nil))
+ (if (consp f)
+ (push (list symbol (cdr f) 1) (gethash (car f) delayed))
+ (apropos--documentation-add symbol f 1))
+ (if (consp v)
+ (push (list symbol (cdr v) 2) (gethash (car v) delayed))
+ (apropos--documentation-add symbol v 2))))
+ (maphash #'apropos--documentation-add-from-elc delayed)
+ (apropos-print nil "\n----------------\n" nil t)))))
(defun apropos-value-internal (predicate symbol function)
@@ -961,11 +981,11 @@ Returns list of symbols and documentation found."
symbol)))
(defun apropos-documentation-internal (doc)
+ ;; By the time we get here, refs to DOC or to .elc files should have
+ ;; been converted into actual strings.
+ (cl-assert (not (or (consp doc) (integerp doc))))
(cond
- ((consp doc)
- (apropos-documentation-check-elc-file (car doc)))
- ((and doc
- ;; Sanity check in case bad data sneaked into the
+ ((and ;; Sanity check in case bad data sneaked into the
;; documentation slot.
(stringp doc)
(string-match apropos-all-words-regexp doc)
@@ -1032,108 +1052,62 @@ non-nil."
;; So we exclude them.
(cond ((= 3 type) (boundp symbol))
((= 2 type) (fboundp symbol))))
- (or (and (setq apropos-item (assq symbol apropos-accumulator))
- (setcar (cdr apropos-item)
- (apropos-score-doc doc)))
- (setq apropos-item (list symbol
- (+ (apropos-score-symbol symbol 2)
- (apropos-score-doc doc))
- nil nil)
- apropos-accumulator (cons apropos-item
- apropos-accumulator)))
- (when apropos-match-face
- (setq doc (substitute-command-keys doc))
- (if (or (string-match apropos-pattern-quoted doc)
- (string-match apropos-all-words-regexp doc))
- (put-text-property (match-beginning 0)
- (match-end 0)
- 'face apropos-match-face doc)))
- (setcar (nthcdr type apropos-item) doc))))
+ (let ((apropos-item (assq symbol apropos-accumulator)))
+ (or (and apropos-item
+ (setcar (cdr apropos-item)
+ (apropos-score-doc doc)))
+ (setq apropos-item (list symbol
+ (+ (apropos-score-symbol symbol 2)
+ (apropos-score-doc doc))
+ nil nil)
+ apropos-accumulator (cons apropos-item
+ apropos-accumulator)))
+ (when apropos-match-face
+ (setq doc (substitute-command-keys doc))
+ (if (or (string-match apropos-pattern-quoted doc)
+ (string-match apropos-all-words-regexp doc))
+ (put-text-property (match-beginning 0)
+ (match-end 0)
+ 'face apropos-match-face doc)))
+ (setcar (nthcdr type apropos-item) doc)))))
(setq sepa (goto-char sepb)))))
-(defun apropos-documentation-check-elc-file (file)
- ;; .elc files have the location of the file specified as #$, but for
- ;; built-in files, that's a relative name (while for the rest, it's
- ;; absolute). So expand the name in the former case.
- (unless (file-name-absolute-p file)
- (setq file (expand-file-name file lisp-directory)))
- (if (or (member file apropos-files-scanned)
- (not (file-exists-p file)))
- nil
- (let (symbol doc beg end this-is-a-variable)
- (setq apropos-files-scanned (cons file apropos-files-scanned))
- (erase-buffer)
- (insert-file-contents file)
- (while (search-forward "\n#@" nil t)
- ;; Read the comment length, and advance over it.
- (setq end (read)
- beg (1+ (point))
- end (+ (point) end -1))
- (forward-char)
- (if (save-restriction
+(defun apropos--documentation-add-from-elc (file defs)
+ (erase-buffer)
+ (insert-file-contents
+ (if (file-name-absolute-p file) file
+ (expand-file-name file lisp-directory)))
+ (pcase-dolist (`(,symbol ,begbyte ,pos) defs)
+ ;; We presume the file-bytes are the same as the buffer bytes,
+ ;; which should indeed be the case because .elc files use the
+ ;; `emacs-internal' encoding.
+ (let* ((beg (byte-to-position (+ (point-min) begbyte)))
+ (sizeend (1- beg))
+ (size (save-excursion
+ (goto-char beg)
+ (skip-chars-backward " 0-9")
+ (cl-assert (looking-back "#@" (- (point) 2)))
+ (string-to-number (buffer-substring (point) sizeend))))
+ (end (byte-to-position (+ begbyte size -1))))
+ (when (save-restriction
;; match ^ and $ relative to doc string
(narrow-to-region beg end)
+ (goto-char (point-min))
(re-search-forward apropos-all-words-regexp nil t))
- (progn
- (goto-char (+ end 2))
- (setq doc (buffer-substring beg end)
- end (- (match-end 0) beg)
- beg (- (match-beginning 0) beg))
- (when (apropos-true-hit-doc doc)
- (setq this-is-a-variable (looking-at "(def\\(var\\|const\\) ")
- symbol (progn
- (skip-chars-forward "(a-z")
- (forward-char)
- (read))
- symbol (if (consp symbol)
- (nth 1 symbol)
- symbol))
- (if (if this-is-a-variable
- (get symbol 'variable-documentation)
- (and (fboundp symbol) (apropos-safe-documentation
symbol)))
- (progn
- (or (and (setq apropos-item (assq symbol
apropos-accumulator))
- (setcar (cdr apropos-item)
- (+ (cadr apropos-item)
(apropos-score-doc doc))))
- (setq apropos-item (list symbol
- (+ (apropos-score-symbol
symbol 2)
- (apropos-score-doc doc))
- nil nil)
- apropos-accumulator (cons apropos-item
- apropos-accumulator)))
- (when apropos-match-face
- (setq doc (substitute-command-keys doc))
- (if (or (string-match apropos-pattern-quoted doc)
- (string-match apropos-all-words-regexp doc))
- (put-text-property (match-beginning 0)
- (match-end 0)
- 'face apropos-match-face doc)))
- (setcar (nthcdr (if this-is-a-variable 3 2)
- apropos-item)
- doc))))))))))
-
-
+ (let ((doc (buffer-substring beg end)))
+ (when (apropos-true-hit-doc doc)
+ (apropos--documentation-add symbol doc pos)))))))
(defun apropos-safe-documentation (function)
"Like `documentation', except it avoids calling `get_doc_string'.
Will return nil instead."
- (while (and function (symbolp function))
- (setq function (symbol-function function)))
- (if (eq (car-safe function) 'macro)
- (setq function (cdr function)))
- (setq function (if (byte-code-function-p function)
- (if (> (length function) 4)
- (aref function 4))
- (if (autoloadp function)
- (nth 2 function)
- (if (eq (car-safe function) 'lambda)
- (if (stringp (nth 2 function))
- (nth 2 function)
- (if (stringp (nth 3 function))
- (nth 3 function)))))))
- (if (integerp function)
- nil
- function))
+ (when (setq function (indirect-function function))
+ ;; FIXME: `function-documentation' says not to call it, but `documentation'
+ ;; would turn (FILE . POS) references into strings too eagerly, so
+ ;; we do want to use the lower-level function.
+ (let ((doc (function-documentation function)))
+ ;; Docstrings from the DOC file are handled elsewhere.
+ (if (integerp doc) nil doc))))
(defcustom apropos-compact-layout nil
"If non-nil, use a single line per binding."
@@ -1239,14 +1213,16 @@ as a heading."
(put-text-property (- (point) 3) (point)
'face 'apropos-keybinding)))
(terpri))
- (apropos-print-doc 2
+ (apropos-print-doc apropos-item
+ 2
(if (commandp symbol)
'apropos-command
(if (macrop symbol)
'apropos-macro
'apropos-function))
(not nosubst))
- (apropos-print-doc 3
+ (apropos-print-doc apropos-item
+ 3
(if (custom-variable-p symbol)
'apropos-user-option
'apropos-variable)
@@ -1264,10 +1240,10 @@ as a heading."
(lambda (_)
(message "Value: %s" value))))
(insert "\n")))
- (apropos-print-doc 7 'apropos-group t)
- (apropos-print-doc 6 'apropos-face t)
- (apropos-print-doc 5 'apropos-widget t)
- (apropos-print-doc 4 'apropos-plist nil))
+ (apropos-print-doc apropos-item 7 'apropos-group t)
+ (apropos-print-doc apropos-item 6 'apropos-face t)
+ (apropos-print-doc apropos-item 5 'apropos-widget t)
+ (apropos-print-doc apropos-item 4 'apropos-plist nil))
(setq-local truncate-partial-width-windows t)
(setq-local truncate-lines t)))
(when help-window-select
@@ -1275,7 +1251,7 @@ as a heading."
(prog1 apropos-accumulator
(setq apropos-accumulator ()))) ; permit gc
-(defun apropos-print-doc (i type do-keys)
+(defun apropos-print-doc (apropos-item i type do-keys)
(let ((doc (nth i apropos-item)))
(when (stringp doc)
(if apropos-compact-layout
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index a209623b65e..49597739446 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -409,7 +409,7 @@ displayed in a window:
'face 'mode-line-emphasis)
" ")))
;; Reset count to 0 in case we display another appt on the next cycle.
- (setq appt-display-count (if (eq '(0) min-list) 0
+ (setq appt-display-count (if (equal '(0) min-list) 0
(1+ prev-appt-display-count))))
;; If we have changed the mode line string, redisplay all mode lines.
(and appt-display-mode-line
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 5f1ce0aaea6..946cf0e7236 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -880,7 +880,10 @@ LIST-ONLY is non-nil, in which case it just returns the
list."
(original-date original-date))
(run-hooks 'diary-hook))))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
- (or d-incp (message "Preparing diary...done"))
+ (or d-incp
+ ;; Don't clobber messages displayed while preparing the diary.
+ (not (equal (current-message) "Preparing diary..."))
+ (message "Preparing diary...done"))
diary-entries-list)))
(defun diary-unhide-everything ()
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index eff2f5558b3..6da2dae8471 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -436,7 +436,23 @@ specify the character). With no input, i.e. when CHAR is
nil,
describe all available character equivalences of `char-fold-to-regexp'.
Optional argument LAX (interactively, the prefix argument), if
non-nil, means also include partially matching ligatures and
-non-canonical equivalences."
+non-canonical equivalences.
+
+Each line of the display shows the equivalences in two different
+ways separated by a colon:
+
+ - as the literal character or sequence
+ - using an ASCII-only escape syntax
+
+For example, for the letter \\='r\\=', the first line is
+
+ r: ?\\N{LATIN SMALL LETTER R}
+
+which is for the requested character itself, and a later line has
+
+ ṟ: ?\\N{LATIN SMALL LETTER R}?\\N{COMBINING MACRON BELOW}
+
+which clearly shows what the constituent characters are."
(interactive (list (ignore-errors
(read-char-by-name
(format-prompt "Unicode name, single char, or hex"
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 054683d7cf6..6ca7d7fcafd 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -310,6 +310,7 @@ Leaving \"Default\" unchecked is equivalent with specifying
a default of
(const :tag "Off" :value nil)
(const :tag "On" :value t)
(const :tag "Auto-raise" :value auto-raise)) "26.1")
+ (yes-or-no-prompt menu string "30.1")
;; fontset.c
;; FIXME nil is the initial value, fontset.el setqs it.
(vertical-centering-font-regexp display
diff --git a/lisp/dired.el b/lisp/dired.el
index 1f7dca802fd..76499d0f520 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -789,7 +789,7 @@ Subexpression 2 must end right before the \\n.")
'(dired-move-to-filename)
nil
'(1 dired-symlink-face)
- '(2 '(face dired-directory-face dired-symlink-filename t))))
+ '(2 `(face ,dired-directory-face dired-symlink-filename t))))
;;
;; Symbolic link to a non-directory.
(list dired-re-sym
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 7c272f52fb3..0303fec67a6 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -212,7 +212,7 @@ are available (see Info node `(emacs)Document View')."
(defcustom doc-view-mupdf-use-svg (image-type-available-p 'svg)
"Whether to use svg images for PDF files."
:type 'boolean
- :version "29.1")
+ :version "30.1")
(defcustom doc-view-imenu-enabled (and (executable-find "mutool") t)
"Whether to generate an imenu outline when \"mutool\" is available."
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 080a6d84498..56f0ae2212c 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -1850,7 +1850,7 @@ function at point for which PREDICATE returns non-nil)."
ad-advised-functions
(if predicate
(lambda (function)
- (funcall predicate (intern (car function)))))
+ (funcall predicate (intern function))))
t)))
(if (equal function "")
(if (ad-is-advised default)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index d7a0d851e01..039cebedb44 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1380,6 +1380,9 @@ See Info node `(elisp) Integer Basics'."
;; (apply F ... (list X Y ...)) -> (funcall F ... X Y ...)
((eq (car-safe last) 'list)
`(funcall ,fn ,@(butlast (cddr form)) ,@(cdr last)))
+ ;; (apply F ... (cons X Y)) -> (apply F ... X Y)
+ ((eq (car-safe last) 'cons)
+ (append (butlast form) (cdr last)))
(t form)))
form)))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 23d02ba92cf..aa9521e5a65 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1575,7 +1575,7 @@ extra args."
"`%s' called with %d args to fill %d format field(s)" (car form)
nargs nfields)))))
-(dolist (elt '(format message error))
+(dolist (elt '(format message format-message error))
(put elt 'byte-compile-format-like t))
(defun byte-compile--suspicious-defcustom-choice (type)
@@ -1772,10 +1772,16 @@ It is too wide if it has any lines longer than the
largest of
kind name col))
;; There's a "naked" ' character before a symbol/list, so it
;; should probably be quoted with \=.
- (when (string-match-p "\\( [\"#]\\|[ \t]\\|^\\)'[a-z(]" docs)
+ (when (string-match-p (rx (| (in " \t") bol)
+ (? (in "\"#"))
+ "'"
+ (in "A-Za-z" "("))
+ docs)
(byte-compile-warn-x
- name "%s%sdocstring has wrong usage of unescaped single quotes (use
\\= or different quoting)"
- kind name))
+ name
+ (concat "%s%sdocstring has wrong usage of unescaped single quotes"
+ " (use \\=%c or different quoting such as %c...%c)")
+ kind name ?' ?` ?'))
;; There's a "Unicode quote" in the string -- it should probably
;; be an ASCII one instead.
(when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 36aab087d94..cffe8b09f53 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2811,7 +2811,7 @@ values. Note that this macro is *not* available in
Common Lisp.
As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
-See info node `(cl) Function Bindings' for details.
+See info node `(cl) Modify Macros' for details.
\(fn ((PLACE VALUE) ...) BODY...)"
(declare (indent 1) (debug ((&rest [&or (symbolp form)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 278f499a894..1fe7a303344 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -3828,22 +3828,22 @@ Return the trampoline if found or nil otherwise."
form nil
;; If we've disabled nativecomp, don't write the trampolines to
;; the eln cache (but create them).
- (and (not inhibit-automatic-native-compilation)
- (cl-loop
- for dir in (if native-compile-target-directory
- (list (expand-file-name comp-native-version-dir
-
native-compile-target-directory))
- (comp-eln-load-path-eff))
- for f = (expand-file-name
- (comp-trampoline-filename subr-name)
- dir)
- unless (file-exists-p dir)
- do (ignore-errors
- (make-directory dir t)
- (cl-return f))
- when (file-writable-p f)
- do (cl-return f)
- finally (error "Cannot find suitable directory for output in \
+ (unless inhibit-automatic-native-compilation
+ (cl-loop
+ for dir in (if native-compile-target-directory
+ (list (expand-file-name comp-native-version-dir
+
native-compile-target-directory))
+ (comp-eln-load-path-eff))
+ for f = (expand-file-name
+ (comp-trampoline-filename subr-name)
+ dir)
+ unless (file-exists-p dir)
+ do (ignore-errors
+ (make-directory dir t)
+ (cl-return f))
+ when (file-writable-p f)
+ do (cl-return f)
+ finally (error "Cannot find suitable directory for output in \
`native-comp-eln-load-path'"))))))
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 83705ca5b89..98a017c8a8e 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -496,7 +496,7 @@ See also `ert-with-temp-directory'."
(progn ,@body)
(ignore-errors
,@(when buffer
- (list `(with-current-buffer buf
+ (list `(with-current-buffer ,buffer
(set-buffer-modified-p nil))
`(kill-buffer ,buffer))))
(ignore-errors
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 069adb3edad..c909ffb6933 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -458,12 +458,13 @@ Assumes the caller has bound
`macroexpand-all-environment'."
(let ((arg (nth funarg form)))
(when (and (eq 'quote (car-safe arg))
(eq 'lambda (car-safe (cadr arg))))
- (setcar (nthcdr funarg form)
- (macroexp-warn-and-return
- (format "%S quoted with ' rather than with #'"
- (let ((f (cadr arg)))
- (if (symbolp f) f `(lambda ,(nth 1 f)
...))))
- arg nil nil (cadr arg))))))
+ (setcar
+ (nthcdr funarg form)
+ (macroexp-warn-and-return
+ (format
+ "(lambda %s ...) quoted with ' rather than with #'"
+ (or (nth 1 (cadr arg)) "()"))
+ arg nil nil (cadr arg))))))
;; Macro expand compiler macros. This cannot be delayed to
;; byte-optimize-form because the output of the compiler-macro
can
;; use macros.
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index ddcfe57928b..33bd0bfd5cd 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -600,10 +600,14 @@ PKG-SPEC is a package specification, a property list
describing
how to fetch and build the package. See `package-vc--archive-spec-alist'
for details. The optional argument REV specifies a specific revision to
checkout. This overrides the `:branch' attribute in PKG-SPEC."
+ (unless pkg-desc
+ (setq pkg-desc (package-desc-create :name (car pkg-spec) :kind 'vc)))
(pcase-let* (((map :lisp-dir) pkg-spec)
(name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
(pkg-dir (expand-file-name dirname package-user-dir)))
+ (when (string-empty-p name)
+ (user-error "Empty package name"))
(setf (package-desc-dir pkg-desc) pkg-dir)
(when (file-exists-p pkg-dir)
(if (yes-or-no-p (format "Overwrite previous checkout for package `%s'?"
name))
@@ -771,7 +775,9 @@ regular package, but it will not remove a VC package.
(package-vc--archives-initialize)
(let* ((name-or-url (package-vc--read-package-name
"Fetch and install package: " t))
- (name (file-name-base name-or-url)))
+ (name (file-name-base (directory-file-name name-or-url))))
+ (when (string-empty-p name)
+ (user-error "Empty package name"))
(list name-or-url
(and current-prefix-arg :last-release)
nil
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index ebda37419f7..e6e3cd6c6f4 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -47,7 +47,9 @@ Otherwise this should be a number."
(defcustom pp-use-max-width nil
"If non-nil, `pp'-related functions will try to fold lines.
-The target width is given by the `pp-max-width' variable."
+The target width is given by the `pp-max-width' variable.
+Note that this could slow down `pp' considerably when formatting
+large lists."
:type 'boolean
:version "29.1")
@@ -162,14 +164,15 @@ Also add the value to the front of the list in the
variable `values'."
(message "Evaluating...")
(let ((result (eval expression lexical-binding)))
(values--store-value result)
- (pp-display-expression result "*Pp Eval Output*")))
+ (pp-display-expression result "*Pp Eval Output*" pp-use-max-width)))
;;;###autoload
(defun pp-macroexpand-expression (expression)
"Macroexpand EXPRESSION and pretty-print its value."
(interactive
(list (read--expression "Macroexpand: ")))
- (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*"))
+ (pp-display-expression (macroexpand-1 expression) "*Pp Macroexpand Output*"
+ pp-use-max-width))
(defun pp-last-sexp ()
"Read sexp before point. Ignore leading comment characters."
@@ -219,7 +222,8 @@ Ignores leading comment characters."
;;;###autoload
(defun pp-emacs-lisp-code (sexp)
"Insert SEXP into the current buffer, formatted as Emacs Lisp code.
-Use the `pp-max-width' variable to control the desired line length."
+Use the `pp-max-width' variable to control the desired line length.
+Note that this could be slow for large SEXPs."
(require 'edebug)
(let ((obuf (current-buffer)))
(with-temp-buffer
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 9505c935816..31b840d6c83 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -204,8 +204,12 @@ SUPPRESS-LIST is the list of kinds of warnings to
suppress."
some-match))
(define-icon warnings-suppress button
- '((emoji "⛔")
- (symbol " ■ ")
+ `((emoji "⛔")
+ ;; Many MS-Windows console fonts don't have good glyphs for U+25A0.
+ (symbol ,(if (and (eq system-type 'windows-nt)
+ (null window-system))
+ " » "
+ " ■ "))
(text " stop "))
"Suppress warnings."
:version "29.1"
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 9eb4f1a9000..994555acecf 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -202,12 +202,13 @@ if ARG is omitted or nil.
(,disable)))
,(erc--assemble-toggle local-p name enable mode t enable-body)
,(erc--assemble-toggle local-p name disable mode nil disable-body)
- ,(when (and alias (not (eq name alias)))
- `(defalias
- ',(intern
- (format "erc-%s-mode"
- (downcase (symbol-name alias))))
- #',mode))
+ ,@(and-let* ((alias)
+ ((not (eq name alias)))
+ (aname (intern (format "erc-%s-mode"
+ (downcase (symbol-name alias))))))
+ `((defalias ',aname #',mode)
+ (put ',aname 'erc-module ',(erc--normalize-module-symbol name))))
+ (put ',mode 'erc-module ',(erc--normalize-module-symbol name))
;; For find-function and find-variable.
(put ',mode 'definition-name ',name)
(put ',enable 'definition-name ',name)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 73ce612a33d..5601ede27a5 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -260,8 +260,8 @@ If START or END is negative, it counts from the end."
(dolist (e rv out)
(when-let* ((s (plist-get e :secret))
(v (auth-source--obfuscate s)))
- (setf (plist-get e :secret)
- (apply-partially #'auth-source--deobfuscate v)))
+ (setq e (plist-put e :secret (apply-partially
+ #'auth-source--deobfuscate v))))
(push e out)))
rv)))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 4044be08f92..95fd8990c99 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -1366,6 +1366,11 @@ ANNOUNCED is the server's reported host name."
erc-server-connected t
erc-networks--id nid))))))
+(defvar erc-networks--copy-server-buffer-functions nil
+ "Abnormal hook run in new server buffers when deduping.
+Passed the existing buffer to be killed, whose contents have
+already been copied over to the current, replacement buffer.")
+
(defun erc-networks--copy-over-server-buffer-contents (existing name)
"Kill off existing server buffer after copying its contents.
Must be called from the replacement buffer."
@@ -1386,6 +1391,7 @@ Must be called from the replacement buffer."
erc-kill-server-hook
erc-kill-buffer-hook)
(erc-networks--insert-transplanted-content text)
+ (run-hook-with-args 'erc-networks--copy-server-buffer-functions existing)
(kill-buffer name)))
;; This stands alone for testing purposes
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index 61c0c66abfb..7fd7b53602e 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -521,7 +521,9 @@ keybindings will not do anything useful."
(add-hook 'erc-disconnected-hook #'erc-modified-channels-update))
;; enable the tracking keybindings
(add-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
- (erc-track-minor-mode-maybe)))
+ (erc-track-minor-mode-maybe))
+ (add-hook 'erc-networks--copy-server-buffer-functions
+ #'erc-track--replace-killed-buffer))
;; Disable:
((when (boundp 'erc-track-when-inactive)
(erc-track-remove-from-mode-line)
@@ -539,7 +541,9 @@ keybindings will not do anything useful."
;; disable the tracking keybindings
(remove-hook 'erc-connect-pre-hook #'erc-track-minor-mode-maybe)
(when erc-track-minor-mode
- (erc-track-minor-mode -1)))))
+ (erc-track-minor-mode -1)))
+ (remove-hook 'erc-networks--copy-server-buffer-functions
+ #'erc-track--replace-killed-buffer)))
(defcustom erc-track-when-inactive nil
"Enable channel tracking even for visible buffers, if you are inactive."
@@ -942,6 +946,10 @@ reverse it."
(interactive "p")
(erc-track--switch-buffer 'switch-to-buffer-other-window arg))
+(defun erc-track--replace-killed-buffer (existing)
+ (when-let ((found (assq existing erc-modified-channels-alist)))
+ (setcar found (current-buffer))))
+
(provide 'erc-track)
;;; erc-track.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6315d5aa482..ff1820cfaf2 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -61,7 +61,6 @@
(load "erc-loaddefs" 'noerror 'nomessage)
(require 'erc-networks)
-(require 'erc-goodies)
(require 'erc-backend)
(require 'cl-lib)
(require 'format-spec)
@@ -323,7 +322,8 @@ A typical value would be \((\"Libera.Chat\" \"MODE\")
\(\"OFTC\" \"JOIN\" \"QUIT\"))."
:version "25.1"
:group 'erc-ignore
- :type 'erc-message-type)
+ :type '(alist :key-type string :value-type erc-message-type
+ :options ("Libera.Chat")))
(defcustom erc-channel-hide-list nil
"A list of IRC channels to hide message types from.
@@ -331,7 +331,8 @@ A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\")
\(\"#erc\" \"NICK\")."
:version "25.1"
:group 'erc-ignore
- :type 'erc-message-type)
+ :type '(alist :key-type string :value-type erc-message-type
+ :options ("#emacs")))
(defcustom erc-disconnected-hook nil
"Run this hook with arguments (NICK IP REASON) when disconnected.
@@ -1303,6 +1304,14 @@ See also `erc-show-my-nick'."
(defvar-local erc-dbuf nil)
+;; See comments in `erc-scenarios-base-local-modules' explaining why
+;; this is insufficient as a public interface.
+
+(defvar erc--target-priors nil
+ "Analogous to `erc--server-reconnecting' but for target buffers.
+Bound to local variables from an existing (logical) session's
+buffer during local-module setup and `erc-mode-hook' activation.")
+
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
(funcall (if (erc-channel-p string)
@@ -1948,7 +1957,8 @@ nil."
(let ((out (list (reverse new-modes))))
(pcase-dolist (`(,k . ,v) old-vars)
(when (and (string-prefix-p "erc-" (symbol-name k))
- (string-suffix-p "-mode" (symbol-name k)))
+ (string-suffix-p "-mode" (symbol-name k))
+ (get k 'erc-module))
(if v
(cl-pushnew k (car out))
(setf (car out) (delq k (car out)))
@@ -1983,7 +1993,9 @@ Returns the buffer for the given server or channel."
(let* ((target (and channel (erc--target-from-string channel)))
(buffer (erc-get-buffer-create server port nil target id))
(old-buffer (current-buffer))
- (old-vars (and target (buffer-local-variables)))
+ (erc--target-priors (and target ; buf from prior session
+ (buffer-local-value 'erc--target buffer)
+ (buffer-local-variables buffer)))
(old-recon-count erc-server-reconnect-count)
(old-point nil)
(delayed-modules nil)
@@ -1996,7 +2008,8 @@ Returns the buffer for the given server or channel."
(setq old-point (point))
(setq delayed-modules
(erc--merge-local-modes (erc--update-modules)
- (or erc--server-reconnecting old-vars)))
+ (or erc--server-reconnecting
+ erc--target-priors)))
(delay-mode-hooks (erc-mode))
@@ -2069,9 +2082,7 @@ Returns the buffer for the given server or channel."
(erc-determine-parameters server port nick full-name user passwd)
- (save-excursion (run-mode-hooks))
- (dolist (mod (car delayed-modules)) (funcall mod +1))
- (dolist (var (cdr delayed-modules)) (set var nil))
+ ;; FIXME consolidate this prompt-setup logic with the pass above.
;; set up prompt
(unless continued-session
@@ -2084,6 +2095,10 @@ Returns the buffer for the given server or channel."
(erc-display-prompt)
(goto-char (point-max)))
+ (save-excursion (run-mode-hooks)
+ (dolist (mod (car delayed-modules)) (funcall mod +1))
+ (dolist (var (cdr delayed-modules)) (set var nil)))
+
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
@@ -7370,4 +7385,6 @@ Customize `erc-url-connect-function' to override this."
(provide 'erc)
+;; FIXME this is a temporary stopgap for Emacs 29.
+(require 'erc-goodies)
;;; erc.el ends here
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index dfbe4db0896..bfff3bdf56e 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -132,7 +132,8 @@ or `eshell-printn' for display."
;; bug#27361.
(when (equal output-newline '(nil))
(display-warning
- :warning "To terminate with a newline, you should use -N instead."))
+ '(eshell echo)
+ "To terminate with a newline, you should use -N instead."))
(eshell-echo args output-newline))))
(defun eshell/printnl (&rest args)
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 94ec5e8f1db..4206ad048fa 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -312,7 +312,7 @@ to writing a completion function."
(eshell-interactive-process-p))
(eshell--pcomplete-insert-tab))
(let ((end (point-marker))
- (begin (save-excursion (eshell-bol) (point)))
+ (begin (save-excursion (beginning-of-line) (point)))
(posns (list t))
args delim)
(when (and pcomplete-allow-modifications
diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el
index 80bc0f031ef..2b003f58dc7 100644
--- a/lisp/eshell/em-elecslash.el
+++ b/lisp/eshell/em-elecslash.el
@@ -72,7 +72,7 @@ insertion."
(delete-char -1)
(let ((tilde-before (eq ?~ (char-before)))
(command (save-excursion
- (eshell-bol)
+ (beginning-of-line)
(skip-syntax-forward " ")
(thing-at-point 'sexp)))
(prefix (file-remote-p default-directory)))
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 05e9598f530..6e0e471d910 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -555,7 +555,7 @@ See also `eshell-read-history'."
(defun eshell-hist-parse-arguments (&optional b e)
"Parse current command arguments in a history-code-friendly way."
(let ((end (or e (point)))
- (begin (or b (save-excursion (eshell-bol) (point))))
+ (begin (or b (save-excursion (beginning-of-line) (point))))
(posb (list t))
(pose (list t))
(textargs (list t))
@@ -913,7 +913,7 @@ If N is negative, search forwards for the -Nth following
match."
eshell-next-matching-input-from-input)))
;; Starting a new search
(setq eshell-matching-input-from-input-string
- (buffer-substring (save-excursion (eshell-bol) (point))
+ (buffer-substring (save-excursion (beginning-of-line) (point))
(point))
eshell-history-index nil))
(eshell-previous-matching-input
@@ -933,7 +933,7 @@ If N is negative, search backwards for the -Nth previous
match."
(if (get-text-property (point) 'history)
(progn (beginning-of-line) t)
(let ((before (point)))
- (eshell-bol)
+ (beginning-of-line)
(if (and (not (bolp))
(<= (point) before))
t
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 575b5a595f1..b3a0fadf618 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -29,6 +29,8 @@
(require 'esh-mode)
(eval-when-compile (require 'eshell))
+(require 'text-property-search)
+
;;;###autoload
(progn
(defgroup eshell-prompt nil
@@ -50,7 +52,7 @@ as is common with most shells."
(defcustom eshell-prompt-function
(lambda ()
(concat (abbreviate-file-name (eshell/pwd))
- (if (= (user-uid) 0) " # " " $ ")))
+ (if (= (file-user-uid) 0) " # " " $ ")))
"A function that returns the Eshell prompt string.
Make sure to update `eshell-prompt-regexp' so that it will match your
prompt."
@@ -58,11 +60,12 @@ prompt."
:group 'eshell-prompt)
(defcustom eshell-prompt-regexp "^[^#$\n]* [#$] "
- "A regexp which fully matches your eshell prompt.
-This setting is important, since it affects how eshell will interpret
-the lines that are passed to it.
-If this variable is changed, all Eshell buffers must be exited and
-re-entered for it to take effect."
+ "A regexp which fully matches your Eshell prompt.
+This is useful for navigating by paragraph using \
+\\[forward-paragraph] and \\[backward-paragraph].
+
+If this variable is changed, all Eshell buffers must be exited
+and re-entered for it to take effect."
:type 'regexp
:group 'eshell-prompt)
@@ -123,7 +126,6 @@ arriving, or after."
(if eshell-prompt-regexp
(setq-local paragraph-start eshell-prompt-regexp))
- (setq-local eshell-skip-prompt-function #'eshell-skip-prompt)
(eshell-prompt-mode)))
(defun eshell-emit-prompt ()
@@ -134,72 +136,83 @@ arriving, or after."
(if (not eshell-prompt-function)
(set-marker eshell-last-output-end (point))
(let ((prompt (funcall eshell-prompt-function)))
- (and eshell-highlight-prompt
- (add-text-properties 0 (length prompt)
- '(read-only t
- font-lock-face eshell-prompt
- front-sticky (font-lock-face read-only)
- rear-nonsticky (font-lock-face read-only))
- prompt))
- (eshell-interactive-print prompt)))
+ (add-text-properties
+ 0 (length prompt)
+ (if eshell-highlight-prompt
+ '( read-only t
+ field prompt
+ font-lock-face eshell-prompt
+ front-sticky (read-only field font-lock-face)
+ rear-nonsticky (read-only field font-lock-face))
+ '( field prompt
+ front-sticky (field)
+ rear-nonsticky (field)))
+ prompt)
+ (eshell-interactive-filter nil prompt)))
(run-hooks 'eshell-after-prompt-hook))
-(defun eshell-backward-matching-input (regexp arg)
- "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `eshell-prompt-regexp'.
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
- (interactive (eshell-regexp-arg "Backward input matching (regexp): "))
- (let* ((re (concat eshell-prompt-regexp ".*" regexp))
- (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
- (if (re-search-backward re nil t arg)
- (point)))))
- (if (null pos)
- (progn (message "Not found")
- (ding))
- (goto-char pos)
- (eshell-bol))))
-
(defun eshell-forward-matching-input (regexp arg)
- "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `eshell-prompt-regexp'.
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
+ "Search forward through buffer for command input that matches REGEXP.
+With prefix argument N, search for Nth next match. If N is
+negative, find the Nth previous match."
(interactive (eshell-regexp-arg "Forward input matching (regexp): "))
- (eshell-backward-matching-input regexp (- arg)))
+ (let ((direction (if (> arg 0) 1 -1))
+ (count (abs arg)))
+ (unless (catch 'found
+ (while (> count 0)
+ (eshell-next-prompt direction)
+ (when (and (string-match regexp (field-string))
+ (= (setq count (1- count)) 0))
+ (throw 'found t))))
+ (message "Not found")
+ (ding))))
+
+(defun eshell-backward-matching-input (regexp arg)
+ "Search backward through buffer for command input that matches REGEXP.
+With prefix argument N, search for Nth previous match. If N is
+negative, find the Nth next match."
+ (interactive (eshell-regexp-arg "Backward input matching (regexp): "))
+ (eshell-forward-matching-input regexp (- arg)))
(defun eshell-next-prompt (n)
- "Move to end of Nth next prompt in the buffer.
-See `eshell-prompt-regexp'."
+ "Move to end of Nth next prompt in the buffer."
(interactive "p")
- (if eshell-highlight-prompt
- (progn
- (while (< n 0)
- (while (and (re-search-backward eshell-prompt-regexp nil t)
- (not (get-text-property (match-beginning 0)
'read-only))))
- (setq n (1+ n)))
- (while (> n 0)
- (while (and (re-search-forward eshell-prompt-regexp nil t)
- (not (get-text-property (match-beginning 0)
'read-only))))
- (setq n (1- n))))
- (re-search-forward eshell-prompt-regexp nil t n))
- (eshell-skip-prompt))
+ (if (natnump n)
+ (while (and (> n 0)
+ (text-property-search-forward 'field 'prompt t))
+ (setq n (1- n)))
+ (let (match this-match)
+ (forward-line 0) ; Don't count prompt on current line.
+ (while (and (< n 0)
+ (setq this-match (text-property-search-backward
+ 'field 'prompt t)))
+ (setq match this-match
+ n (1+ n)))
+ (when match
+ (goto-char (prop-match-end match))))))
(defun eshell-previous-prompt (n)
- "Move to end of Nth previous prompt in the buffer.
-See `eshell-prompt-regexp'."
+ "Move to end of Nth previous prompt in the buffer."
(interactive "p")
- (forward-line 0) ; Don't count prompt on current line.
(eshell-next-prompt (- n)))
(defun eshell-skip-prompt ()
"Skip past the text matching regexp `eshell-prompt-regexp'.
If this takes us past the end of the current line, don't skip at all."
+ (declare (obsolete nil "30.1"))
(let ((eol (line-end-position)))
(if (and (looking-at eshell-prompt-regexp)
(<= (match-end 0) eol))
(goto-char (match-end 0)))))
+(defun eshell-bol-ignoring-prompt (arg)
+ "Move point to the beginning of the current line, past the prompt (if any).
+With argument ARG not nil or 1, move forward ARG - 1 lines
+first (see `move-beginning-of-line' for more information)."
+ (interactive "^p")
+ (let ((inhibit-field-text-motion t))
+ (move-beginning-of-line arg)))
+
(provide 'em-prompt)
;; Local Variables:
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index 2c95d4fdffb..f147d432300 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -50,9 +50,7 @@ the behavior of normal shells while the user editing new
input text."
:group 'eshell-rebind)
(defcustom eshell-rebind-keys-alist
- '(([(control ?a)] . eshell-bol)
- ([home] . eshell-bol)
- ([(control ?d)] . eshell-delchar-or-maybe-eof)
+ '(([(control ?d)] . eshell-delchar-or-maybe-eof)
([backspace] . eshell-delete-backward-char)
([delete] . eshell-delete-backward-char)
([(control ?w)] . backward-kill-word)
@@ -190,7 +188,7 @@ lock it at that."
(and eshell-remap-previous-input
(setq begin
(save-excursion
- (eshell-bol)
+ (beginning-of-line)
(and (not (bolp)) (point))))
(>= pos begin)
(<= pos (line-end-position))
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index c17a8fb8c4f..6c882471aee 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -554,8 +554,9 @@ and if found, returns a grouped list like:
((list arg-1) (list arg-2) spliced-arg-3 ...)
This allows callers of this function to build the final spliced
-list by concatenating each element together, e.g. with (apply
-#'append grouped-list).
+list by concatenating each element together, e.g. with
+
+ (apply #\\='append grouped-list)
If no argument requested a splice, return nil."
(let* ((splicep nil)
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 4dad4c7429a..cccdb49ce2a 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -74,6 +74,8 @@
(eval-when-compile
(require 'cl-lib))
+(declare-function eshell-interactive-print "esh-mode" (string))
+
(defgroup eshell-io nil
"Eshell's I/O management code provides a scheme for treating many
different kinds of objects -- symbols, files, buffers, etc. -- as
@@ -597,8 +599,6 @@ after all printing is over with no argument."
(eshell-print object)
(eshell-print "\n"))
-(autoload 'eshell-output-filter "esh-mode")
-
(defun eshell-output-object-to-target (object target)
"Insert OBJECT into TARGET.
Returns what was actually sent, or nil if nothing was sent."
@@ -608,7 +608,7 @@ Returns what was actually sent, or nil if nothing was sent."
((symbolp target)
(if (eq target t) ; means "print to display"
- (eshell-output-filter nil (eshell-stringify object))
+ (eshell-interactive-print (eshell-stringify object))
(if (not (symbol-value target))
(set target object)
(setq object (eshell-stringify object))
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index d80f1d1f390..503d9ba1b63 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -155,7 +155,8 @@ number, if the function `eshell-truncate-buffer' is on
eshell-watch-for-password-prompt)
"Functions to call before output is displayed.
These functions are only called for output that is displayed
-interactively, and not for output which is redirected."
+interactively (see `eshell-interactive-filter'), and not for
+output which is redirected."
:type 'hook)
(defcustom eshell-preoutput-filter-functions nil
@@ -175,6 +176,8 @@ This is used by `eshell-watch-for-password-prompt'."
"A function called from beginning of line to skip the prompt."
:type '(choice (const nil) function))
+(make-obsolete-variable 'eshell-skip-prompt-function nil "30.1")
+
(defcustom eshell-status-in-mode-line t
"If non-nil, let the user know a command is running in the mode line."
:type 'boolean)
@@ -261,14 +264,13 @@ This is used by `eshell-watch-for-password-prompt'."
"C-c" 'eshell-command-map
"RET" #'eshell-send-input
"M-RET" #'eshell-queue-input
- "C-M-l" #'eshell-show-output
- "C-a" #'eshell-bol)
+ "C-M-l" #'eshell-show-output)
(defvar-keymap eshell-command-map
:prefix 'eshell-command-map
"M-o" #'eshell-mark-output
"M-d" #'eshell-toggle-direct-send
- "C-a" #'eshell-bol
+ "C-a" #'move-beginning-of-line
"C-b" #'eshell-backward-argument
"C-e" #'eshell-show-maximum-output
"C-f" #'eshell-forward-argument
@@ -471,7 +473,7 @@ and the hook `eshell-exit-hook'."
(defun eshell-move-argument (limit func property arg)
"Move forward ARG arguments."
(catch 'eshell-incomplete
- (eshell-parse-arguments (save-excursion (eshell-bol) (point))
+ (eshell-parse-arguments (save-excursion (beginning-of-line) (point))
(line-end-position)))
(let ((pos (save-excursion
(funcall func 1)
@@ -504,12 +506,7 @@ and the hook `eshell-exit-hook'."
(kill-ring-save begin (point))
(yank)))
-(defun eshell-bol ()
- "Go to the beginning of line, then skip past the prompt, if any."
- (interactive)
- (beginning-of-line)
- (and eshell-skip-prompt-function
- (funcall eshell-skip-prompt-function)))
+(define-obsolete-function-alias 'eshell-bol #'beginning-of-line "30.1")
(defsubst eshell-push-command-mark ()
"Push a mark at the end of the last input text."
@@ -525,9 +522,13 @@ Putting this function on `eshell-pre-command-hook' will
mimic Plan 9's
(custom-add-option 'eshell-pre-command-hook #'eshell-goto-input-start)
-(defsubst eshell-interactive-print (string)
+(defun eshell-interactive-print (string)
"Print STRING to the eshell display buffer."
- (eshell-output-filter nil string))
+ (when string
+ (add-text-properties 0 (length string)
+ '(field command-output rear-nonsticky (field))
+ string)
+ (eshell-interactive-filter nil string)))
(defsubst eshell-begin-on-new-line ()
"This function outputs a newline if not at beginning of line."
@@ -687,14 +688,14 @@ newline."
(custom-add-option 'eshell-input-filter-functions 'eshell-kill-new)
-(defun eshell-output-filter (process string)
- "Send the output from PROCESS (STRING) to the interactive display.
+(defun eshell-interactive-filter (buffer string)
+ "Send output (STRING) to the interactive display, using BUFFER.
This is done after all necessary filtering has been done."
- (let ((oprocbuf (if process (process-buffer process)
- (current-buffer)))
- (inhibit-modification-hooks t))
- (when (and string oprocbuf (buffer-name oprocbuf))
- (with-current-buffer oprocbuf
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (when (and string (buffer-live-p buffer))
+ (let ((inhibit-modification-hooks t))
+ (with-current-buffer buffer
(let ((functions eshell-preoutput-filter-functions))
(while (and functions string)
(setq string (funcall (car functions) string))
@@ -851,7 +852,7 @@ With a prefix argument, narrows region to last command
output."
(if (> (point) eshell-last-output-end)
(kill-region eshell-last-output-end (point))
(let ((here (point)))
- (eshell-bol)
+ (beginning-of-line)
(kill-region (point) here))))
(defun eshell-show-maximum-output (&optional interactive)
@@ -879,17 +880,18 @@ If SCROLLBACK is non-nil, clear the scrollback contents."
(erase-buffer)))
(defun eshell-get-old-input (&optional use-current-region)
- "Return the command input on the current line."
+ "Return the command input on the current line.
+If USE-CURRENT-REGION is non-nil, return the current region."
(if use-current-region
(buffer-substring (min (point) (mark))
(max (point) (mark)))
(save-excursion
- (beginning-of-line)
- (and eshell-skip-prompt-function
- (funcall eshell-skip-prompt-function))
- (let ((beg (point)))
- (end-of-line)
- (buffer-substring beg (point))))))
+ (let ((inhibit-field-text-motion t))
+ (end-of-line))
+ (let ((inhibit-field-text-motion)
+ (end (point)))
+ (beginning-of-line)
+ (buffer-substring (point) end)))))
(defun eshell-copy-old-input ()
"Insert after prompt old input at point as new input to be edited."
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 8a803c67e46..27cd521e82e 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -296,15 +296,20 @@ Used only on systems which do not support async
subprocesses.")
'unix))))
(cond
((fboundp 'make-process)
- (unless (equal (car (aref eshell-current-handles eshell-output-handle))
- (car (aref eshell-current-handles eshell-error-handle)))
+ (unless (or ;; FIXME: It's not currently possible to use a
+ ;; stderr process for remote files.
+ (file-remote-p default-directory)
+ (equal (car (aref eshell-current-handles
+ eshell-output-handle))
+ (car (aref eshell-current-handles
+ eshell-error-handle))))
(eshell-protect-handles eshell-current-handles)
(setq stderr-proc
(make-pipe-process
:name (concat (file-name-nondirectory command) "-stderr")
:buffer (current-buffer)
:filter (if (eshell-interactive-output-p eshell-error-handle)
- #'eshell-output-filter
+ #'eshell-interactive-process-filter
#'eshell-insertion-filter)
:sentinel #'eshell-sentinel))
(eshell-record-process-properties stderr-proc eshell-error-handle))
@@ -320,7 +325,7 @@ Used only on systems which do not support async
subprocesses.")
:buffer (current-buffer)
:command (cons command args)
:filter (if (eshell-interactive-output-p)
- #'eshell-output-filter
+ #'eshell-interactive-process-filter
#'eshell-insertion-filter)
:sentinel #'eshell-sentinel
:connection-type conn-type
@@ -381,7 +386,7 @@ Used only on systems which do not support async
subprocesses.")
line (buffer-substring-no-properties lbeg lend))
(set-buffer oldbuf)
(if interact-p
- (eshell-output-filter nil line)
+ (eshell-interactive-process-filter nil line)
(eshell-output-object line))
(setq lbeg lend)
(set-buffer proc-buf))
@@ -402,6 +407,22 @@ Used only on systems which do not support async
subprocesses.")
(setq proc t))))
proc))
+(defun eshell-interactive-process-filter (process string)
+ "Send the output from PROCESS (STRING) to the interactive display.
+This is done after all necessary filtering has been done."
+ (when string
+ (add-text-properties 0 (length string)
+ '(field command-output rear-nonsticky (field))
+ string)
+ (require 'esh-mode)
+ (declare-function eshell-interactive-filter "esh-mode" (buffer string))
+ (eshell-interactive-filter (if process (process-buffer process)
+ (current-buffer))
+ string)))
+
+(define-obsolete-function-alias 'eshell-output-filter
+ #'eshell-interactive-process-filter "30.1")
+
(defun eshell-insertion-filter (proc string)
"Insert a string into the eshell buffer, or a process/file/buffer.
PROC is the process for which we're inserting output. STRING is the
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 811bb9957cf..83dd5cb50f5 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -162,6 +162,7 @@ if they are quoted with a backslash."
("COLUMNS" ,(lambda () (window-body-width nil 'remap)) t t)
("LINES" ,(lambda () (window-body-height nil 'remap)) t t)
("INSIDE_EMACS" eshell-inside-emacs t)
+ ("UID" ,(lambda () (file-user-uid)) nil t)
;; for esh-ext.el
("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator)))
@@ -466,9 +467,7 @@ process any indices that come after the variable reference."
indices (and (not (eobp))
(eq (char-after) ?\[)
(eshell-parse-indices))
- ;; This is an expression that will be evaluated by `eshell-do-eval',
- ;; which only support let-binding of dynamically-scoped vars
- value `(let ((indices (eshell-eval-indices ',indices))) ,value))
+ value `(let ((indices ,(eshell-prepare-indices indices))) ,value))
(when get-len
(setq value `(length ,value)))
(when eshell-current-quoted
@@ -495,7 +494,7 @@ Possible variable references are:
NAME an environment or Lisp variable value
\"LONG-NAME\" disambiguates the length of the name
- `LONG-NAME' as above
+ \\='LONG-NAME\\=' as above
{COMMAND} result of command is variable's value
(LISP-FORM) result of Lisp form is variable's value
<COMMAND> write the output of command to a temporary file;
@@ -590,7 +589,7 @@ Possible variable references are:
"Parse and return a list of index-lists.
For example, \"[0 1][2]\" becomes:
- ((\"0\" \"1\") (\"2\")."
+ ((\"0\" \"1\") (\"2\"))."
(let (indices)
(while (eq (char-after) ?\[)
(let ((end (eshell-find-delimiter ?\[ ?\])))
@@ -608,8 +607,14 @@ For example, \"[0 1][2]\" becomes:
(defun eshell-eval-indices (indices)
"Evaluate INDICES, a list of index-lists generated by
`eshell-parse-indices'."
+ (declare (obsolete eshell-prepare-indices "30.1"))
(mapcar (lambda (i) (mapcar #'eval i)) indices))
+(defun eshell-prepare-indices (indices)
+ "Prepare INDICES to be evaluated by Eshell.
+INDICES is a list of index-lists generated by `eshell-parse-indices'."
+ `(list ,@(mapcar (lambda (idx-list) (cons 'list idx-list)) indices)))
+
(defun eshell-get-variable (name &optional indices quoted)
"Get the value for the variable NAME.
INDICES is a list of index-lists (see `eshell-parse-indices').
@@ -627,9 +632,10 @@ If QUOTED is non-nil, this was invoked inside
double-quotes."
(if (or (eq max-arity 'many) (>= max-arity 2))
(funcall target indices quoted)
(display-warning
- :warning (concat "Function for `eshell-variable-aliases-list'
"
- "entry should accept two arguments: INDICES "
- "and QUOTED.'"))
+ '(eshell variable-alias)
+ (concat "Function for `eshell-variable-aliases-list' "
+ "entry should accept two arguments: INDICES "
+ "and QUOTED.'"))
(funcall target indices)))))
((symbolp target)
(eshell-apply-indices (symbol-value target) indices quoted))
diff --git a/lisp/files.el b/lisp/files.el
index e1b7a990b15..9da82446112 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -5059,7 +5059,8 @@ This is a separate procedure so your site-init or startup
file can
redefine it.
If the optional argument KEEP-BACKUP-VERSION is non-nil,
we do not remove backup version numbers, only true file version numbers.
-See also `file-name-version-regexp'."
+See `file-name-version-regexp' for what constitutes backup versions
+and version strings."
(let ((handler (find-file-name-handler name 'file-name-sans-versions)))
(if handler
(funcall handler 'file-name-sans-versions name keep-backup-version)
@@ -5111,9 +5112,12 @@ the group would be preserved too."
(file-attribute-group-id attributes)))))))))))
(defun file-name-sans-extension (filename)
- "Return FILENAME sans final \"extension\".
+ "Return FILENAME sans final \"extension\" and any backup version strings.
The extension, in a file name, is the part that begins with the last `.',
-except that a leading `.' of the file name, if there is one, doesn't count."
+except that a leading `.' of the file name, if there is one, doesn't count.
+Any extensions that indicate backup versions and version strings are
+removed by calling `file-name-sans-versions', which see, before looking
+for the \"real\" file extension."
(save-match-data
(let ((file (file-name-sans-versions (file-name-nondirectory filename)))
directory)
@@ -5127,12 +5131,14 @@ except that a leading `.' of the file name, if there is
one, doesn't count."
filename))))
(defun file-name-extension (filename &optional period)
- "Return FILENAME's final \"extension\".
+ "Return FILENAME's final \"extension\" sans any backup version strings.
The extension, in a file name, is the part that begins with the last `.',
-excluding version numbers and backup suffixes, except that a leading `.'
-of the file name, if there is one, doesn't count.
+except that a leading `.' of the file name, if there is one, doesn't count.
+This function calls `file-name-sans-versions', which see, to remove from
+the extension it returns any parts that indicate backup versions and
+version strings.
Return nil for extensionless file names such as `foo'.
-Return the empty string for file names such as `foo.'.
+Return the empty string for file names such as `foo.' that end in a period.
By default, the returned value excludes the period that starts the
extension, but if the optional argument PERIOD is non-nil, the period
@@ -6336,6 +6342,12 @@ RECURSIVE if DIRECTORY is nonempty."
directory-exists))
(files--force recursive #'delete-directory-internal directory))))))
+(defcustom remote-file-name-inhibit-delete-by-moving-to-trash nil
+ "Whether remote files shall be moved to the Trash.
+This overrules any setting of `delete-by-moving-to-trash'."
+ :version "30.1"
+ :type 'boolean)
+
(defun file-equal-p (file1 file2)
"Return non-nil if files FILE1 and FILE2 name the same file.
If FILE1 or FILE2 does not exist, the return value is unspecified."
@@ -7088,10 +7100,11 @@ specifies the list of buffers to kill, asking for
approval for each one."
(setq list (cdr list))))
(defun kill-matching-buffers (regexp &optional internal-too no-ask)
- "Kill buffers whose name matches the specified REGEXP.
-Ignores buffers whose name starts with a space, unless optional
-prefix argument INTERNAL-TOO is non-nil. Asks before killing
-each buffer, unless NO-ASK is non-nil."
+ "Kill buffers whose names match the regular expression REGEXP.
+Interactively, prompt for REGEXP.
+Ignores buffers whose names start with a space, unless optional
+prefix argument INTERNAL-TOO(interactively, the prefix argument)
+is non-nil. Asks before killing each buffer, unless NO-ASK is non-nil."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
(let ((name (buffer-name buffer)))
@@ -7100,6 +7113,17 @@ each buffer, unless NO-ASK is non-nil."
(string-match regexp name))
(funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer)))))
+(defun kill-matching-buffers-no-ask (regexp &optional internal-too)
+ "Kill buffers whose names match the regular expression REGEXP.
+Interactively, prompt for REGEXP.
+Like `kill-matching-buffers', but doesn't ask for confirmation
+before killing each buffer.
+Ignores buffers whose names start with a space, unless the
+optional argument INTERNAL-TOO (interactively, the prefix argument)
+is non-nil."
+ (interactive "sKill buffers matching this regular expression: \nP")
+ (kill-matching-buffers regexp internal-too t))
+
(defun rename-auto-save-file ()
"Adjust current buffer's auto save file name for current conditions.
@@ -7669,9 +7693,12 @@ regardless of the language.")
(defvar insert-directory-ls-version 'unknown)
(defun insert-directory-wildcard-in-dir-p (dir)
- "Return non-nil if DIR contents a shell wildcard in the directory part.
-The return value is a cons (DIR . WILDCARDS); DIR is the
-`default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
+ "Return non-nil if DIR contains shell wildcards in its parent directory part.
+The return value is a cons (DIRECTORY . WILDCARD), where DIRECTORY is the
+part of DIR up to and excluding the first component that includes
+wildcard characters, and WILDCARD is the rest of DIR's components. The
+DIRECTORY part of the value includes the trailing slash, to indicate that
+it is a directory.
Valid wildcards are `*', `?', `[abc]' and `[a-z]'."
(let ((wildcards "[?*"))
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index 83bdaba5352..33376ee4ed9 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -177,7 +177,9 @@ using GNU findutils (on macOS and *BSD systems), see
instead the
man page for \"find\"."
(interactive (list (read-directory-name "Run find in directory: " nil "" t)
(read-string "Run find (with args): " find-args
- '(find-args-history . 1))))
+ (if find-args
+ '(find-args-history . 1)
+ 'find-args-history))))
(setq find-args args ; save for next interactive call
args (concat find-program " . "
(if (string= args "")
@@ -209,7 +211,7 @@ it finishes, type \\[kill-find]."
" . \\( \\) "
(find-dired--escaped-ls-option))
(+ 1 (length find-program) (length " . \\( ")))
- find-command-history)))
+ 'find-command-history)))
(let ((dired-buffers dired-buffers))
;; Expand DIR ("" means default-directory), and make sure it has a
;; trailing slash.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 99df8fb9e06..1fa45379b9f 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -1183,7 +1183,7 @@ This function is the default
`font-lock-fontify-region-function'."
(setq font-lock-syntactically-fontified end))
(font-lock-fontify-syntactic-keywords-region start end)))
(unless font-lock-keywords-only
- (funcall font-lock-fontify-syntactically-function beg end loudly))
+ (font-lock-fontify-syntactically-region beg end loudly))
(font-lock-fontify-keywords-region beg end loudly)
`(jit-lock-bounds ,beg . ,end))))
@@ -1531,6 +1531,12 @@ START should be at the beginning of a line."
(defvar font-lock-comment-end-skip nil
"If non-nil, Font Lock mode uses this instead of `comment-end-skip'.")
+(defun font-lock-fontify-syntactically-region (beg end &optional loudly)
+ "Syntactically fontify the text between BEG and END.
+If LOUDLY is non-nil, print status messages while fontifying.
+This works by calling `font-lock-fontify-syntactically-function'."
+ (funcall font-lock-fontify-syntactically-function beg end loudly))
+
(defun font-lock-default-fontify-syntactically (start end &optional loudly)
"Put proper face on each string and comment between START and END.
START should be at the beginning of a line."
@@ -2369,7 +2375,6 @@ 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 322a6f9aa59..fa376788eb0 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -2189,7 +2189,7 @@ frame's display)."
This means that, for example, DISPLAY can differentiate between
the keybinding RET and [return]."
(let ((frame-type (framep-on-display display)))
- (or (memq frame-type '(x w32 ns pc pgtk))
+ (or (memq frame-type '(x w32 ns pc pgtk haiku))
;; MS-DOS and MS-Windows terminals have built-in support for
;; function (symbol) keys
(memq system-type '(ms-dos windows-nt)))))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index c989a12d205..1ab33cc6411 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -78,7 +78,7 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
(require 'cus-edit)
(defconst hfy-meta-tags
@@ -372,11 +372,15 @@ otherwise."
:tag "istext-command"
:type '(string))
-(defcustom hfy-find-cmd
- "find . -type f \\! -name \\*~ \\! -name \\*.flc \\! -path \\*/CVS/\\*"
- "Find command used to harvest a list of files to attempt to fontify."
- :tag "find-command"
- :type '(string))
+(defcustom hfy-exclude-file-rules
+ '("\\.flc\\'"
+ "/CVS/"
+ "~\\'"
+ "/\\.git\\(?:/\\|\\'\\)")
+ "Regular expressions matching files to exclude."
+ :tag "exclude-rules"
+ :type '(repeat regexp)
+ :version "29.1")
(defcustom hfy-display-class nil
"Display class to use to determine which display class to use when
@@ -1826,8 +1830,12 @@ Strips any leading \"./\" from each filename."
;;(message "hfy-list-files");;DBUG
;; FIXME: this changes the dir of the current buffer. Is that right??
(cd directory)
- (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F))
- (split-string (shell-command-to-string hfy-find-cmd))) )
+ (cl-remove-if (lambda (f)
+ (or (null (file-regular-p f))
+ (seq-some (lambda (r)
+ (string-match r f))
+ hfy-exclude-file-rules)))
+ (directory-files-recursively "." "" nil t)))
;; strip the filename off, return a directory name
;; not a particularly thorough implementation, but it will be
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 9fa622017f7..014f38b2024 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -252,7 +252,7 @@ the default otherwise."
"Step forward completions by one entry.
Second entry becomes the first and can be selected with
`icomplete-force-complete-and-exit'.
-Return non-nil iff something was stepped."
+Return non-nil if something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
@@ -270,7 +270,7 @@ Return non-nil iff something was stepped."
"Step backward completions by one entry.
Last entry becomes the first and can be selected with
`icomplete-force-complete-and-exit'.
-Return non-nil iff something was stepped."
+Return non-nil if something was stepped."
(interactive)
(let* ((beg (icomplete--field-beg))
(end (icomplete--field-end))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 4f6addea387..52019697ad7 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -863,7 +863,8 @@ This attribute is meaningful only when `:coding-type' is
`utf-16' or
VALUE must be `big' or `little' specifying big-endian and
little-endian respectively. The default value is `big'.
-This attribute is meaningful only when `:coding-type' is `utf-16'.
+Changing this attribute is only meaningful when `:coding-type'
+is `utf-16'.
`:ccl-decoder' (required if :coding-type is `ccl')
@@ -2539,6 +2540,10 @@ This function is intended to be added to
`auto-coding-functions'."
(bfcs-type
(coding-system-type buffer-file-coding-system)))
(if (and enable-multibyte-characters
+ ;; 'charset' will signal an error in
+ ;; coding-system-equal, since it isn't a
+ ;; coding-system. So test that up front.
+ (not (equal sym-type 'charset))
(coding-system-equal 'utf-8 sym-type)
(coding-system-equal 'utf-8 bfcs-type))
buffer-file-coding-system
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 315eaab7560..791221f2459 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -186,10 +186,17 @@ a menu, so this function is not useful for non-menu
keymaps."
(declare (indent defun)
(compiler-macro (lambda (form) (keymap--compile-check key) form)))
(keymap--check key)
- (when after
- (keymap--check after))
+ (when (eq after t) (setq after nil)) ; nil and t are treated the same
+ (when (stringp after)
+ (keymap--check after)
+ (setq after (key-parse after)))
+ ;; If we're binding this key to another key, then parse that other
+ ;; key, too.
+ (when (stringp definition)
+ (keymap--check definition)
+ (setq definition (key-parse definition)))
(define-key-after keymap (key-parse key) definition
- (and after (key-parse after))))
+ after))
(defun key-parse (keys)
"Convert KEYS to the internal Emacs key representation.
@@ -404,7 +411,7 @@ specified buffer position instead of point are used."
(symbolp value))
(or (command-remapping value) value)
value))
- (key-binding (kbd key) accept-default no-remap position)))
+ (key-binding (key-parse key) accept-default no-remap position)))
(defun keymap-local-lookup (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index c21955c3f06..4d5921582cc 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1079,10 +1079,11 @@ or a regexp (using some regexp special characters). If
it is a word,
search for matches for that word as a substring. If it is a list of words,
search for matches for any two (or more) of those words.
-Note that by default this command only searches in the file specified by
-`internal-doc-file-name'; i.e., the etc/DOC file. With \\[universal-argument]
prefix,
-or if `apropos-do-all' is non-nil, it searches all currently defined
-documentation strings.
+Note that by default this command only searches in the functions predefined
+at Emacs startup, i.e., the primitives implemented in C or preloaded in the
+Emacs dump image.
+With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, it
searches
+all currently defined documentation strings.
Returns list of symbols and documentation found.
@@ -2929,6 +2930,10 @@ Major mode for editing C, powered by tree-sitter.
(autoload 'c-ts-mode "c-ts-mode" "\
Major mode for editing C, powered by tree-sitter.
+This mode is independent from the classic cc-mode.el based
+`c-mode', so configuration variables of that mode, like
+`c-basic-offset', don't affect this mode.
+
(fn)" t)
(autoload 'c++-ts-mode "c-ts-mode" "\
Major mode for editing C++, powered by tree-sitter.
@@ -4114,6 +4119,22 @@ Optional argument LAX (interactively, the prefix
argument), if
non-nil, means also include partially matching ligatures and
non-canonical equivalences.
+Each line of the display shows the equivalences in two different
+ways separated by a colon:
+
+ - as the literal character or sequence
+ - using an ASCII-only escape syntax
+
+For example, for the letter \\='r\\=', the first line is
+
+ r: ?\\N{LATIN SMALL LETTER R}
+
+which is for the requested character itself, and a later line has
+
+ ṟ: ?\\N{LATIN SMALL LETTER R}?\\N{COMBINING MACRON BELOW}
+
+which clearly shows what the constituent characters are.
+
(fn CHAR &optional LAX)" t)
(register-definition-prefixes "char-fold" '("char-fold-"))
@@ -11261,8 +11282,10 @@ For more information, see Info node `(eww) Top'.
(defalias 'browse-web 'eww)
(autoload 'eww-open-file "eww" "\
Render FILE using EWW.
+If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
+new buffer instead of reusing the default EWW buffer.
-(fn FILE)" t)
+(fn FILE &optional NEW-BUFFER)" t)
(autoload 'eww-search-words "eww" "\
Search the web for the text in the region.
If region is active (and not whitespace), search the web for
@@ -22327,7 +22350,7 @@ Coloring:
;;; Generated autoloads from org/org.el
-(push (purecopy '(org 9 6)) package--builtin-versions)
+(push (purecopy '(org 9 6 1)) package--builtin-versions)
(autoload 'org-babel-do-load-languages "org" "\
Load the languages defined in `org-babel-load-languages'.
@@ -24511,6 +24534,7 @@ Ignores leading comment characters.
(autoload 'pp-emacs-lisp-code "pp" "\
Insert SEXP into the current buffer, formatted as Emacs Lisp code.
Use the `pp-max-width' variable to control the desired line length.
+Note that this could be slow for large SEXPs.
(fn SEXP)")
(register-definition-prefixes "pp" '("pp-"))
@@ -25097,7 +25121,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 9 3)) package--builtin-versions)
+(push (purecopy '(project 0 9 4)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -27320,6 +27344,13 @@ it is disabled.
;;; Generated autoloads from progmodes/ruby-mode.el
(push (purecopy '(ruby-mode 1 2)) package--builtin-versions)
+(autoload 'ruby-base-mode "ruby-mode" "\
+Generic major mode for editing Ruby.
+
+This mode is intended to be inherited by concrete major modes.
+Currently there are `ruby-mode' and `ruby-ts-mode'.
+
+(fn)" t)
(autoload 'ruby-mode "ruby-mode" "\
Major mode for editing Ruby code.
@@ -27329,6 +27360,15 @@ Major mode for editing Ruby code.
(register-definition-prefixes "ruby-mode" '("ruby-"))
+;;; Generated autoloads from progmodes/ruby-ts-mode.el
+
+(autoload 'ruby-ts-mode "ruby-ts-mode" "\
+Major mode for editing Ruby, powered by tree-sitter.
+
+(fn)" t)
+(register-definition-prefixes "ruby-ts-mode" '("ruby-ts-"))
+
+
;;; Generated autoloads from ruler-mode.el
(defvar-local ruler-mode nil "\
@@ -30223,7 +30263,7 @@ Return the width of STRING in pixels.
(autoload 'string-glyph-split "subr-x" "\
Split STRING into a list of strings representing separate glyphs.
This takes into account combining characters and grapheme clusters:
-if compositions are enbaled, each sequence of characters composed
+if compositions are enabled, each sequence of characters composed
on display into a single grapheme cluster is treated as a single
indivisible unit.
@@ -32409,7 +32449,6 @@ Mode for displaying and reprioritizing top priority
Todo.
;;; Generated autoloads from textmodes/toml-ts-mode.el
-(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))
(autoload 'toml-ts-mode "toml-ts-mode" "\
Major mode for editing TOML, powered by tree-sitter.
@@ -32601,7 +32640,7 @@ It must be supported by libarchive(3).")
List of suffixes which indicate a compressed file.
It must be supported by libarchive(3).")
(defmacro tramp-archive-autoload-file-name-regexp nil "\
-Regular expression matching archive file names." (if (<= emacs-major-version
26) '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:"
"\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/"
".*" "\\)" "\\'") `(rx bos (group (+ nonl) "." (| ,@tramp-archive-suffixes) (32
"." (| ,@tramp-archive-compression-suffixes))) (group "/" (* nonl)) eos)))
+Regular expression matching archive file names." `(rx bos (group (+ nonl) "."
(| ,@tramp-archive-suffixes) (32 "." (| ,@tramp-archive-compression-suffixes)))
(group "/" (* nonl)) eos))
(defun tramp-archive-autoload-file-name-handler (operation &rest args) "\
Load Tramp archive file name handler, and perform OPERATION." (defvar
tramp-archive-autoload) (let ((default-directory temporary-file-directory)
(tramp-archive-autoload tramp-archive-enabled)) (apply
#'tramp-autoload-file-name-handler operation args)))
(defun tramp-register-archive-autoload-file-name-handler nil "\
@@ -32623,7 +32662,6 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/tramp-compat.el
- (defalias 'tramp-compat-rx #'rx)
(register-definition-prefixes "tramp-compat" '("tramp-"))
@@ -32689,7 +32727,7 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 6 0 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 7 0 -1)) package--builtin-versions)
(register-definition-prefixes "trampver" '("tramp-"))
@@ -32797,6 +32835,21 @@ See info node `(transient)Modifying Existing
Transients'.
;;; Generated autoloads from treesit.el
+(autoload 'treesit-install-language-grammar "treesit" "\
+Build and install the tree-sitter language grammar library for LANG.
+
+Interactively, if `treesit-language-source-alist' doesn't already
+have data for building the grammar for LANG, prompt for its
+repository URL and the C/C++ compiler to use.
+
+This command requires Git, a C compiler and (sometimes) a C++ compiler,
+and the linker to be installed and on PATH. It also requires that the
+recipe for LANG exists in `treesit-language-source-alist'.
+
+See `exec-path' for the current path where Emacs looks for
+executable programs, such as the C/C++ compiler and linker.
+
+(fn LANG)" t)
(register-definition-prefixes "treesit" '("treesit-"))
@@ -36791,7 +36844,7 @@ If LIMIT is non-nil, then do not consider characters
beyond LIMIT.
;;; Generated autoloads from progmodes/xref.el
-(push (purecopy '(xref 1 6 0)) package--builtin-versions)
+(push (purecopy '(xref 1 6 1)) package--builtin-versions)
(autoload 'xref-find-backend "xref")
(define-obsolete-function-alias 'xref-pop-marker-stack #'xref-go-back "29.1")
(autoload 'xref-go-back "xref" "\
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 217bebcfcb2..81ff14932c6 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -482,8 +482,22 @@ not contain `d', so that a full listing is expected."
(if (not dir-wildcard)
(funcall orig-fun dir-or-list switches)
(let* ((default-directory (car dir-wildcard))
- (files (file-expand-wildcards (cdr dir-wildcard)))
+ (wildcard (cdr dir-wildcard))
+ (files (file-expand-wildcards wildcard))
(dir (car dir-wildcard)))
+ ;; When the wildcard ends in a slash, file-expand-wildcards
+ ;; returns nil; fix that by treating the wildcards as
+ ;; specifying only directories whose names match the
+ ;; widlcard.
+ (if (and (null files)
+ (directory-name-p wildcard))
+ (setq files
+ (delq nil
+ (mapcar (lambda (fname)
+ (if (file-accessible-directory-p fname)
+ fname))
+ (file-expand-wildcards
+ (directory-file-name wildcard))))))
(if files
(let ((inhibit-read-only t)
(buf
@@ -494,7 +508,7 @@ not contain `d', so that a full listing is expected."
(dired-goto-next-file)
(forward-line 0)
(insert " wildcard " (cdr dir-wildcard) "\n"))))
- (user-error "No files matching regexp")))))))
+ (user-error "No files matching wildcard")))))))
(advice-add 'dired :around #'ls-lisp--dired)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 659649b5d42..c56f4ce62dc 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4580,6 +4580,9 @@ Argument MIME is non-nil if this is a mime message."
(current-buffer))))
(error nil))
+ ;; Decode any base64-encoded material in what we just decrypted.
+ (rmail-epa-decode armor-start after-end)
+
(list armor-start (- (point-max) after-end) mime
armor-end-regexp
(buffer-substring armor-start (- (point-max) after-end)))))
@@ -4622,9 +4625,6 @@ Argument MIME is non-nil if this is a mime message."
"> ")
(push (rmail-epa-decrypt-1 mime) decrypts))))
- ;; Decode any base64-encoded mime sections.
- (rmail-epa-decode)
-
(when (and decrypts (rmail-buffers-swapped-p))
(when (y-or-n-p "Replace the original message? ")
(when (eq major-mode 'rmail-mode)
@@ -4689,12 +4689,14 @@ Argument MIME is non-nil if this is a mime message."
(unless decrypts
(error "Nothing to decrypt")))))
-;; Decode all base64-encoded mime sections, so that this change
-;; is made in the Rmail file, not just in the viewing buffer.
-(defun rmail-epa-decode ()
+;; Decode all base64-encoded mime sections from BEG to (Z - BACK-FROM-END),
+;; so that we save the decoding permanently in the Rmail buffer
+;; if we permanently save the decryption.
+(defun rmail-epa-decode (beg back-from-end)
(save-excursion
- (goto-char (point-min))
- (while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t)
+ (goto-char beg)
+ (while (re-search-forward "--------------[0-9a-zA-Z]+\n"
+ (- (point-max) back-from-end) t)
;; The ending delimiter is a start delimiter if another section follows.
;; Otherwise it is an end delimiter, with -- affixed.
(let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n")))
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 1640c23e002..34c809a5ecd 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -764,6 +764,8 @@ This assumes that a temporary buffer is set up."
;; Sample '-version' outputs:
;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003]
;; install-mh -- nmh-1.7.1 built October 26, 2019 on build-server-000
+ ;; "libdir" was deprecated in nmh-1.7 in favor of "libexecdir", and
+ ;; removed completely in nmh-1.8.
(let ((install-mh (expand-file-name "install-mh" dir)))
(when (mh-file-command-p install-mh)
(erase-buffer)
@@ -774,7 +776,8 @@ This assumes that a temporary buffer is set up."
(mh-progs dir))
`(,version
(variant nmh)
- (mh-lib-progs ,(mh-profile-component "libdir"))
+ (mh-lib-progs ,(or (mh-profile-component "libdir")
+ (mh-profile-component "libexecdir")))
(mh-lib ,(mh-profile-component "etcdir"))
(mh-progs ,dir)
(flists ,(file-exists-p
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index f47299bd0da..21d4607e7cf 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -986,7 +986,7 @@ already visible.
If the value is `visible', the *Completions* buffer is displayed
whenever completion is requested but cannot be done for the first time,
but remains visible thereafter, and the list of completions in it is
-updated for subsequent attempts to complete.."
+updated for subsequent attempts to complete."
:type '(choice (const :tag "Don't show" nil)
(const :tag "Show only when cannot complete" t)
(const :tag "Show after second failed completion attempt"
lazy)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 41c28672aae..e21367135d3 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -3534,7 +3534,8 @@ system TYPE.")
(setq file (expand-file-name file))
(let ((parsed (ange-ftp-ftp-name file)))
(if parsed
- (if (and delete-by-moving-to-trash trash)
+ (if (and delete-by-moving-to-trash trash
+ (not remote-file-name-inhibit-delete-by-moving-to-trash))
(move-file-to-trash file)
(let* ((host (nth 0 parsed))
(user (nth 1 parsed))
@@ -4378,6 +4379,10 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
;; or return nil meaning don't make a backup.
(if ange-ftp-make-backup-files
(ange-ftp-real-find-backup-file-name fn)))
+
+(defun ange-ftp-file-user-uid ()
+ ;; Return "don't know" value.
+ -1)
;;; Define the handler for special file names
;;; that causes ange-ftp to be invoked.
@@ -4518,6 +4523,9 @@ NEWNAME should be the name to give the new compressed or
uncompressed file.")
(put 'file-notify-add-watch 'ange-ftp 'ignore)
(put 'file-notify-rm-watch 'ange-ftp 'ignore)
(put 'file-notify-valid-p 'ange-ftp 'ignore)
+
+;; Return the "don't know' value for remote user uid.
+(put 'file-user-uid 'ange-ftp 'ange-ftp-file-user-uid)
;;; Define ways of getting at unmodified Emacs primitives,
;;; turning off our handler.
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 763b2f07a5c..73d11c0ef52 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -488,14 +488,17 @@ For more information, see Info node `(eww) Top'."
;;;###autoload (defalias 'browse-web 'eww)
;;;###autoload
-(defun eww-open-file (file)
- "Render FILE using EWW."
- (interactive "fFile: ")
+(defun eww-open-file (file &optional new-buffer)
+ "Render FILE using EWW.
+If NEW-BUFFER is non-nil (interactively, the prefix arg), use a
+new buffer instead of reusing the default EWW buffer."
+ (interactive "fFile: \nP")
(let ((url-allow-non-local-files t))
(eww (concat "file://"
(and (memq system-type '(windows-nt ms-dos))
"/")
- (expand-file-name file)))))
+ (expand-file-name file))
+ new-buffer)))
(defun eww--file-buffer (file)
(with-current-buffer (generate-new-buffer " *eww file*")
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 5477ad946ba..064b72f02c2 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -44,8 +44,10 @@
"Last message that the newsticker displayed.")
(defvar newsticker--scrollable-text ""
"The text which is scrolled smoothly in the echo area.")
+(defvar newsticker--ticker-period-timer nil
+ "Timer for newsticker ticker display.")
(defvar newsticker--ticker-timer nil
- "Timer for newsticker ticker.")
+ "Timer for newsticker ticker scrolling.")
;;;###autoload
(defun newsticker-ticker-running-p ()
@@ -77,7 +79,7 @@ value effective."
(defcustom newsticker-ticker-interval
0.3
- "Time interval for displaying news items in the echo area (seconds).
+ "Time interval for scrolling news items in the echo area (seconds).
If equal or less than 0 no messages are shown in the echo area. For
smooth display (see `newsticker-scroll-smoothly') a value of 0.3 seems
reasonable. For non-smooth display a value of 10 is a good starting
@@ -86,6 +88,17 @@ point."
:set #'newsticker--set-customvar-ticker
:group 'newsticker-ticker)
+(defcustom newsticker-ticker-period
+ 0
+ "Time interval for displaying news items in the echo area (seconds).
+If equal or less than 0 messages are shown continuously. In order not
+to miss new items, a value of equal or less than the shortest feed
+retrieval interval (or the global `newsticker-retrieval-interval`) is
+recommended."
+ :type 'number
+ :set #'newsticker--set-customvar-ticker
+ :group 'newsticker-ticker)
+
(defcustom newsticker-scroll-smoothly
t
"Decides whether to flash or scroll news items.
@@ -129,9 +142,16 @@ If t the echo area will not show obsolete items. See also
"Called from the display timer.
This function calls a display function, according to the variable
`newsticker-scroll-smoothly'."
- (if newsticker-scroll-smoothly
- (newsticker--display-scroll)
- (newsticker--display-jump)))
+ (when (not newsticker--ticker-timer)
+ (if newsticker-scroll-smoothly
+ (setq newsticker--ticker-timer
+ (run-at-time 1
+ newsticker-ticker-interval
+ #'newsticker--display-scroll))
+ (setq newsticker--ticker-timer
+ (run-at-time nil
+ newsticker-ticker-interval
+ #'newsticker--display-jump)))))
(defsubst newsticker--echo-area-clean-p ()
"Check whether somebody is using the echo area / minibuffer.
@@ -149,7 +169,12 @@ there is another message displayed or the minibuffer is
active."
(when (newsticker--echo-area-clean-p)
(setq newsticker--item-position (1+ newsticker--item-position))
(when (>= newsticker--item-position (length newsticker--item-list))
- (setq newsticker--item-position 0))
+ (setq newsticker--item-position 0)
+ (when (> newsticker-ticker-period 0)
+ (cancel-timer newsticker--ticker-timer)
+ (setq newsticker--ticker-timer nil)
+ (run-at-time newsticker-ticker-interval nil
+ (lambda () (message "")))))
(setq newsticker--prev-message
(nth newsticker--item-position newsticker--item-list))
(message "%s" newsticker--prev-message))))
@@ -192,7 +217,12 @@ there is another message displayed or the minibuffer is
active."
(setq newsticker--prev-message subtext)
(setq newsticker--item-position (1+ i))
(when (>= newsticker--item-position l)
- (setq newsticker--item-position 0))))))
+ (setq newsticker--item-position 0)
+ (when (> newsticker-ticker-period 0)
+ (cancel-timer newsticker--ticker-timer)
+ (setq newsticker--ticker-timer nil)
+ (run-at-time newsticker-ticker-interval nil
+ (lambda () (message "")))))))))
;;;###autoload
(defun newsticker-start-ticker ()
@@ -200,19 +230,26 @@ there is another message displayed or the minibuffer is
active."
Start display timer for the actual ticker if wanted and not
running already."
(interactive)
- (if (and (> newsticker-ticker-interval 0)
- (not newsticker--ticker-timer))
- (setq newsticker--ticker-timer
- (run-at-time newsticker-ticker-interval
- newsticker-ticker-interval
- #'newsticker--display-tick))))
+ (when (and (> newsticker-ticker-interval 0)
+ (not newsticker--ticker-period-timer)
+ (not newsticker--ticker-timer))
+ (if (> newsticker-ticker-period 0)
+ (setq newsticker--ticker-period-timer
+ (run-at-time nil
+ newsticker-ticker-period
+ #'newsticker--display-tick))
+ (newsticker--display-tick))))
(defun newsticker-stop-ticker ()
"Stop newsticker's ticker (but not the news retrieval)."
(interactive)
- (when newsticker--ticker-timer
- (cancel-timer newsticker--ticker-timer)
- (setq newsticker--ticker-timer nil)))
+ (progn
+ (when newsticker--ticker-timer
+ (cancel-timer newsticker--ticker-timer)
+ (setq newsticker--ticker-timer nil))
+ (when newsticker--ticker-period-timer
+ (cancel-timer newsticker--ticker-period-timer)
+ (setq newsticker--ticker-period-timer nil))))
;; ======================================================================
;;; Manipulation of ticker text
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index da7c20b5e0a..5e4aa5e1198 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -2062,12 +2062,11 @@ connection."
(next-single-property-change (point) 'hard)
(forward-char 1)
(throw 'exit nil))))
+ (goto-char (line-beginning-position))
(set-marker-insertion-type rcirc-prompt-start-marker t)
(set-marker-insertion-type rcirc-prompt-end-marker t)
;; run markup functions
- (unless (bolp)
- (newline))
(save-excursion
(save-restriction
(narrow-to-region (point) (point))
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 619d29bb4d6..10f33e5f929 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -153,6 +153,7 @@ It is used for TCP/IP devices."
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-adb-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-adb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -424,14 +425,10 @@ Emacs dired can't find files."
(defun tramp-adb-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)
- (if (and delete-by-moving-to-trash trash)
- (move-file-to-trash filename)
- (tramp-adb-barf-unless-okay
- v (format "rm %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename))))
+ (tramp-skeleton-delete-file filename trash
+ (tramp-adb-barf-unless-okay
+ v (format "rm %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename)))
(defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
@@ -1082,11 +1079,12 @@ E.g. a host name \"192.168.1.1#5555\" returns
\"192.168.1.1:5555\"
(format "%s:%s" host port))
;; An empty host name shall be mapped as well, when there
;; is exactly one entry in `devices'.
- ((and (zerop (length host)) (= (length devices) 1))
+ ((and (tramp-string-empty-or-nil-p host)
+ (tramp-compat-length= devices 1))
(car devices))
;; Try to connect device.
((and tramp-adb-connect-if-not-connected
- (not (zerop (length host)))
+ (tramp-compat-length> host 0)
(tramp-adb-execute-adb-command
vec "connect"
(tramp-compat-string-replace
@@ -1103,7 +1101,7 @@ E.g. a host name \"192.168.1.1#5555\" returns
\"192.168.1.1:5555\"
"Execute an adb command.
Insert the result into the connection buffer. Return nil on
error and non-nil on success."
- (when (and (> (length (tramp-file-name-host vec)) 0)
+ (when (and (tramp-compat-length> (tramp-file-name-host vec) 0)
;; The -s switch is only available for ADB device commands.
(not (member (car args) '("connect" "disconnect"))))
(setq args (append (list "-s" (tramp-adb-get-device vec)) args)))
@@ -1230,7 +1228,7 @@ connection if a previous connection has died for some
reason."
(unless (process-live-p p)
(save-match-data
(when (and p (processp p)) (delete-process p))
- (if (zerop (length device))
+ (if (tramp-string-empty-or-nil-p device)
(tramp-error vec 'file-error "Device %s not connected" host))
(with-tramp-progress-reporter vec 3 "Opening adb shell connection"
(let* ((coding-system-for-read 'utf-8-dos) ; Is this correct?
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index a2add1ed73a..7c1f578d085 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -265,6 +265,7 @@ It must be supported by libarchive(3).")
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-archive-handle-file-system-info)
(file-truename . tramp-archive-handle-file-truename)
+ (file-user-uid . tramp-archive-handle-file-user-uid)
(file-writable-p . ignore)
(find-backup-file-name . ignore)
;; `get-file-buffer' performed by default handler.
@@ -598,7 +599,7 @@ offered."
(defun tramp-archive-handle-directory-file-name (directory)
"Like `directory-file-name' for file archives."
(with-parsed-tramp-archive-file-name directory nil
- (if (and (not (zerop (length localname)))
+ (if (and (tramp-compat-length> localname 0)
(eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/")))
(substring directory 0 -1)
@@ -669,6 +670,13 @@ offered."
(setq local (expand-file-name local (file-name-directory localname))))
(concat (file-truename archive) local))))
+(defun tramp-archive-handle-file-user-uid ()
+ "Like `user-uid' for file archives."
+ (with-parsed-tramp-archive-file-name default-directory nil
+ (let ((default-directory (file-name-directory archive)))
+ ;; `file-user-uid' exists since Emacs 30.1.
+ (tramp-compat-funcall 'file-user-uid))))
+
(defun tramp-archive-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for file archives."
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index dc967dccf68..6627ef47ee2 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -127,7 +127,7 @@ When called interactively, a Tramp connection has to be
selected."
(or (not keep-processes)
(eq key (tramp-get-process vec))))
(tramp-flush-connection-properties key)
- (delete-process key)))
+ (ignore-errors (delete-process key))))
;; Remove buffers.
(dolist
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 6a2654ee474..01f1c38988c 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -37,7 +37,6 @@
(require 'subr-x)
(declare-function tramp-error "tramp")
-(declare-function tramp-file-name-handler "tramp")
(declare-function tramp-tramp-file-p "tramp")
(defvar tramp-temp-name-prefix)
@@ -178,6 +177,48 @@ Add the extension of F, if existing."
(car components))
(cdr components)))))))
+;; Function `replace-regexp-in-region' is new in Emacs 28.1.
+(defalias 'tramp-compat-replace-regexp-in-region
+ (if (fboundp 'replace-regexp-in-region)
+ #'replace-regexp-in-region
+ (lambda (regexp replacement &optional start end)
+ (if start
+ (when (< start (point-min))
+ (error "Start before start of buffer"))
+ (setq start (point)))
+ (if end
+ (when (> end (point-max))
+ (error "End after end of buffer"))
+ (setq end (point-max)))
+ (save-excursion
+ (let ((matches 0)
+ (case-fold-search nil))
+ (goto-char start)
+ (while (re-search-forward regexp end t)
+ (replace-match replacement t)
+ (setq matches (1+ matches)))
+ (and (not (zerop matches))
+ matches))))))
+
+;; `length<', `length>' and `length=' are added to Emacs 28.1.
+(defalias 'tramp-compat-length<
+ (if (fboundp 'length<)
+ #'length<
+ (lambda (sequence length)
+ (< (length sequence) length))))
+
+(defalias 'tramp-compat-length>
+ (if (fboundp 'length>)
+ #'length>
+ (lambda (sequence length)
+ (> (length sequence) length))))
+
+(defalias 'tramp-compat-length=
+ (if (fboundp 'length=)
+ #'length=
+ (lambda (sequence length)
+ (= (length sequence) length))))
+
;; `permission-denied' is introduced in Emacs 29.1.
(defconst tramp-permission-denied
(if (get 'permission-denied 'error-conditions) 'permission-denied
'file-error)
@@ -205,7 +246,7 @@ Add the extension of F, if existing."
#'take
(lambda (n list)
(when (and (natnump n) (> n 0))
- (if (>= n (length list))
+ (if (tramp-compat-length< list n)
list (butlast list (- (length list) n)))))))
;; Function `ntake' is new in Emacs 29.1.
@@ -214,7 +255,7 @@ Add the extension of F, if existing."
#'ntake
(lambda (n list)
(when (and (natnump n) (> n 0))
- (if (>= n (length list))
+ (if (tramp-compat-length< list n)
list (nbutlast list (- (length list) n)))))))
;; Function `string-equal-ignore-case' is new in Emacs 29.1.
@@ -234,29 +275,6 @@ Add the extension of F, if existing."
(autoload 'netrc-parse "netrc")
(netrc-parse file))))
-;; Function `replace-regexp-in-region' is new in Emacs 28.1.
-(defalias 'tramp-compat-replace-regexp-in-region
- (if (fboundp 'replace-regexp-in-region)
- #'replace-regexp-in-region
- (lambda (regexp replacement &optional start end)
- (if start
- (when (< start (point-min))
- (error "Start before start of buffer"))
- (setq start (point)))
- (if end
- (when (> end (point-max))
- (error "End after end of buffer"))
- (setq end (point-max)))
- (save-excursion
- (let ((matches 0)
- (case-fold-search nil))
- (goto-char start)
- (while (re-search-forward regexp end t)
- (replace-match replacement t)
- (setq matches (1+ matches)))
- (and (not (zerop matches))
- matches))))))
-
(dolist (elt (all-completions "tramp-compat-" obarray 'functionp))
(put (intern elt) 'tramp-suppress-trace t))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 61d1c529619..afd3166d161 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -204,6 +204,7 @@ If NAME doesn't belong to an encrypted remote directory,
return nil."
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-crypt-handle-file-system-info)
;; `file-truename' performed by default handler.
+ ;; `file-user-uid' performed by default-handler.
(file-writable-p . tramp-crypt-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -689,17 +690,17 @@ absolute file names."
(directory &optional recursive _trash)
"Like `delete-directory' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name directory) nil
- (tramp-flush-directory-properties v localname)
(let (tramp-crypt-enabled)
- (delete-directory (tramp-crypt-encrypt-file-name directory) recursive))))
+ (delete-directory (tramp-crypt-encrypt-file-name directory) recursive))
+ (tramp-flush-directory-properties v localname)))
;; Encrypted files won't be trashed.
(defun tramp-crypt-handle-delete-file (filename &optional _trash)
"Like `delete-file' for Tramp files."
(with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-flush-file-properties v localname)
(let (tramp-crypt-enabled)
- (delete-file (tramp-crypt-encrypt-file-name filename)))))
+ (delete-file (tramp-crypt-encrypt-file-name filename)))
+ (tramp-flush-file-properties v localname)))
(defun tramp-crypt-handle-directory-files
(directory &optional full match nosort count)
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index c8754e2b03d..b846caadc18 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -34,15 +34,13 @@
(defun tramp-fuse-handle-delete-directory
(directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (tramp-flush-directory-properties v localname)
+ (tramp-skeleton-delete-directory directory recursive trash
(delete-directory (tramp-fuse-local-file-name directory) recursive trash)))
(defun tramp-fuse-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (delete-file (tramp-fuse-local-file-name filename) trash)
- (tramp-flush-file-properties v localname)))
+ (tramp-skeleton-delete-file filename trash
+ (delete-file (tramp-fuse-local-file-name filename) trash)))
(defvar tramp-fuse-remove-hidden-files nil
"Remove hidden files from directory listings.")
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index bb81b3eb66c..02ceb2979f7 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -798,6 +798,7 @@ It has been changed in GVFS 1.14.")
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-gvfs-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -1139,25 +1140,23 @@ file names."
(defun tramp-gvfs-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-flush-file-properties v localname)
- (if (and delete-by-moving-to-trash trash)
- (move-file-to-trash filename)
- (unless (and (tramp-gvfs-send-command
- v "gvfs-rm" (tramp-gvfs-url-file-name filename))
- (not (tramp-gvfs-info filename)))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename))))))
+ (tramp-skeleton-delete-file filename trash
+ (unless (and (tramp-gvfs-send-command
+ v "gvfs-rm" (tramp-gvfs-url-file-name filename))
+ (not (tramp-gvfs-info filename)))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename)))))
(defun tramp-gvfs-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
+ (when (string-empty-p name)
+ (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@@ -1172,7 +1171,7 @@ file names."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
- (when (zerop (length uname))
+ (when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -1533,7 +1532,7 @@ If FILE-SYSTEM is non-nil, return file system attributes."
'file-notify-callback (list proc action file file1)))))
;; Save rest of the string.
- (when (zerop (length string)) (setq string nil))
+ (when (string-empty-p string) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
@@ -1614,7 +1613,7 @@ VEC or USER, or if there is no home directory, return
nil."
(let ((localname (tramp-get-connection-property vec "default-location"))
result)
(cond
- ((zerop (length localname))
+ ((tramp-string-empty-or-nil-p localname)
(tramp-get-connection-property (tramp-get-process vec) "share"))
;; Google-drive.
((not (string-prefix-p "/" localname))
@@ -1746,11 +1745,11 @@ a downcased host name only."
(condition-case nil
(with-parsed-tramp-file-name filename l
- (when (and (zerop (length user))
+ (when (and (tramp-string-empty-or-nil-p user)
(not
(zerop (logand flags tramp-gvfs-password-need-username))))
(setq user (read-string "User name: ")))
- (when (and (zerop (length domain))
+ (when (and (tramp-string-empty-or-nil-p domain)
(not
(zerop (logand flags tramp-gvfs-password-need-domain))))
(setq domain (read-string "Domain name: ")))
@@ -2187,7 +2186,7 @@ connection if a previous connection has died for some
reason."
(with-tramp-progress-reporter
vec 3
- (if (zerop (length user))
+ (if (tramp-string-empty-or-nil-p user)
(format "Opening connection for %s using %s" host method)
(format "Opening connection for %s@%s using %s" user host method))
@@ -2237,7 +2236,7 @@ connection if a previous connection has died for some
reason."
(with-timeout
((or (tramp-get-method-parameter vec 'tramp-connection-timeout)
tramp-connection-timeout)
- (if (zerop (length (tramp-file-name-user vec)))
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(tramp-error
vec 'file-error
"Timeout reached mounting %s using %s" host method)
@@ -2416,7 +2415,7 @@ VEC is used only for traces."
;; Adapt default host name, supporting /mtp:: when possible.
(setq tramp-default-host-alist
(append
- `(("mtp" nil ,(if (= (length devices) 1) (car devices) "")))
+ `(("mtp" nil ,(if (tramp-compat-length= devices 1) (car devices)
"")))
(delete
(assoc "mtp" tramp-default-host-alist)
tramp-default-host-alist)))))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 4018fa3aa29..9eb2a54cdcf 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -118,6 +118,7 @@
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-rclone-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -361,7 +362,7 @@ connection if a previous connection has died for some
reason."
(let ((host (tramp-file-name-host vec)))
(when (rassoc `(,host) (tramp-rclone-parse-device-names nil))
- (if (zerop (length host))
+ (if (tramp-string-empty-or-nil-p host)
(tramp-error vec 'file-error "Storage %s not connected" host))
;; We need a process bound to the connection buffer. Therefore,
;; we create a dummy process. Maybe there is a better solution?
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index fbdd40dd1d2..25bc59eb4ff 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1086,6 +1086,7 @@ Format specifiers \"%s\" are replaced before the script
is used.")
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-sh-handle-file-system-info)
(file-truename . tramp-sh-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-sh-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -1131,119 +1132,55 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
(defun tramp-sh-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name (expand-file-name linkname) nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target))))
- ;; There could be a cyclic link.
- (tramp-flush-file-properties
- v (expand-file-name target (tramp-file-local-name default-directory))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
-
- (let ((ln (tramp-get-remote-ln v))
- (cwd (tramp-run-real-handler
- #'file-name-directory (list localname))))
- (unless ln
- (tramp-error
- v 'file-error
- (concat "Making a symbolic link. "
- "ln(1) does not exist on the remote host.")))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Right, they are on the same host, regardless of user,
- ;; method, etc. We now make the link on the remote machine.
- ;; This will occur as the user that TARGET belongs to.
- (and (tramp-send-command-and-check
- v (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- v (format
- "%s -sf %s %s" ln
- (tramp-shell-quote-argument target)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file names
- ;; could start with "-".
- ;; `tramp-shell-quote-argument' does not handle this,
- ;; we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory localname))))))))))
+ "Like `make-symbolic-link' for Tramp files."
+ (let ((v (tramp-dissect-file-name (expand-file-name linkname))))
+ (unless (tramp-get-remote-ln v)
+ (tramp-error
+ v 'file-error
+ (concat "Making a symbolic link. "
+ "ln(1) does not exist on the remote host."))))
+
+ (tramp-skeleton-handle-make-symbolic-link target linkname
ok-if-already-exists
+ (and (tramp-send-command-and-check
+ v (format
+ "cd %s"
+ (tramp-shell-quote-argument (file-name-directory localname))))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" (tramp-get-remote-ln v)
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use relative
+ ;; file names.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (let ((result
- (cond
- ;; Use GNU readlink --canonicalize-missing where available.
- ((tramp-get-remote-readlink v)
- (tramp-send-command-and-check
- v (format "%s --canonicalize-missing %s"
- (tramp-get-remote-readlink v)
- (tramp-shell-quote-argument localname)))
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (buffer-substring (point-min) (line-end-position))))
-
- ;; Use Perl implementation.
- ((and (tramp-get-remote-perl v)
- (tramp-get-connection-property v "perl-file-spec")
- (tramp-get-connection-property v "perl-cwd-realpath"))
- (tramp-maybe-send-script
- v tramp-perl-file-truename "tramp_perl_file_truename")
- (tramp-send-command-and-read
- v (format "tramp_perl_file_truename %s"
- (tramp-shell-quote-argument localname))))
-
- ;; Do it yourself.
- (t (tramp-file-local-name
- (tramp-handle-file-truename filename))))))
-
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (file-remote-p result)
- (setq result (file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
+ (tramp-skeleton-file-truename filename
+ (cond
+ ;; Use GNU readlink --canonicalize-missing where available.
+ ((tramp-get-remote-readlink v)
+ (tramp-send-command-and-check
+ v (format "%s --canonicalize-missing %s"
+ (tramp-get-remote-readlink v)
+ (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (buffer-substring (point-min) (line-end-position))))
+
+ ;; Use Perl implementation.
+ ((and (tramp-get-remote-perl v)
+ (tramp-get-connection-property v "perl-file-spec")
+ (tramp-get-connection-property v "perl-cwd-realpath"))
+ (tramp-maybe-send-script
+ v tramp-perl-file-truename "tramp_perl_file_truename")
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_truename %s"
+ (tramp-shell-quote-argument localname))))
+
+ ;; Do it yourself.
+ (t (tramp-file-local-name
+ (tramp-handle-file-truename filename))))))
;; Basic functions.
@@ -1736,7 +1673,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; Sometimes, when a connection is not established yet, it is
;; desirable to return t immediately for "/method:foo:". It can
;; be expected that this is always a directory.
- (or (zerop (length localname))
+ (or (tramp-string-empty-or-nil-p localname)
(with-tramp-file-property v localname "file-directory-p"
(if-let
((truename (tramp-get-file-property v localname "file-truename"))
@@ -2349,7 +2286,7 @@ The method used must be an out-of-band method."
copy-program copy-args copy-env copy-keep-date listener spec
options source target remote-copy-program remote-copy-args p)
- (if (and v1 v2 (zerop (length (tramp-scp-direct-remote-copying v1 v2))))
+ (if (and v1 v2 (string-empty-p (tramp-scp-direct-remote-copying v1 v2)))
;; Both are Tramp files. We cannot use direct remote copying.
(let* ((dir-flag (file-directory-p filename))
@@ -2567,14 +2504,10 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (setq filename (expand-file-name (expand-file-name filename)))
- (with-parsed-tramp-file-name filename nil
- (if (and delete-by-moving-to-trash trash)
- (move-file-to-trash filename)
- (tramp-barf-unless-okay
- v (format "rm -f %s" (tramp-shell-quote-argument localname))
- "Couldn't delete %s" filename))
- (tramp-flush-file-properties v localname)))
+ (tramp-skeleton-delete-file filename trash
+ (tramp-barf-unless-okay
+ v (format "rm -f %s" (tramp-shell-quote-argument localname))
+ "Couldn't delete %s" filename)))
;; Dired.
@@ -2688,9 +2621,9 @@ The method used must be an out-of-band method."
(tramp-get-ls-command v)
switches
(if (or wildcard
- (zerop (length
- (tramp-run-real-handler
- #'file-name-nondirectory (list
localname)))))
+ (tramp-string-empty-or-nil-p
+ (tramp-run-real-handler
+ #'file-name-nondirectory (list localname))))
""
(tramp-shell-quote-argument
(tramp-run-real-handler
@@ -2807,7 +2740,8 @@ the result will be a local, non-Tramp, file name."
;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
+ (when (string-empty-p 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 false positive "/:".
@@ -2842,7 +2776,7 @@ the result will be a local, non-Tramp, file name."
;; the default user name for tilde expansion is not
;; appropriate either, because ssh and companions might
;; use a user name from the config file.
- (when (and (zerop (length uname))
+ (when (and (tramp-string-empty-or-nil-p uname)
(string-match-p (rx bos "su" (? "do") eos) method))
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
@@ -2943,7 +2877,7 @@ implementation will be used."
(heredoc (and (not (bufferp stderr))
(stringp program)
(string-match-p (rx "sh" eol) program)
- (= (length args) 2)
+ (tramp-compat-length= args 2)
(string-equal "-c" (car args))
;; Don't if there is a quoted string.
(not
@@ -2953,7 +2887,7 @@ implementation will be used."
;; When PROGRAM is nil, we just provide a tty.
(args (if (not heredoc) args
(let ((i 250))
- (while (and (< i (length (cadr args)))
+ (while (and (not (tramp-compat-length< (cadr args)
i))
(string-match " " (cadr args) i))
(setcdr
args
@@ -3935,7 +3869,7 @@ Fall back to normal file name handler if no Tramp handler
exists."
;; Save rest of the string.
(while (string-match (rx bol "\n") string)
(setq string (replace-match "" nil nil string)))
- (when (zerop (length string)) (setq string nil))
+ (when (string-empty-p string) (setq string nil))
(when string (tramp-message proc 10 "Rest string:\n%s" string))
(process-put proc 'rest-string string)))
@@ -4180,7 +4114,7 @@ variable PATH."
'noerror)))
tmpfile chunk chunksize)
(tramp-message vec 5 "Setting $PATH environment variable")
- (if (< (length command) pipe-buf)
+ (if (tramp-compat-length< command pipe-buf)
(tramp-send-command vec command)
;; Use a temporary file. We cannot use `write-region' because
;; setting the remote path happens in the early connection
@@ -4569,7 +4503,7 @@ process to set up. VEC specifies the connection."
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\""
'noerror)))
- (unless (zerop (length tty))
+ (unless (string-empty-p tty)
(process-put proc 'remote-tty tty)
(tramp-set-connection-property proc "remote-tty" tty)))
@@ -5142,7 +5076,7 @@ connection if a previous connection has died for some
reason."
(unless (process-live-p p)
(with-tramp-progress-reporter
vec 3
- (if (zerop (length (tramp-file-name-user vec)))
+ (if (tramp-string-empty-or-nil-p (tramp-file-name-user vec))
(format "Opening connection %s for %s using %s"
process-name
(tramp-file-name-host vec)
@@ -5515,7 +5449,7 @@ raises an error."
(cond
((tramp-get-method-parameter vec 'tramp-remote-copy-program)
localname)
- ((zerop (length user)) (format "%s:%s" host localname))
+ ((tramp-string-empty-or-nil-p user) (format "%s:%s" host localname))
(t (format "%s@%s:%s" user host localname)))))
(defun tramp-method-out-of-band-p (vec size)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f31865d498d..a9cec17f536 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -269,6 +269,7 @@ See `tramp-actions-before-shell' for more info.")
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-smb-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-smb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -487,9 +488,9 @@ arguments to pass to the OPERATION."
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
+ (if (tramp-string-empty-or-nil-p user)
+ (setq args (append args (list "-N")))
+ (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@@ -695,31 +696,25 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(defun tramp-smb-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (setq filename (expand-file-name filename))
- (when (file-exists-p filename)
- (with-parsed-tramp-file-name filename nil
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
- (if (and delete-by-moving-to-trash trash)
- (move-file-to-trash filename)
- (unless (tramp-smb-send-command
- v (format
- "%s %s"
- (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
- (tramp-smb-shell-quote-localname v)))
- ;; Error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (search-forward-regexp tramp-smb-errors nil t)
- (tramp-error v 'file-error "%s `%s'" (match-string 0)
filename)))))))
+ (tramp-skeleton-delete-file filename trash
+ (unless (tramp-smb-send-command
+ v (format
+ "%s %s"
+ (if (tramp-smb-get-cifs-capabilities v) "posix_unlink" "rm")
+ (tramp-smb-shell-quote-localname v)))
+ ;; Error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (search-forward-regexp tramp-smb-errors nil t)
+ (tramp-error v 'file-error "%s `%s'" (match-string 0) filename)))))
(defun tramp-smb-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files."
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
+ (when (string-empty-p name)
+ (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@@ -734,7 +729,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
- (when (zerop (length uname))
+ (when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -788,9 +783,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(args (list (concat "//" host "/" share) "-E"))
(options tramp-smb-options))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
+ (if (tramp-string-empty-or-nil-p user)
+ (setq args (append args (list "-N")))
+ (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@@ -1078,7 +1073,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(setq entries
(delq
nil
- (if (or wildcard (zerop (length base)))
+ (if (or wildcard (string-empty-p base))
;; Check for matching entries.
(mapcar
(lambda (x)
@@ -1103,7 +1098,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(when (tramp-compat-string-search "F" switches)
(mapc
(lambda (x)
- (unless (zerop (length (car x)))
+ (unless (string-empty-p (car x))
(cond
((char-equal ?d (string-to-char (nth 1 x)))
(setcar x (concat (car x) "/")))
@@ -1123,7 +1118,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; Print entries.
(mapc
(lambda (x)
- (unless (zerop (length (nth 0 x)))
+ (unless (string-empty-p (nth 0 x))
(let ((attr
(when (tramp-smb-get-stat-capability v)
(ignore-errors
@@ -1180,51 +1175,21 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-error v 'file-error "Couldn't make directory %s" dir))))
(defun tramp-smb-handle-make-symbolic-link
- (target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name linkname nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (unless (tramp-smb-get-cifs-capabilities v)
- (tramp-error v 'file-error "make-symbolic-link not supported"))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (tramp-smb-send-command
- v (format "symlink %s %s"
- (tramp-smb-shell-quote-argument target)
- (tramp-smb-shell-quote-localname v)))
- (tramp-error
- v 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (tramp-get-connection-buffer v))))))
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files."
+ (let ((v (tramp-dissect-file-name (expand-file-name linkname))))
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported")))
+
+ (tramp-skeleton-handle-make-symbolic-link target linkname
ok-if-already-exists
+ (unless (tramp-smb-send-command
+ v (format "symlink %s %s"
+ (tramp-smb-shell-quote-argument target)
+ (tramp-smb-shell-quote-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (tramp-get-connection-buffer v)))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
@@ -1416,9 +1381,9 @@ component is used as the target of the symlink."
"\n" "," acl-string)))
(options tramp-smb-options))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
+ (if (tramp-string-empty-or-nil-p user)
+ (setq args (append args (list "-N")))
+ (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@@ -1568,7 +1533,7 @@ If USER is a string, return its home directory instead of
the
user identified by VEC. If there is no user specified in either
VEC or USER, or if there is no home directory, return nil."
(let ((user (or user (tramp-file-name-user vec))))
- (unless (zerop (length user))
+ (unless (tramp-string-empty-or-nil-p user)
(concat "/" user))))
(defun tramp-smb-handle-write-region
@@ -1966,9 +1931,9 @@ If ARGUMENT is non-nil, use it as argument for
(t
(setq args (list "-g" "-L" host ))))
- (if (not (zerop (length user)))
- (setq args (append args (list "-U" user)))
- (setq args (append args (list "-N"))))
+ (if (tramp-string-empty-or-nil-p user)
+ (setq args (append args (list "-N")))
+ (setq args (append args (list "-U" user))))
(when domain (setq args (append args (list "-W" domain))))
(when port (setq args (append args (list "-p" port))))
@@ -1983,7 +1948,8 @@ If ARGUMENT is non-nil, use it as argument for
(with-tramp-progress-reporter
vec 3
(format "Opening connection for //%s%s/%s"
- (if (not (zerop (length user))) (concat user "@") "")
+ (if (tramp-string-empty-or-nil-p user)
+ "" (concat user "@"))
host (or share ""))
(let* (coding-system-for-read
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 27b2854e451..65c4bf23c38 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -124,6 +124,7 @@
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-sshfs-handle-file-system-info)
(file-truename . tramp-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-sshfs-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index c4e1d32f525..486a22a60e1 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -114,6 +114,7 @@ See `tramp-actions-before-shell' for more info.")
(file-symlink-p . tramp-handle-file-symlink-p)
(file-system-info . tramp-sudoedit-handle-file-system-info)
(file-truename . tramp-sudoedit-handle-file-truename)
+ (file-user-uid . tramp-handle-file-user-uid)
(file-writable-p . tramp-sudoedit-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `get-file-buffer' performed by default handler.
@@ -347,17 +348,14 @@ absolute file names."
(defun tramp-sudoedit-handle-delete-file (filename &optional trash)
"Like `delete-file' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (tramp-flush-file-properties v localname)
- (if (and delete-by-moving-to-trash trash)
- (move-file-to-trash filename)
- (unless (tramp-sudoedit-send-command
- v "rm" "-f" (file-name-unquote localname))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error "Couldn't delete %s" filename))))))
+ (tramp-skeleton-delete-file filename trash
+ (unless (tramp-sudoedit-send-command
+ v "rm" "-f" (file-name-unquote localname))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error "Couldn't delete %s" filename)))))
(defun tramp-sudoedit-handle-expand-file-name (name &optional dir)
"Like `expand-file-name' for Tramp files.
@@ -366,7 +364,8 @@ the result will be a local, non-Tramp, file name."
;; If DIR is not given, use `default-directory' or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
+ (when (string-empty-p name)
+ (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@@ -377,7 +376,7 @@ the result will be a local, non-Tramp, file name."
;; Tilde expansion if necessary. We cannot accept "~/", because
;; under sudo "~/" is expanded to the local user home directory
;; but to the root home directory.
- (when (zerop (length localname))
+ (when (tramp-string-empty-or-nil-p localname)
(setq localname "~"))
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
@@ -386,7 +385,7 @@ the result will be a local, non-Tramp, file name."
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
- (when (zerop (length uname))
+ (when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -474,7 +473,7 @@ the result will be a local, non-Tramp, file name."
(with-tramp-file-property v localname "file-name-all-completions"
(tramp-sudoedit-send-command
v "ls" "-a1" "--quoting-style=literal" "--show-control-chars"
- (if (zerop (length localname))
+ (if (tramp-string-empty-or-nil-p localname)
"" (file-name-unquote localname)))
(mapcar
(lambda (f)
@@ -569,33 +568,9 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (with-parsed-tramp-file-name
- (file-name-unquote (expand-file-name filename)) nil
- (tramp-make-tramp-file-name
- v
- (with-tramp-file-property v localname "file-truename"
- (let (result)
- (tramp-message v 4 "Finding true name for `%s'" filename)
- (setq result (tramp-sudoedit-send-command-string
- v "readlink" "--canonicalize-missing" localname))
- ;; Detect cycle.
- (when (and (file-symlink-p filename)
- (string-equal result localname))
- (tramp-error
- v 'file-error
- "Apparent cycle of symbolic links for %s" filename))
- ;; If the resulting localname looks remote, we must quote it
- ;; for security reasons.
- (when (file-remote-p result)
- (setq result (file-name-quote result 'top)))
- (tramp-message v 4 "True name of `%s' is `%s'" localname result)
- result)))))))
+ (tramp-skeleton-file-truename filename
+ (tramp-sudoedit-send-command-string
+ v "readlink" "--canonicalize-missing" localname)))
(defun tramp-sudoedit-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@@ -623,41 +598,12 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-make-symbolic-link
(target linkname &optional ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files.
-If TARGET is a non-Tramp file, it is used verbatim as the target
-of the symlink. If TARGET is a Tramp file, only the localname
-component is used as the target of the symlink."
- (with-parsed-tramp-file-name (expand-file-name linkname) nil
- ;; If TARGET is a Tramp name, use just the localname component.
- ;; Don't check for a proper method.
- (let ((non-essential t))
- (when (and (tramp-tramp-file-p target)
- (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
- (setq target (tramp-file-local-name (expand-file-name target)))))
-
- ;; If TARGET is still remote, quote it.
- (if (tramp-tramp-file-p target)
- (make-symbolic-link
- (file-name-quote target 'top) linkname ok-if-already-exists)
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not
- (yes-or-no-p
- (format
- "File %s already exists; make it a link anyway?"
- localname)))))
- (tramp-error v 'file-already-exists localname)
- (delete-file linkname)))
-
- (tramp-flush-file-properties v localname)
- (tramp-sudoedit-send-command
- v "ln" "-sf"
- (file-name-unquote target)
- (file-name-unquote localname)))))
+ "Like `make-symbolic-link' for Tramp files."
+ (tramp-skeleton-handle-make-symbolic-link target linkname
ok-if-already-exists
+ (tramp-sudoedit-send-command
+ v "ln" "-sf"
+ (file-name-unquote target)
+ (file-name-unquote localname))))
(defun tramp-sudoedit-handle-rename-file
(filename newname &optional ok-if-already-exists)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 4bf0fdefc0b..6dca53dcbcf 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -657,7 +657,7 @@ The `sudo' program appears to insert a `^@' character into
the prompt."
(defcustom tramp-wrong-passwd-regexp
(rx bol (* nonl)
(| "Permission denied"
- "Login [Ii]ncorrect"
+ (: "Login " (| "Incorrect" "incorrect"))
"Connection refused"
"Connection closed"
"Timeout, server not responding."
@@ -1630,7 +1630,7 @@ This is USER, if non-nil. Otherwise, do a lookup in
This is HOST, if non-nil. Otherwise, do a lookup in
`tramp-default-host-alist' and `tramp-default-host'."
(let ((result
- (or (and (> (length host) 0) host)
+ (or (and (tramp-compat-length> host 0) host)
(let ((choices tramp-default-host-alist)
lhost item)
(while choices
@@ -1642,7 +1642,7 @@ This is HOST, if non-nil. Otherwise, do a lookup in
lhost)
tramp-default-host)))
;; We must mark, whether a default value has been used.
- (if (or (> (length host) 0) (null result))
+ (if (or (tramp-compat-length> host 0) (null result))
result
(propertize result 'tramp-default t))))
@@ -1748,14 +1748,18 @@ See `tramp-dissect-file-name' for details."
(put #'tramp-dissect-hop-name 'tramp-suppress-trace t)
+(defsubst tramp-string-empty-or-nil-p (string)
+ "Check whether STRING is empty or nil."
+ (or (null string) (string= string "")))
+
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
- (if (not (zerop (length user-domain)))
- (format "*tramp/%s %s@%s*" method user-domain host-port)
- (format "*tramp/%s %s*" method host-port))))
+ (if (tramp-string-empty-or-nil-p user-domain)
+ (format "*tramp/%s %s*" method host-port)
+ (format "*tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-buffer-name 'tramp-suppress-trace t)
@@ -1800,23 +1804,23 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
hop (nth 6 args))))
;; Unless `tramp-syntax' is `simplified', we need a method.
- (when (and (not (zerop (length tramp-postfix-method-format)))
- (zerop (length method)))
+ (when (and (not (string-empty-p tramp-postfix-method-format))
+ (tramp-string-empty-or-nil-p method))
(signal 'wrong-type-argument (list #'stringp method)))
(concat tramp-prefix-format hop
- (unless (zerop (length tramp-postfix-method-format))
+ (unless (string-empty-p tramp-postfix-method-format)
(concat method tramp-postfix-method-format))
user
- (unless (zerop (length domain))
+ (unless (tramp-string-empty-or-nil-p domain)
(concat tramp-prefix-domain-format domain))
- (unless (zerop (length user))
+ (unless (tramp-string-empty-or-nil-p user)
tramp-postfix-user-format)
(when host
(if (string-match-p tramp-ipv6-regexp host)
(concat
tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host))
- (unless (zerop (length port))
+ (unless (tramp-string-empty-or-nil-p port)
(concat tramp-prefix-port-format port))
tramp-postfix-host-format
localname)))
@@ -1840,12 +1844,12 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
It must not be a complete Tramp file name, but as long as there are
necessary only. This function will be used in file name completion."
(concat tramp-prefix-format
- (unless (or (zerop (length method))
- (zerop (length tramp-postfix-method-format)))
+ (unless (or (tramp-string-empty-or-nil-p method)
+ (string-empty-p tramp-postfix-method-format))
(concat method tramp-postfix-method-format))
- (unless (zerop (length user))
+ (unless (tramp-string-empty-or-nil-p user)
(concat user tramp-postfix-user-format))
- (unless (zerop (length host))
+ (unless (tramp-string-empty-or-nil-p host)
(concat
(if (string-match-p tramp-ipv6-regexp host)
(concat
@@ -1940,9 +1944,9 @@ of `current-buffer'."
(let ((method (tramp-file-name-method vec))
(user-domain (tramp-file-name-user-domain vec))
(host-port (tramp-file-name-host-port vec)))
- (if (not (zerop (length user-domain)))
- (format "*debug tramp/%s %s@%s*" method user-domain host-port)
- (format "*debug tramp/%s %s*" method host-port))))
+ (if (tramp-string-empty-or-nil-p user-domain)
+ (format "*debug tramp/%s %s*" method host-port)
+ (format "*debug tramp/%s %s@%s*" method user-domain host-port))))
(put #'tramp-debug-buffer-name 'tramp-suppress-trace t)
@@ -2628,7 +2632,9 @@ Must be handled by the callers."
'(exec-path make-nearby-temp-file make-process process-file
shell-command start-file-process temporary-file-directory
;; Emacs 29+ only.
- list-system-processes memory-info process-attributes))
+ list-system-processes memory-info process-attributes
+ ;; Emacs 30+ only.
+ file-user-uid))
default-directory)
;; PROC.
((member operation '(file-notify-rm-watch file-notify-valid-p))
@@ -2942,10 +2948,10 @@ not in completion mode."
(tramp-drop-volume-letter (expand-file-name filename directory)))
;; When `tramp-syntax' is `simplified', we need a default method.
(tramp-default-method
- (and (zerop (length tramp-postfix-method-format))
+ (and (string-empty-p tramp-postfix-method-format)
tramp-default-method))
(tramp-default-method-alist
- (and (zerop (length tramp-postfix-method-format))
+ (and (string-empty-p tramp-postfix-method-format)
tramp-default-method-alist))
tramp-default-user tramp-default-user-alist
tramp-default-host tramp-default-host-alist
@@ -3399,15 +3405,35 @@ BODY is the backend specific code."
BODY is the backend specific code."
(declare (indent 3) (debug t))
`(with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (if (and delete-by-moving-to-trash ,trash)
- ;; Move non-empty dir to trash only if recursive deletion was
- ;; requested.
- (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
- (tramp-error
- v 'file-error "Directory is not empty, not moving to trash")
- (move-file-to-trash ,directory))
- ,@body)
- (tramp-flush-directory-properties v localname)))
+ (let ((delete-by-moving-to-trash
+ (and delete-by-moving-to-trash
+ ;; This variable exists since Emacs 30.1.
+ (not (bound-and-true-p
+ remote-file-name-inhibit-delete-by-moving-to-trash)))))
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname))))
+
+(defmacro tramp-skeleton-delete-file (filename &optional trash &rest body)
+ "Skeleton for `tramp-*-handle-delete-file'.
+BODY is the backend specific code."
+ (declare (indent 2) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,filename) nil
+ (let ((delete-by-moving-to-trash
+ (and delete-by-moving-to-trash
+ ;; This variable exists since Emacs 30.1.
+ (not (bound-and-true-p
+ remote-file-name-inhibit-delete-by-moving-to-trash)))))
+ (if (and delete-by-moving-to-trash ,trash)
+ (move-file-to-trash ,filename)
+ ,@body)
+ (tramp-flush-file-properties v localname))))
(defmacro tramp-skeleton-directory-files
(directory &optional full match nosort count &rest body)
@@ -3503,6 +3529,35 @@ BODY is the backend specific code."
;; Trigger the `file-missing' error.
(signal 'error nil)))))
+(defmacro tramp-skeleton-file-truename (filename &rest body)
+ "Skeleton for `tramp-*-handle-file-truename'.
+BODY is the backend specific code."
+ (declare (indent 1) (debug (form body)))
+ ;; Preserve trailing "/".
+ `(funcall
+ (if (directory-name-p ,filename) #'file-name-as-directory #'identity)
+ ;; Quote properly.
+ (funcall
+ (if (file-name-quoted-p ,filename) #'file-name-quote #'identity)
+ (with-parsed-tramp-file-name
+ (file-name-unquote (expand-file-name ,filename)) nil
+ (tramp-make-tramp-file-name
+ v
+ (with-tramp-file-property v localname "file-truename"
+ (let (result)
+ (setq result (progn ,@body))
+ ;; Detect cycle.
+ (when (and (file-symlink-p ,filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" ,filename))
+ ;; If the resulting localname looks remote, we must quote
+ ;; it for security reasons.
+ (when (file-remote-p result)
+ (setq result (file-name-quote result 'top)))
+ result)))))))
+
(defmacro tramp-skeleton-make-directory (dir &optional parents &rest body)
"Skeleton for `tramp-*-handle-make-directory'.
BODY is the backend specific code."
@@ -3524,6 +3579,49 @@ BODY is the backend specific code."
,@body
nil))))
+(defmacro tramp-skeleton-handle-make-symbolic-link
+ (target linkname &optional ok-if-already-exists &rest body)
+ "Skeleton for `tramp-*-handle-make-symbolic-link'.
+BODY is the backend specific code.
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink if it is located
+on the same host. Otherwise, TARGET is quoted."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,linkname) nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ ;; Don't check for a proper method.
+ (let ((non-essential t))
+ (when (and (tramp-tramp-file-p ,target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name ,target)))
+ (setq ,target (tramp-file-local-name (expand-file-name ,target))))
+ ;; There could be a cyclic link.
+ (tramp-flush-file-properties
+ v (expand-file-name ,target (tramp-file-local-name default-directory))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p ,target)
+ (make-symbolic-link
+ (file-name-quote ,target 'top) ,linkname ,ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p ,linkname)
+ ;; What to do?
+ (if (or (null ,ok-if-already-exists) ; not allowed to exist
+ (and (numberp ,ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway?"
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file ,linkname)))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ ,@body)))
+
(defmacro tramp-skeleton-set-file-modes-times-uid-gid
(filename &rest body)
"Skeleton for `tramp-*-set-file-{modes,times,uid-gid}'.
@@ -3690,6 +3788,15 @@ Let-bind it when necessary.")
vec (concat "~" (substring filename (match-beginning 1))))
(tramp-make-tramp-file-name (tramp-dissect-file-name filename)))))
+(defun tramp-handle-file-user-uid ()
+ "Like `user-uid' for Tramp files."
+ (let ((v (tramp-dissect-file-name default-directory)))
+ (or (tramp-get-remote-uid v 'integer)
+ ;; Some handlers for `tramp-get-remote-uid' return nil if they
+ ;; can't get the UID; always return -1 in this case for
+ ;; consistency.
+ -1)))
+
(defun tramp-handle-access-file (filename string)
"Like `access-file' for Tramp files."
(setq filename (file-truename filename))
@@ -3748,7 +3855,7 @@ Let-bind it when necessary.")
;; Otherwise, remove any trailing slash from localname component.
;; Method, host, etc, are unchanged.
(while (with-parsed-tramp-file-name directory nil
- (and (not (zerop (length localname)))
+ (and (tramp-compat-length> localname 0)
(eq (aref localname (1- (length localname))) ?/)
(not (string= localname "/"))))
(setq directory (substring directory 0 -1)))
@@ -3779,7 +3886,8 @@ Let-bind it when necessary.")
;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
(setq dir (or dir default-directory "/"))
;; Handle empty NAME.
- (when (zerop (length name)) (setq name "."))
+ (when (string-empty-p name)
+ (setq name "."))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
@@ -3798,7 +3906,7 @@ Let-bind it when necessary.")
(let ((uname (match-string 1 localname))
(fname (match-string 2 localname))
hname)
- (when (zerop (length uname))
+ (when (tramp-string-empty-or-nil-p uname)
(setq uname user))
(when (setq hname (tramp-get-home-directory v uname))
(setq localname (concat hname fname)))))
@@ -3881,7 +3989,7 @@ Let-bind it when necessary.")
;; Run the command on the localname portion only unless we are in
;; completion mode.
(tramp-make-tramp-file-name
- v (or (and (zerop (length (tramp-file-name-localname v)))
+ v (or (and (tramp-string-empty-or-nil-p (tramp-file-name-localname v))
(not (tramp-connectable-p file)))
(tramp-run-real-handler
#'file-name-as-directory
@@ -3944,7 +4052,8 @@ Let-bind it when necessary.")
;; "." and ".." are never interesting as completions, and are
;; actually in the way in a directory with only one file. See
;; file_name_completion() in dired.c.
- (when (and (consp fnac) (= (length (delete "./" (delete "../" fnac))) 1))
+ (when (and (consp fnac)
+ (tramp-compat-length= (delete "./" (delete "../" fnac)) 1))
(setq fnac (delete "./" (delete "../" fnac))))
(or
(try-completion
@@ -4008,9 +4117,15 @@ Let-bind it when necessary.")
"Like `file-regular-p' for Tramp files."
(and (file-exists-p filename)
;; Sometimes, `file-attributes' does not return a proper value
- ;; even if `file-exists-p' does.
- (when-let ((attr (file-attributes filename)))
- (eq ?- (aref (file-attribute-modes attr) 0)))))
+ ;; even if `file-exists-p' does. Protect by `ignore-errors',
+ ;; because `file-truename' could raise an error for cyclic
+ ;; symlinks.
+ (ignore-errors
+ (when-let ((attr (file-attributes filename)))
+ (cond
+ ((eq ?- (aref (file-attribute-modes attr) 0)))
+ ((eq ?l (aref (file-attribute-modes attr) 0))
+ (file-regular-p (file-truename filename))))))))
(defun tramp-handle-file-remote-p (filename &optional identification connected)
"Like `file-remote-p' for Tramp files."
@@ -4048,13 +4163,8 @@ Let-bind it when necessary.")
(defun tramp-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
- ;; Preserve trailing "/".
- (funcall
- (if (directory-name-p filename) #'file-name-as-directory #'identity)
- ;; Quote properly.
- (funcall
- (if (file-name-quoted-p filename) #'file-name-quote #'identity)
- (let ((result (file-name-unquote (expand-file-name filename)))
+ (tramp-skeleton-file-truename filename
+ (let ((result (directory-file-name localname))
(numchase 0)
;; Don't make the following value larger than necessary.
;; People expect an error message in a timely fashion when
@@ -4064,31 +4174,21 @@ Let-bind it when necessary.")
;; Unquoting could enable encryption.
tramp-crypt-enabled
symlink-target)
- (with-parsed-tramp-file-name result v1
- ;; We cache only the localname.
- (tramp-make-tramp-file-name
- v1
- (with-tramp-file-property v1 v1-localname "file-truename"
- (while (and (setq symlink-target (file-symlink-p result))
- (< numchase numchase-limit))
- (setq numchase (1+ numchase)
- result
- (with-parsed-tramp-file-name (expand-file-name result) v2
- (tramp-make-tramp-file-name
- v2
- (if (stringp symlink-target)
- (if (file-remote-p symlink-target)
- (file-name-quote symlink-target 'top)
- (tramp-drop-volume-letter
- (expand-file-name
- symlink-target
- (file-name-directory v2-localname))))
- v2-localname))))
- (when (>= numchase numchase-limit)
- (tramp-error
- v1 'file-error
- "Maximum number (%d) of symlinks exceeded" numchase-limit)))
- (tramp-file-local-name (directory-file-name result)))))))))
+ (while (and (setq symlink-target
+ (file-symlink-p (tramp-make-tramp-file-name v result)))
+ (< numchase numchase-limit))
+ (setq numchase (1+ numchase)
+ result
+ (if (file-remote-p symlink-target)
+ (file-name-quote symlink-target 'top)
+ (tramp-drop-volume-letter
+ (expand-file-name
+ symlink-target (file-name-directory result)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit)))
+ (directory-file-name result))))
(defun tramp-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
@@ -4705,7 +4805,7 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(tramp-get-connection-property v "direct-async-process")
;; There's no multi-hop.
(or (not (tramp-multi-hop-p v))
- (= (length (tramp-compute-multi-hops v)) 1))
+ (null (cdr (tramp-compute-multi-hops v))))
;; There's no remote stdout or stderr file.
(or (not (stringp buffer)) (not (tramp-tramp-file-p buffer)))
(or (not (stringp stderr)) (not (tramp-tramp-file-p stderr))))))
@@ -6303,6 +6403,7 @@ It always returns a return code. The Lisp error raised
when
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory)
+ (temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment))
(destination (if (eq destination t) (current-buffer) destination))
(vec (or vec (car tramp-current-connection)))
@@ -6323,7 +6424,7 @@ are written with verbosity of 6."
(error
(setq error (error-message-string err)
result 1)))
- (if (zerop (length error))
+ (if (tramp-string-empty-or-nil-p error)
(tramp-message vec 6 "%s\n%s" result output)
(tramp-message vec 6 "%s\n%s\n%s" result output error))
result))
@@ -6335,6 +6436,7 @@ It always returns a return code. The Lisp error raised
when
PROGRAM is nil is trapped also, returning 1. Furthermore, traces
are written with verbosity of 6."
(let ((default-directory tramp-compat-temporary-file-directory)
+ (temporary-file-directory tramp-compat-temporary-file-directory)
(process-environment (default-toplevel-value 'process-environment))
(buffer (if (eq buffer t) (current-buffer) buffer))
result)
@@ -6459,7 +6561,7 @@ Consults the auth-source package."
;; Workaround. Prior Emacs 28.1, auth-source has saved empty
;; passwords. See discussion in Bug#50399.
- (when (zerop (length auth-passwd))
+ (when (tramp-string-empty-or-nil-p auth-passwd)
(setq tramp-password-save-function nil))
(tramp-set-connection-property vec "first-password-request" nil)
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index 9bb77f7920b..3f6696fce77 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1690,6 +1690,7 @@ shown below.
(append
(split-string (if (stringp raw-result)
raw-result
+ ;; FIXME: Arbitrary code evaluation.
(eval raw-result t)))
(cdr (assq :result-params params))))))
(append
@@ -2860,6 +2861,7 @@ parameters when merging lists."
(split-string
(cond ((stringp value) value)
((functionp value) (funcall value))
+ ;; FIXME: Arbitrary code evaluation.
(t (eval value t)))))))
(`(:exports . ,value)
(setq exports (funcall merge
@@ -3188,16 +3190,8 @@ situations in which is it not appropriate."
((and (not inhibit-lisp-eval)
(or (memq (string-to-char cell) '(?\( ?' ?` ?\[))
(string= cell "*this*")))
- ;; Prevent arbitrary function calls.
- (if (and (memq (string-to-char cell) '(?\( ?`))
- (not (org-babel-confirm-evaluate
- ;; See `org-babel-get-src-block-info'.
- (list "emacs-lisp" cell
- '((:eval . yes)) nil (format "%s" cell)
- nil nil))))
- ;; Not allowed.
- (user-error "Evaluation of elisp code %S aborted." cell)
- (eval (read cell) t)))
+ ;; FIXME: Arbitrary code evaluation.
+ (eval (read cell) t))
((save-match-data
(and (string-match "^[[:space:]]*\"\\(.*\\)\"[[:space:]]*$" cell)
(not (string-match "[^\\]\"" (match-string 1 cell)))))
@@ -3283,7 +3277,7 @@ Emacs shutdown.")
(while (or (not dir) (file-exists-p dir))
(setq dir (expand-file-name
(format "babel-stable-%d" (random 1000))
- (temporary-file-directory))))
+ temporary-file-directory)))
(make-directory dir)
dir))
"Directory to hold temporary files created to execute code blocks.
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 03c94b1ba99..b94bc73dd79 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -29,11 +29,10 @@
;; - ruby and irb executables :: https://www.ruby-lang.org/
;;
-;; - ruby-mode :: Can be installed through ELPA, or from
-;; https://github.com/eschulte/rinari/raw/master/util/ruby-mode.el
+;; - ruby-mode :: Comes with Emacs.
;;
;; - inf-ruby mode :: Can be installed through ELPA, or from
-;; https://github.com/eschulte/rinari/raw/master/util/inf-ruby.el
+;; https://raw.githubusercontent.com/nonsequitur/inf-ruby/master/inf-ruby.el
;;; Code:
diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el
index 4a60186cd5d..2c30a26056b 100644
--- a/lisp/org/ob-shell.el
+++ b/lisp/org/ob-shell.el
@@ -79,7 +79,7 @@ is modified outside the Customize interface."
,(format "Execute a block of %s commands with Babel." name)
(let ((shell-file-name ,name)
(org-babel-prompt-command
- (or (alist-get ,name org-babel-shell-set-prompt-commands)
+ (or (cdr (assoc ,name org-babel-shell-set-prompt-commands))
(alist-get t org-babel-shell-set-prompt-commands))))
(org-babel-execute:shell body params))))
(eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 66b08adf535..2d194ad3413 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -54,6 +54,7 @@
(require 'org)
(require 'org-macs)
(require 'org-refile)
+(require 'org-element)
(declare-function diary-add-to-list "diary-lib"
(date string specifier &optional marker globcolor literal))
@@ -80,11 +81,6 @@
(declare-function org-columns-quit "org-colview" ())
(declare-function diary-date-display-form "diary-lib" (&optional type))
(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element--cache-active-p "org-element"
- (&optional called-from-cache-change-func-p))
-(declare-function org-element-lineage "org-element"
- (datum &optional types with-self))
(declare-function org-habit-insert-consistency-graphs
"org-habit" (&optional line))
(declare-function org-is-habit-p "org-habit" (&optional pom))
@@ -95,8 +91,6 @@
(declare-function org-capture "org-capture" (&optional goto keys))
(declare-function org-clock-modify-effort-estimate "org-clock" (&optional
value))
-(declare-function org-element-type "org-element" (&optional element))
-
(defvar calendar-mode-map)
(defvar org-clock-current-task)
(defvar org-current-tag-alist)
@@ -1184,7 +1178,9 @@ Custom commands can set this variable in the options
section."
"Non-nil means start the overview always on the specified weekday.
0 denotes Sunday, 1 denotes Monday, etc.
When nil, always start on the current day.
-Custom commands can set this variable in the options section."
+Custom commands can set this variable in the options section.
+
+This variable only applies when agenda spans either 7 or 14 days."
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Today" nil)
(integer :tag "Weekday No.")))
@@ -4357,7 +4353,10 @@ This check for agenda markers in all agenda buffers
currently active."
Custom commands can set this variable in the options section.
This is usually a string like \"2007-11-01\", \"+2d\" or any other
input allowed when reading a date through the Org calendar.
-See the docstring of `org-read-date' for details.")
+See the docstring of `org-read-date' for details.
+
+This variable has no effect when `org-agenda-start-on-weekday' is set
+and agenda spans 7 or 14 days.")
(defvar org-starting-day nil) ; local variable in the agenda buffer
(defvar org-arg-loc nil) ; local variable
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 4e72141cdc9..55372e5649b 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -1800,17 +1800,25 @@ Optional argument N tells to change by that many units."
(time-subtract
(org-time-string-to-time org-last-changed-timestamp)
(org-time-string-to-time ts)))
- (save-excursion
- (goto-char begts)
- (org-timestamp-change
- (round (/ (float-time tdiff)
- (pcase timestamp?
- (`minute 60)
- (`hour 3600)
- (`day (* 24 3600))
- (`month (* 24 3600 31))
- (`year (* 24 3600 365.2)))))
- timestamp? 'updown)))))))
+ ;; `save-excursion' won't work because
+ ;; `org-timestamp-change' deletes and re-inserts the
+ ;; timestamp.
+ (let ((origin (point)))
+ (save-excursion
+ (goto-char begts)
+ (org-timestamp-change
+ (round (/ (float-time tdiff)
+ (pcase timestamp?
+ (`minute 60)
+ (`hour 3600)
+ (`day (* 24 3600))
+ (`month (* 24 3600 31))
+ (`year (* 24 3600 365.2)))))
+ timestamp? 'updown))
+ ;; Move back to initial position, but never beyond updated
+ ;; clock.
+ (unless (< (point) origin)
+ (goto-char origin))))))))
;;;###autoload
(defun org-clock-cancel ()
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index f787fb1f713..389acf82500 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -2382,7 +2382,9 @@ Assume point is at the beginning of the fixed-width area."
(defun org-element-fixed-width-interpreter (fixed-width _)
"Interpret FIXED-WIDTH element as Org syntax."
(let ((value (org-element-property :value fixed-width)))
- (and value (replace-regexp-in-string "^" ": " value))))
+ (and value
+ (if (string-empty-p value) ":\n"
+ (replace-regexp-in-string "^" ": " value)))))
;;;; Horizontal Rule
diff --git a/lisp/org/org-fold-core.el b/lisp/org/org-fold-core.el
index 0855e6f39ce..027ff921581 100644
--- a/lisp/org/org-fold-core.el
+++ b/lisp/org/org-fold-core.el
@@ -1003,7 +1003,13 @@ If SPEC-OR-ALIAS is omitted and FLAG is nil, unfold
everything in the region."
(overlay-put o (org-fold-core--property-symbol-get-create
spec) spec)
(overlay-put o 'invisible spec)
(overlay-put o 'isearch-open-invisible
#'org-fold-core--isearch-show)
- (overlay-put o 'isearch-open-invisible-temporary
#'org-fold-core--isearch-show-temporary))
+ ;; FIXME: Disabling to work around Emacs bug#60399
+ ;; and https://orgmode.org/list/87zgb6tk6h.fsf@localhost.
+ ;; The proper fix will require making sure that
+ ;; `org-fold-core-isearch-open-function' does not
+ ;; delete the overlays used by isearch.
+ ;; (overlay-put o 'isearch-open-invisible-temporary
#'org-fold-core--isearch-show-temporary)
+ )
(put-text-property from to
(org-fold-core--property-symbol-get-create spec) spec)
(put-text-property from to 'isearch-open-invisible
#'org-fold-core--isearch-show)
(put-text-property from to 'isearch-open-invisible-temporary
#'org-fold-core--isearch-show-temporary)
@@ -1131,16 +1137,9 @@ This function is intended to be used as
`isearch-filter-predicate'."
"Clear `org-fold-core--isearch-local-regions'."
(clrhash org-fold-core--isearch-local-regions))
-(defun org-fold-core--isearch-show (region)
- "Reveal text in REGION found by isearch.
-REGION can also be an overlay in current buffer."
- (when (overlayp region)
- (setq region (cons (overlay-start region)
- (overlay-end region))))
- (org-with-point-at (car region)
- (while (< (point) (cdr region))
- (funcall org-fold-core-isearch-open-function (car region))
- (goto-char (org-fold-core-next-visibility-change (point) (cdr region)
'ignore-hidden)))))
+(defun org-fold-core--isearch-show (_)
+ "Reveal text at point found by isearch."
+ (funcall org-fold-core-isearch-open-function (point)))
(defun org-fold-core--isearch-show-temporary (region hide-p)
"Temporarily reveal text in REGION.
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 72929cdd26c..07c668a807d 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -372,18 +372,23 @@ be set to a buffer or a buffer name. `shell-command'
then uses
it for output."
(let* ((base-name (file-name-base source))
(full-name (file-truename source))
- (out-dir (or (file-name-directory source) "./"))
+ (relative-name (file-relative-name source))
+ (out-dir (if (file-name-directory source)
+ ;; Expand "~". Shell expansion will be disabled
+ ;; in the shell command call.
+ (file-name-directory full-name)
+ "./"))
(output (expand-file-name (concat base-name "." ext) out-dir))
(time (file-attribute-modification-time (file-attributes output)))
(err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
(save-window-excursion
(pcase process
- ((pred functionp) (funcall process (shell-quote-argument source)))
+ ((pred functionp) (funcall process (shell-quote-argument
relative-name)))
((pred consp)
(let ((log-buf (and log-buf (get-buffer-create log-buf)))
(spec (append spec
`((?b . ,(shell-quote-argument base-name))
- (?f . ,(shell-quote-argument source))
+ (?f . ,(shell-quote-argument relative-name))
(?F . ,(shell-quote-argument full-name))
(?o . ,(shell-quote-argument out-dir))
(?O . ,(shell-quote-argument output))))))
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 6a733f09db7..3b2c4cba624 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -241,7 +241,7 @@ return `:middle'."
(t :middle)))
(defun org-mouse-empty-line ()
- "Return non-nil iff the line contains only white space."
+ "Return non-nil if the line contains only white space."
(save-excursion (beginning-of-line) (looking-at "[ \t]*$")))
(defun org-mouse-next-heading ()
@@ -283,7 +283,7 @@ keyword as the only argument.
If SELECTED is nil, then all items are normal menu items. If
SELECTED is a function, then each item is a checkbox, which is
-enabled for a given keyword iff (funcall SELECTED keyword) return
+enabled for a given keyword if (funcall SELECTED keyword) return
non-nil. If SELECTED is neither nil nor a function, then the
items are radio buttons. A radio button is enabled for the
keyword `equal' to SELECTED.
diff --git a/lisp/org/org-persist.el b/lisp/org/org-persist.el
index c3650c167e2..a0652b99c56 100644
--- a/lisp/org/org-persist.el
+++ b/lisp/org/org-persist.el
@@ -160,6 +160,8 @@
(declare-function org-next-visible-heading "org" (arg))
(declare-function org-at-heading-p "org" (&optional invisible-not-ok))
+;; Silence byte-compiler (used in `org-persist--write-elisp-file').
+(defvar pp-use-max-width)
(defconst org-persist--storage-version "3.1"
"Persistent storage layout version.")
@@ -335,7 +337,8 @@ FORMAT and ARGS are passed to `message'."
(make-directory (file-name-directory file) t))
(with-temp-file file
(if pp
- (pp data (current-buffer))
+ (let ((pp-use-max-width nil)) ; Emacs bug#58687
+ (pp data (current-buffer)))
(prin1 data (current-buffer))))
(org-persist--display-time
(- (float-time) start-time)
@@ -753,12 +756,12 @@ with `org-persist-write'."
When ASSOCIATED is `all', unregister CONTAINER everywhere."
(unless org-persist--index (org-persist--load-index))
(setq container (org-persist--normalize-container container))
- (setq associated (org-persist--normalize-associated associated))
(if (eq associated 'all)
(mapc (lambda (collection)
(when (member container (plist-get collection :container))
(org-persist-unregister container (plist-get collection
:associated))))
org-persist--index)
+ (setq associated (org-persist--normalize-associated associated))
(let ((collection (org-persist--find-index `(:container ,container
:associated ,associated))))
(when collection
(if (= (length (plist-get collection :container)) 1)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 06cf919db76..5116b1127f7 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -1229,7 +1229,7 @@ Return t when the line exists, nil if it does not exist."
(if (looking-at "|[^|\n]+")
(let* ((pos (match-beginning 0))
(match (match-string 0))
- (len (org-string-width match)))
+ (len (save-match-data (org-string-width match))))
(replace-match (concat "|" (make-string (1- len) ?\ )))
(goto-char (+ 2 pos))
(substring match 1)))))
@@ -1725,8 +1725,12 @@ In particular, this does handle wide and invisible
characters."
(setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
(while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
(setq s (replace-match
- (concat "|" (make-string (org-string-width (match-string 1 s))
- ?\ ) "|")
+ (concat "|"
+ (make-string
+ (save-match-data
+ (org-string-width (match-string 1 s)))
+ ?\ )
+ "|")
t t s)))
s))
@@ -2614,6 +2618,7 @@ location of point."
(if lispp
(setq ev (condition-case nil
+ ;; FIXME: Arbitrary code evaluation.
(eval (eval (read form)))
(error "#ERROR"))
ev (if (numberp ev) (number-to-string ev) ev)
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index dd6d92d8e58..22f952d7a30 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.6"))
+ (let ((org-release "9.6.1"))
org-release))
;;;###autoload
(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-81-g563a43"))
+ (let ((org-git-version "release_9.6.1-16-ge37e9b"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 21764f3d434..153e860f9a5 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -7,9 +7,9 @@
;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: outlines, hypermedia, calendar, wp
;; URL: https://orgmode.org
-;; Package-Requires: ((emacs "25.1"))
+;; Package-Requires: ((emacs "26.1"))
-;; Version: 9.6
+;; Version: 9.6.1
;; This file is part of GNU Emacs.
;;
@@ -4898,16 +4898,20 @@ The following commands are available:
(= (point-min) (point-max)))
(insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
+ (when (or org-startup-align-all-tables org-startup-shrink-all-tables)
+ (org-table-map-tables
+ (cond ((and org-startup-align-all-tables
+ org-startup-shrink-all-tables)
+ (lambda () (org-table-align) (org-table-shrink)))
+ (org-startup-align-all-tables #'org-table-align)
+ (t #'org-table-shrink))
+ t))
+ ;; Suppress modification hooks to speed up the startup.
+ ;; However, do it only when text properties/overlays, but not
+ ;; buffer text are actually modified. We still need to track text
+ ;; modifications to make cache updates work reliably.
(org-unmodified
(when org-startup-with-beamer-mode (org-beamer-mode))
- (when (or org-startup-align-all-tables org-startup-shrink-all-tables)
- (org-table-map-tables
- (cond ((and org-startup-align-all-tables
- org-startup-shrink-all-tables)
- (lambda () (org-table-align) (org-table-shrink)))
- (org-startup-align-all-tables #'org-table-align)
- (t #'org-table-shrink))
- t))
(when org-startup-with-inline-images (org-display-inline-images))
(when org-startup-with-latex-preview (org-latex-preview '(16)))
(unless org-inhibit-startup-visibility-stuff
(org-cycle-set-startup-visibility))
@@ -8855,7 +8859,7 @@ keywords relative to each registered export back-end."
"EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" "INDEX:" "KEYWORDS:" "LANGUAGE:"
"MACRO:" "OPTIONS:" "PROPERTY:" "PRINT_BIBLIOGRAPHY" "PRIORITIES:"
"SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" "TITLE:" "TODO:"
- "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
+ "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:" "EXPORT_FILE_NAME:"))
(defcustom org-structure-template-alist
'(("a" . "export ascii")
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 1c233a266a1..949c8f9b5b2 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -2935,7 +2935,7 @@ contextual information."
(trailing (and (string-match (rx (1+ blank) eos) output)
(match-string 0 output))))
;; Unfill, retaining leading/trailing space.
- (let ((fill-column (point-max)))
+ (let ((fill-column most-positive-fixnum))
(fill-region (point-min) (point-max)))
(concat leading (buffer-string) trailing))))))
;; Return value.
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 62fc8d583e4..65f9ff18279 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -3040,7 +3040,7 @@ Return code as a string."
;; This way, we will be able to retrieve its export
;; options when calling
;; `org-export--get-subtree-options'.
- (backward-char)
+ (when (bolp) (backward-char))
(narrow-to-region (point) (point-max))))
;; Initialize communication channel with original buffer
;; attributes, unavailable in its copy.
@@ -6407,7 +6407,7 @@ them."
("nb" :default "Innhold")
("nn" :default "Innhald")
("pl" :html "Spis treści")
- ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice")
+ ("pt_BR" :html "Índice" :utf-8 "Índice" :ascii "Indice")
("ro" :default "Cuprins")
("ru" :html
"Содержание"
:utf-8 "Содержание")
@@ -6757,7 +6757,6 @@ Return file name as a string."
(cond
(pub-dir (concat (file-name-as-directory pub-dir)
(file-name-nondirectory base-name)))
- ((file-name-absolute-p base-name) base-name)
(t base-name))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
diff --git a/lisp/outline.el b/lisp/outline.el
index 91f6040687b..a89985d1990 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -209,8 +209,14 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
:version "28.1")
(defvar outline-minor-mode-cycle)
+(defvar outline-minor-mode-cycle-map)
(defun outline-minor-mode-cycle--bind (map key binding &optional filter)
- (define-key map key
+ "Define KEY as BINDING in MAP using FILTER.
+The key takes effect only on the following conditions:
+`outline-minor-mode-cycle' is non-nil, point is located on the heading line,
+FILTER or `outline-minor-mode-cycle-filter' is nil or returns non-nil.
+The argument MAP is optional and defaults to `outline-minor-mode-cycle-map'."
+ (define-key (or map outline-minor-mode-cycle-map) key
`(menu-item
"" ,binding
;; Filter out specific positions on the heading.
@@ -227,8 +233,16 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
(let ((map (make-sparse-keymap)))
(outline-minor-mode-cycle--bind map (kbd "TAB") #'outline-cycle)
(outline-minor-mode-cycle--bind map (kbd "<backtab>")
#'outline-cycle-buffer)
+ (keymap-set map "<left-margin> <mouse-1>" 'outline-cycle)
+ (keymap-set map "<right-margin> <mouse-1>" 'outline-cycle)
+ (keymap-set map "<left-margin> S-<mouse-1>" 'outline-cycle-buffer)
+ (keymap-set map "<right-margin> S-<mouse-1>" 'outline-cycle-buffer)
map)
- "Keymap used by `outline-minor-mode-cycle'.")
+ "Keymap used as a parent of the `outline-minor-mode' keymap.
+It contains key bindings that can be used to cycle visibility.
+The recommended way to bind keys is with `outline-minor-mode-cycle--bind'
+when the key should be enabled only when `outline-minor-mode-cycle' is
+non-nil and point is located on the heading line.")
(defvar outline-mode-map
(let ((map (make-sparse-keymap)))
@@ -518,10 +532,6 @@ See the command `outline-mode' for more information on
this mode."
:keymap (define-keymap
:parent outline-minor-mode-cycle-map
"<menu-bar>" outline-minor-mode-menu-bar-map
- "<left-margin> <mouse-1>" 'outline-cycle
- "<right-margin> <mouse-1>" 'outline-cycle
- "<left-margin> S-<mouse-1>" 'outline-cycle-buffer
- "<right-margin> S-<mouse-1>" 'outline-cycle-buffer
(key-description outline-minor-mode-prefix)
outline-mode-prefix-map)
(if outline-minor-mode
(progn
@@ -1766,6 +1776,20 @@ With a prefix argument, show headings up to that LEVEL."
;;; Button/margin indicators
+(defvar-keymap outline-button-icon-map
+ "<mouse-2>" #'outline-cycle
+ ;; Need to override the global binding
+ ;; `mouse-appearance-menu' with <down->:
+ "S-<down-mouse-1>" #'ignore
+ "S-<mouse-1>" #'outline-cycle-buffer)
+
+(defvar-keymap outline-overlay-button-map
+ "RET" #'outline-cycle)
+
+(defvar-keymap outline-inserted-button-map
+ :parent (make-composed-keymap outline-button-icon-map
+ outline-overlay-button-map))
+
(defun outline--create-button-icons ()
(pcase outline-minor-mode-use-buttons
('in-margins
@@ -1798,12 +1822,7 @@ With a prefix argument, show headings up to that LEVEL."
(propertize (icon-string icon-name)
'mouse-face 'default
'follow-link 'mouse-face
- 'keymap (define-keymap
- "<mouse-2>" #'outline-cycle
- ;; Need to override the global binding
- ;; `mouse-appearance-menu' with <down->:
- "S-<down-mouse-1>" #'ignore
- "S-<mouse-1>" #'outline-cycle-buffer)))
+ 'keymap outline-button-icon-map))
(list 'outline-open
(if outline--use-rtl 'outline-close-rtl 'outline-close))))))
@@ -1829,19 +1848,13 @@ With a prefix argument, show headings up to that LEVEL."
(overlay-put o 'face (plist-get icon 'face))
(overlay-put o 'follow-link 'mouse-face)
(overlay-put o 'mouse-face 'highlight)
- (overlay-put o 'keymap (define-keymap
- "RET" #'outline-cycle
- "<mouse-2>" #'outline-cycle
- ;; Need to override the global binding
- ;; `mouse-appearance-menu' with <down->:
- "S-<down-mouse-1>" #'ignore
- "S-<mouse-1>" #'outline-cycle-buffer)))
+ (overlay-put o 'keymap outline-inserted-button-map))
('in-margins
(overlay-put o 'before-string icon)
- (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))
+ (overlay-put o 'keymap outline-overlay-button-map))
(_
(overlay-put o 'before-string icon)
- (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))))))))
+ (overlay-put o 'keymap outline-overlay-button-map)))))))
(defun outline--fix-up-all-buttons (&optional from to)
(when outline-minor-mode-use-buttons
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 5bee5152463..1ca7a213361 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -632,6 +632,13 @@ This will modify the current buffer."
;;; Internal Functions:
;; argument handling
+(defsubst pcomplete-actual-arg (&optional index offset)
+ "Return the actual text representation of the last argument.
+This is different from `pcomplete-arg', which returns the textual value
+that the last argument evaluated to. This function returns what the
+user actually typed in."
+ (buffer-substring (pcomplete-begin index offset) (point)))
+
(defun pcomplete-arg (&optional index offset)
"Return the textual content of the INDEXth argument.
INDEX is based from the current processing position. If INDEX is
@@ -659,11 +666,20 @@ the pcomplete-arg-value text property of that string."
(_ (- pcomplete-index (or index 0))))
(or offset 0))
pcomplete-args)))
- (if (stringp arg)
+ (if (or (stringp arg)
+ ;; FIXME: 'last' is handled specially in Emacs 29, because
+ ;; 'pcomplete-parse-arguments' accepts a list of strings
+ ;; (which are completion candidates) as return value for
+ ;; (pcomplete-arg 'last). See below: "it means it's a
+ ;; list of completions computed during parsing,
+ ;; e.g. Eshell uses that to turn globs into lists of
+ ;; completions". This special case will be dealt with
+ ;; differently in Emacs 30: the pcomplete-arg-value
+ ;; property will be used by 'pcomplete-parse-arguments'.
+ (eq index 'last))
arg
(propertize
- (buffer-substring (pcomplete-begin index offset)
- (pcomplete-begin (1- (or index 0)) offset))
+ (car (split-string (pcomplete-actual-arg index offset)))
'pcomplete-arg-value arg))))
(defun pcomplete-begin (&optional index offset)
@@ -679,13 +695,6 @@ See the documentation for `pcomplete-arg'."
(setq index (+ index offset)))
(nth index pcomplete-begins))
-(defsubst pcomplete-actual-arg (&optional index offset)
- "Return the actual text representation of the last argument.
-This is different from `pcomplete-arg', which returns the textual value
-that the last argument evaluated to. This function returns what the
-user actually typed in."
- (buffer-substring (pcomplete-begin index offset) (point)))
-
(defsubst pcomplete-next-arg ()
"Move the various pointers to the next argument."
(setq pcomplete-index (1+ pcomplete-index)
diff --git a/lisp/proced.el b/lisp/proced.el
index 839b36b528f..03a7f1bebdf 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -792,6 +792,52 @@ Return nil if point is not on a process line."
(if (looking-at "^. .")
(get-text-property (match-end 0) 'proced-pid))))
+(defun proced--position-info (pos)
+ "Return information of the process at POS.
+
+The returned information will have the form `(PID KEY COLUMN)' where
+PID is the process ID of the process at point, KEY is the value of the
+proced-key text property at point, and COLUMN is the column for which the
+current value of the proced-key text property starts, or 0 if KEY is nil."
+ ;; If point is on a field, we try to return point to that field.
+ ;; Otherwise we try to return to the same column
+ (save-excursion
+ (goto-char pos)
+ (let ((pid (proced-pid-at-point))
+ (key (get-text-property (point) 'proced-key)))
+ (list pid key ; can both be nil
+ (if key
+ (if (get-text-property (1- (point)) 'proced-key)
+ (- (point) (previous-single-property-change
+ (point) 'proced-key))
+ 0)
+ (current-column))))))
+
+(defun proced--determine-pos (key column)
+ "Return position of point in the current line using KEY and COLUMN.
+
+Attempt to find the first position on the current line where the
+text property proced-key is equal to KEY. If this is not possible, return
+the position of point of column COLUMN on the current line."
+ (save-excursion
+ (let (new-pos)
+ (if key
+ (let ((limit (line-end-position)) pos)
+ (while (and (not new-pos)
+ (setq pos (next-property-change (point) nil limit)))
+ (goto-char pos)
+ (when (eq key (get-text-property (point) 'proced-key))
+ (forward-char (min column (- (next-property-change (point))
+ (point))))
+ (setq new-pos (point))))
+ (unless new-pos
+ ;; we found the process, but the field of point
+ ;; is not listed anymore
+ (setq new-pos (proced-move-to-goal-column))))
+ (setq new-pos (min (+ (line-beginning-position) column)
+ (line-end-position))))
+ new-pos)))
+
;; proced mode
(define-derived-mode proced-mode special-mode "Proced"
@@ -847,6 +893,7 @@ normal hook `proced-post-display-hook'.
(setq-local revert-buffer-function #'proced-revert)
(setq-local font-lock-defaults
'(proced-font-lock-keywords t nil nil beginning-of-line))
+ (setq-local switch-to-buffer-preserve-window-point nil)
(if (and (not proced-auto-update-timer) proced-auto-update-interval)
(setq proced-auto-update-timer
(run-at-time t proced-auto-update-interval
@@ -1889,17 +1936,10 @@ After updating a displayed Proced buffer run the normal
hook
(if (consp buffer-undo-list)
(setq buffer-undo-list nil))
(let ((buffer-undo-list t)
- ;; If point is on a field, we try to return point to that field.
- ;; Otherwise we try to return to the same column
- (old-pos (let ((pid (proced-pid-at-point))
- (key (get-text-property (point) 'proced-key)))
- (list pid key ; can both be nil
- (if key
- (if (get-text-property (1- (point)) 'proced-key)
- (- (point) (previous-single-property-change
- (point) 'proced-key))
- 0)
- (current-column)))))
+ (window-pos-infos
+ (mapcar (lambda (w) `(,w . ,(proced--position-info (window-point w))))
+ (get-buffer-window-list (current-buffer) nil t)))
+ (old-pos (proced--position-info (point)))
buffer-read-only mp-list)
;; remember marked processes (whatever the mark was)
(goto-char (point-min))
@@ -1932,7 +1972,8 @@ After updating a displayed Proced buffer run the normal
hook
;; Sometimes this puts point in the middle of the proced buffer
;; where it is not interesting. Is there a better / more flexible
solution?
(goto-char (point-min))
- (let (pid mark new-pos)
+
+ (let (pid mark new-pos win-points)
(if (or mp-list (car old-pos))
(while (not (eobp))
(setq pid (proced-pid-at-point))
@@ -1941,28 +1982,25 @@ After updating a displayed Proced buffer run the normal
hook
(delete-char 1)
(beginning-of-line))
(when (eq (car old-pos) pid)
- (if (nth 1 old-pos)
- (let ((limit (line-end-position)) pos)
- (while (and (not new-pos)
- (setq pos (next-property-change (point) nil
limit)))
- (goto-char pos)
- (when (eq (nth 1 old-pos)
- (get-text-property (point) 'proced-key))
- (forward-char (min (nth 2 old-pos)
- (- (next-property-change (point))
- (point))))
- (setq new-pos (point))))
- (unless new-pos
- ;; we found the process, but the field of point
- ;; is not listed anymore
- (setq new-pos (proced-move-to-goal-column))))
- (setq new-pos (min (+ (line-beginning-position) (nth 2
old-pos))
- (line-end-position)))))
+ (setq new-pos (proced--determine-pos (nth 1 old-pos)
+ (nth 2 old-pos))))
+ (mapc (lambda (w-pos)
+ (when (eq (cadr w-pos) pid)
+ (push `(,(car w-pos) . ,(proced--determine-pos
+ (nth 1 (cdr w-pos))
+ (nth 2 (cdr w-pos))))
+ win-points)))
+ window-pos-infos)
(forward-line)))
- (if new-pos
- (goto-char new-pos)
- (goto-char (point-min))
- (proced-move-to-goal-column)))
+ (let ((fallback (save-excursion (goto-char (point-min))
+ (proced-move-to-goal-column)
+ (point))))
+ (goto-char (or new-pos fallback))
+ ;; Update window points
+ (mapc (lambda (w-pos)
+ (set-window-point (car w-pos)
+ (alist-get (car w-pos) win-points fallback)))
+ window-pos-infos)))
;; update mode line
;; Does the long `mode-name' clutter the mode line? It would be nice
;; to have some other location for displaying the values of the various
diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el
new file mode 100644
index 00000000000..6671d4be5b6
--- /dev/null
+++ b/lisp/progmodes/c-ts-common.el
@@ -0,0 +1,247 @@
+;;; c-ts-common.el --- Utilities for C like Languages -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author : 付禹安 (Yuan Fu) <casouri@gmail.com>
+;; Keywords : c c++ java javascript rust languages tree-sitter
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; For C-like language major modes:
+;;
+;; - Use `c-ts-common-comment-setup' to setup comment variables and
+;; filling.
+;;
+;; - Use simple-indent matcher `c-ts-common-looking-at-star' and
+;; anchor `c-ts-common-comment-start-after-first-star' for indenting
+;; block comments. See `c-ts-mode--indent-styles' for example.
+
+;;; Code:
+
+(require 'treesit)
+(eval-when-compile (require 'rx))
+
+(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-end "treesit.c")
+(declare-function treesit-node-type "treesit.c")
+
+(defun c-ts-common-looking-at-star (_n _p bol &rest _)
+ "A tree-sitter simple indent matcher.
+Matches if there is a \"*\" after BOL."
+ (eq (char-after bol) ?*))
+
+(defun c-ts-common-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))))
+
+(defun c-ts-common-comment-2nd-line-matcher (_n parent &rest _)
+ "Matches if point is at the second line of a block comment.
+PARENT should be a comment node."
+ (and (equal (treesit-node-type parent) "comment")
+ (save-excursion
+ (forward-line -1)
+ (back-to-indentation)
+ (eq (point) (treesit-node-start parent)))))
+
+(defun c-ts-common-comment-2nd-line-anchor (_n _p bol &rest _)
+ "Return appropriate anchor for the second line of a comment.
+
+If the first line is /* alone, return the position right after
+the star; if the first line is /* followed by some text, return
+the position right before the text minus 1.
+
+Use an offset of 1 with this anchor. BOL is the beginning of
+non-whitespace characters of the current line."
+ (save-excursion
+ (forward-line -1)
+ (back-to-indentation)
+ (when (looking-at comment-start-skip)
+ (goto-char (match-end 0))
+ (if (looking-at (rx (* (or " " "\t")) eol))
+ ;; Only /* at the first line.
+ (progn (skip-chars-backward " \t")
+ (if (save-excursion
+ (goto-char bol)
+ (looking-at (rx "*")))
+ ;; The common case. Checked by "Multiline Block
+ ;; Comments 4".
+ (point)
+ ;; The "Multiline Block Comments 2" test in
+ ;; c-ts-common-resources/indent.erts checks this.
+ (1- (point))))
+ ;; There is something after /* at the first line. The
+ ;; "Multiline Block Comments 3" test checks this.
+ (1- (point))))))
+
+(defvar c-ts-common--comment-regexp
+ ;; These covers C/C++, Java, JavaScript, TypeScript, Rust, C#.
+ (rx (or "comment" "line_comment" "block_comment"))
+ "Regexp pattern that matches a comment in C-like languages.")
+
+(defun c-ts-common--fill-paragraph (&optional arg)
+ "Fillling function for `c-ts-common'.
+ARG is passed to `fill-paragraph'."
+ (interactive "*P")
+ (save-restriction
+ (widen)
+ (let ((node (treesit-node-at (point))))
+ (when (string-match-p c-ts-common--comment-regexp
+ (treesit-node-type node))
+ (if (save-excursion
+ (goto-char (treesit-node-start node))
+ (looking-at "//"))
+ (fill-comment-paragraph arg)
+ (c-ts-common--fill-block-comment arg)))
+ ;; Return t so `fill-paragraph' doesn't attempt to fill by
+ ;; itself.
+ t)))
+
+(defun c-ts-common--fill-block-comment (&optional arg)
+ "Fillling function for block comments.
+ARG is passed to `fill-paragraph'. Assume point is in a block
+comment."
+ (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 (point-marker))
+ (end-marker nil)
+ (end-len 0))
+ (move-marker start-marker start)
+ ;; 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))
+ (move-marker start-marker (point))
+ (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)
+ ;; We don't want to fill the region between START and
+ ;; START-MARKER, otherwise the filling function might delete
+ ;; some spaces there.
+ (fill-region start-marker end 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))))))
+
+(defun c-ts-common-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-common--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-common--fill-paragraph))
+
+(provide 'c-ts-common)
+
+;;; c-ts-common.el ends here
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index e76966e7660..1f22a2b2a64 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -24,14 +24,58 @@
;;; Commentary:
;;
+;; This package provides major modes for C and C++, plus some handy
+;; functions that are useful generally to major modes for C-like
+;; languages.
+;;
+;; This package provides `c-ts-mode' for C, `c++-ts-mode' for C++, and
+;; `c-or-c++-ts-mode' which automatically chooses the right mode for
+;; C/C++ header files.
+;;
+;; To use these modes by default, assuming you have the respective
+;; tree-sitter grammars available, do one of the following:
+;;
+;; - If you have both C and C++ grammars installed, add
+;;
+;; (require 'c-ts-mode)
+;;
+;; to your init file.
+;;
+;; - Add one or mode of the following to your init file:
+;;
+;; (add-to-list 'major-mode-remap-alist '(c-mode . c-ts-mode))
+;; (add-to-list 'major-mode-remap-alist '(c++-mode . c++-ts-mode))
+;; (add-to-list 'major-mode-remap-alist '(c-or-c++-mode . c-or-c++-ts-mode))
+;;
+;; If you have only C grammar available, use only the first one; if
+;; you have only the C++ grammar, use only the second one.
+;;
+;; - Customize 'auto-mode-alist' to turn one or more of the modes
+;; automatically. For example:
+;;
+;; (add-to-list 'auto-mode-alist
+;;
'("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'"
+;; . c++-ts-mode))
+;;
+;; will turn on the c++-ts-mode for C++ source files.
+;;
+;; You can also turn on these modes manually in a buffer. Doing so
+;; will set up Emacs to use the C/C++ modes defined here for other
+;; files, provided that you have the corresponding parser grammar
+;; libraries installed.
+;;
+;; - Use variable `c-ts-mode-indent-block-type-regexp' with indent
+;; offset c-ts-mode--statement-offset for indenting statements.
+;; Again, see `c-ts-mode--indent-styles' for example.
+;;
;;; Code:
(require 'treesit)
+(require 'c-ts-common)
(eval-when-compile (require 'rx))
(declare-function treesit-parser-create "treesit.c")
-(declare-function treesit-induce-sparse-tree "treesit.c")
(declare-function treesit-node-parent "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-end "treesit.c")
@@ -115,29 +159,46 @@ delimiters < and >'s."
"Indent rules supported by `c-ts-mode'.
MODE is either `c' or `cpp'."
(let ((common
- `(((parent-is "translation_unit") parent-bol 0)
+ `(((parent-is "translation_unit") point-min 0)
((node-is ")") parent 1)
((node-is "]") 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") c-ts-mode--looking-at-star)
- c-ts-mode--comment-start-after-first-star -1)
+ ;; `c-ts-common-looking-at-star' has to come before
+ ;; `c-ts-common-comment-2nd-line-matcher'.
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-comment-start-after-first-star -1)
+ (c-ts-common-comment-2nd-line-matcher
+ c-ts-common-comment-2nd-line-anchor
+ 1)
((parent-is "comment") prev-adaptive-prefix 0)
+
+ ;; Labels.
((node-is "labeled_statement") parent-bol 0)
- ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset)
+ ((parent-is "labeled_statement")
+ point-min c-ts-mode--statement-offset)
+
((match "preproc_ifdef" "compound_statement") point-min 0)
((match "#endif" "preproc_ifdef") point-min 0)
((match "preproc_if" "compound_statement") point-min 0)
((match "#endif" "preproc_if") point-min 0)
((match "preproc_function_def" "compound_statement") point-min 0)
((match "preproc_call" "compound_statement") point-min 0)
+
+ ;; {} blocks.
+ ((node-is "}") point-min c-ts-mode--close-bracket-offset)
((parent-is "compound_statement")
- c-ts-mode--bracket-children-anchor c-ts-mode-indent-offset)
+ point-min c-ts-mode--statement-offset)
+ ((parent-is "enumerator_list")
+ point-min c-ts-mode--statement-offset)
+ ((parent-is "field_declaration_list")
+ point-min c-ts-mode--statement-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)
+ ((parent-is "concatenated_string") parent-bol
c-ts-mode-indent-offset)
((parent-is "comma_expression") first-sibling 0)
((parent-is "init_declarator") parent-bol c-ts-mode-indent-offset)
((parent-is "parenthesized_expression") first-sibling 1)
@@ -149,10 +210,11 @@ MODE is either `c' or `cpp'."
((query "(for_statement update: (_) @indent)") parent-bol 5)
((query "(call_expression arguments: (_) @indent)") parent
c-ts-mode-indent-offset)
((parent-is "call_expression") parent 0)
- ((parent-is "enumerator_list") parent-bol c-ts-mode-indent-offset)
,@(when (eq mode 'cpp)
- '(((node-is "access_specifier") parent-bol 0)))
- ((parent-is "field_declaration_list") parent-bol
c-ts-mode-indent-offset)
+ '(((node-is "access_specifier") parent-bol 0)
+ ;; Indent the body of namespace definitions.
+ ((parent-is "declaration_list") parent-bol
c-ts-mode-indent-offset)))
+
((parent-is "initializer_list") parent-bol c-ts-mode-indent-offset)
((parent-is "if_statement") parent-bol c-ts-mode-indent-offset)
((parent-is "for_statement") parent-bol c-ts-mode-indent-offset)
@@ -165,10 +227,20 @@ MODE is either `c' or `cpp'."
`((gnu
;; Prepend rules to set highest priority
((match "while" "do_statement") parent 0)
+ (c-ts-mode--top-level-label-matcher point-min 1)
,@common)
(k&r ,@common)
- (linux ,@common)
+ (linux
+ ;; Reference:
+ ;; https://www.kernel.org/doc/html/latest/process/coding-style.html,
+ ;; and script/Lindent in Linux kernel repository.
+ ((node-is "labeled_statement") point-min 0)
+ ,@common)
(bsd
+ ((node-is "}") parent-bol 0)
+ ((node-is "labeled_statement") parent-bol c-ts-mode-indent-offset)
+ ((parent-is "labeled_statement") parent-bol c-ts-mode-indent-offset)
+ ((parent-is "compound_statement") parent-bol c-ts-mode-indent-offset)
((parent-is "if_statement") parent-bol 0)
((parent-is "for_statement") parent-bol 0)
((parent-is "while_statement") parent-bol 0)
@@ -190,36 +262,100 @@ 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))))
+(defun c-ts-mode--top-level-label-matcher (node &rest _)
+ "A matcher that matches a top-level label.
+NODE should be a labeled_statement."
+ (let ((func (treesit-parent-until
+ node (lambda (n)
+ (equal (treesit-node-type n)
+ "compound_statement")))))
+ (and (equal (treesit-node-type node)
+ "labeled_statement")
+ (not (treesit-node-top-level func "compound_statement")))))
+
+(defvar c-ts-mode-indent-block-type-regexp
+ (rx (or "compound_statement"
+ "field_declaration_list"
+ "enumerator_list"))
+ "Regexp matching types of block nodes (i.e., {} blocks).")
+
+(defvar c-ts-mode--statement-offset-post-processr nil
+ "A functions that makes adjustments to `c-ts-mode--statement-offset'.
+
+This is a function that takes two arguments, the current indent
+level and the current node, and returns a new level.
+
+When `c-ts-mode--statement-offset' runs and go up the parse tree,
+it increments the indent level when some condition are met in
+each level. At each level, after (possibly) incrementing the
+offset, it calls this function, passing it the current indent
+level and the current node, and use the return value as the new
+indent level.")
+
+(defun c-ts-mode--statement-offset (node parent &rest _)
+ "This anchor is used for children of a statement inside a block.
+
+This function basically counts the number of block nodes (defined
+by `c-ts-mode--indent-block-type-regexp') between NODE and the
+root node (not counting NODE itself), and multiply that by
+`c-ts-mode-indent-offset'.
+
+To support GNU style, on each block level, this function also
+checks whether the opening bracket { is on its own line, if so,
+it adds an extra level, except for the top-level.
+
+PARENT is NODE's parent."
+ (let ((level 0))
+ ;; If point is on an empty line, NODE would be nil, but we pretend
+ ;; there is a statement node.
+ (when (null node)
+ (setq node t))
+ (while (if (eq node t)
+ (setq node parent)
+ (setq node (treesit-node-parent node)))
+ (when (string-match-p c-ts-mode-indent-block-type-regexp
+ (treesit-node-type node))
+ (cl-incf level)
+ (save-excursion
+ (goto-char (treesit-node-start node))
+ ;; Add an extra level if the opening bracket is on its own
+ ;; line, except (1) it's at top-level, or (2) it's immedate
+ ;; parent is another block.
+ (cond ((bolp) nil) ; Case (1).
+ ((let ((parent-type (treesit-node-type
+ (treesit-node-parent node))))
+ ;; Case (2).
+ (and parent-type
+ (string-match-p c-ts-mode-indent-block-type-regexp
+ parent-type)))
+ nil)
+ ;; Add a level.
+ ((looking-back (rx bol (* whitespace))
+ (line-beginning-position))
+ (cl-incf level)))))
+ (when c-ts-mode--statement-offset-post-processr
+ (setq level (funcall c-ts-mode--statement-offset-post-processr
+ level node))))
+ (* level c-ts-mode-indent-offset)))
+
+(defun c-ts-mode--fix-bracketless-indent (level node)
+ "Takes LEVEL and NODE and returns adjusted LEVEL.
+This fixes indentation for cases shown in bug#61026. Basically
+in C/C++, constructs like if, for, while sometimes don't have
+bracket."
+ (if (and (not (equal (treesit-node-type node) "compound_statement"))
+ (member (treesit-node-type (treesit-node-parent node))
+ '("if_statement" "while_statement" "do_statement"
+ "for_statement")))
+ (1+ level)
+ level))
+
+(defun c-ts-mode--close-bracket-offset (node parent &rest _)
+ "Offset for the closing bracket, NODE.
+It's basically one level less that the statements in the block.
+PARENT is NODE's parent."
+ (- (c-ts-mode--statement-offset node parent)
+ c-ts-mode-indent-offset))
;;; Font-lock
@@ -419,20 +555,29 @@ MODE is either `c' or `cpp'."
;;; Font-lock helpers
-(defun c-ts-mode--declarator-identifier (node)
- "Return the identifier of the declarator node NODE."
+(defun c-ts-mode--declarator-identifier (node &optional qualified)
+ "Return the identifier of the declarator node NODE.
+
+If QUALIFIED is non-nil, include the names space part of the
+identifier and return a qualified_identifier."
(pcase (treesit-node-type node)
;; Recurse.
((or "attributed_declarator" "parenthesized_declarator")
- (c-ts-mode--declarator-identifier (treesit-node-child node 0 t)))
+ (c-ts-mode--declarator-identifier (treesit-node-child node 0 t)
+ qualified))
((or "pointer_declarator" "reference_declarator")
- (c-ts-mode--declarator-identifier (treesit-node-child node -1)))
+ (c-ts-mode--declarator-identifier (treesit-node-child node -1)
+ qualified))
((or "function_declarator" "array_declarator" "init_declarator")
(c-ts-mode--declarator-identifier
- (treesit-node-child-by-field-name node "declarator")))
+ (treesit-node-child-by-field-name node "declarator")
+ qualified))
("qualified_identifier"
- (c-ts-mode--declarator-identifier
- (treesit-node-child-by-field-name node "name")))
+ (if qualified
+ node
+ (c-ts-mode--declarator-identifier
+ (treesit-node-child-by-field-name node "name")
+ qualified)))
;; Terminal case.
((or "identifier" "field_identifier")
node)))
@@ -534,9 +679,11 @@ Return nil if NODE is not a defun node or doesn't have a
name."
(pcase (treesit-node-type node)
((or "function_definition" "declaration")
(c-ts-mode--declarator-identifier
- (treesit-node-child-by-field-name node "declarator")))
+ (treesit-node-child-by-field-name node "declarator")
+ t))
((or "struct_specifier" "enum_specifier"
- "union_specifier" "class_specifier")
+ "union_specifier" "class_specifier"
+ "namespace_definition")
(treesit-node-child-by-field-name node "name")))
t))
@@ -568,6 +715,23 @@ Ie, NODE is not nested."
node "declarator"))
"function_declarator")))))
+(defun c-ts-mode--defun-for-class-in-imenu-p (node)
+ "Check if NODE is a valid entry for the Class subindex.
+
+Basically, if NODE is a class, return non-nil; if NODE is a
+function but is under a class, return non-nil; if NODE is a
+top-level function, return nil.
+
+This is for the Class subindex in
+`treesit-simple-imenu-settings'."
+ (pcase (treesit-node-type node)
+ ;; The Class subindex only has class_specifier and
+ ;; function_definition.
+ ("class_specifier" t)
+ ("function_definition"
+ ;; Return t if this function is nested in a class.
+ (treesit-node-top-level node "class_specifier"))))
+
(defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends.
Structs in C ends with a semicolon, but the semicolon is not
@@ -588,138 +752,6 @@ the semicolon. This function skips the semicolon."
(treesit-node-end node))
(goto-char orig-point)))
-;;; Filling
-
-(defun c-ts-mode--fill-paragraph (&optional arg)
- "Fillling function for `c-ts-mode'.
-ARG is passed to `fill-paragraph'."
- (interactive "*P")
- (save-restriction
- (widen)
- (let* ((node (treesit-node-at (point)))
- (start (treesit-node-start node))
- (end (treesit-node-end node))
- ;; Bind to nil to avoid infinite recursion.
- (fill-paragraph-function nil)
- (orig-point (point-marker))
- (start-marker nil)
- (end-marker nil)
- (end-len 0))
- ;; These covers C/C++, Java, JavaScript, TypeScript, Rust, C#.
- (when (member (treesit-node-type node)
- '("comment" "line_comment" "block_comment"))
- ;; We mask "/*" and the space before "*/" like
- ;; `c-fill-paragraph' does.
- (atomic-change-group
- ;; Mask "/*".
- (goto-char start)
- (when (looking-at (rx (* (syntax whitespace))
- (group "/") "*"))
- (goto-char (match-beginning 1))
- (setq start-marker (point-marker))
- (replace-match " " nil nil nil 1))
- ;; Include whitespaces before /*.
- (goto-char start)
- (beginning-of-line)
- (setq start (point))
- ;; Mask spaces before "*/" if it is attached at the end
- ;; of a sentence rather than on its own line.
- (goto-char end)
- (when (looking-back (rx (not (syntax whitespace))
- (group (+ (syntax whitespace)))
- "*/")
- (line-beginning-position))
- (goto-char (match-beginning 1))
- (setq end-marker (point-marker))
- (setq end-len (- (match-end 1) (match-beginning 1)))
- (replace-match (make-string end-len ?x)
- nil nil nil 1))
- ;; If "*/" is on its own line, don't included it in the
- ;; filling region.
- (when (not end-marker)
- (goto-char end)
- (when (looking-back (rx "*/") 2)
- (backward-char 2)
- (skip-syntax-backward "-")
- (setq end (point))))
- ;; Let `fill-paragraph' do its thing.
- (goto-char orig-point)
- (narrow-to-region start end)
- (funcall #'fill-paragraph arg)
- ;; Unmask.
- (when start-marker
- (goto-char start-marker)
- (delete-char 1)
- (insert "/"))
- (when end-marker
- (goto-char end-marker)
- (delete-region (point) (+ end-len (point)))
- (insert (make-string end-len ?\s))))
- (goto-char orig-point))
- ;; Return t so `fill-paragraph' doesn't attempt to fill by
- ;; itself.
- t)))
-
-(defun c-ts-mode-comment-setup ()
- "Set up local variables for C-like comment.
-
-Set up:
- - `comment-start'
- - `comment-end'
- - `comment-start-skip'
- - `comment-end-skip'
- - `adaptive-fill-mode'
- - `adaptive-fill-first-line-regexp'
- - `paragraph-start'
- - `paragraph-separate'
- - `fill-paragraph-function'"
- (setq-local comment-start "// ")
- (setq-local comment-end "")
- (setq-local comment-start-skip (rx (or (seq "/" (+ "/"))
- (seq "/" (+ "*")))
- (* (syntax whitespace))))
- (setq-local comment-end-skip
- (rx (* (syntax whitespace))
- (group (or (syntax comment-end)
- (seq (+ "*") "/")))))
- (setq-local adaptive-fill-mode t)
- ;; This matches (1) empty spaces (the default), (2) "//", (3) "*",
- ;; but do not match "/*", because we don't want to use "/*" as
- ;; prefix when filling. (Actually, it doesn't matter, because
- ;; `comment-start-skip' matches "/*" which will cause
- ;; `fill-context-prefix' to use "/*" as a prefix for filling, that's
- ;; why we mask the "/*" in `c-ts-mode--fill-paragraph'.)
- (setq-local adaptive-fill-regexp
- (concat (rx (* (syntax whitespace))
- (group (or (seq "/" (+ "/")) (* "*"))))
- adaptive-fill-regexp))
- ;; Note the missing * comparing to `adaptive-fill-regexp'. The
- ;; reason for its absence is a bit convoluted to explain. Suffice
- ;; to say that without it, filling a single line paragraph that
- ;; starts with /* doesn't insert * at the beginning of each
- ;; following line, and filling a multi-line paragraph whose first
- ;; two lines start with * does insert * at the beginning of each
- ;; following line. If you know how does adaptive filling works, you
- ;; know what I mean.
- (setq-local adaptive-fill-first-line-regexp
- (rx bos
- (seq (* (syntax whitespace))
- (group (seq "/" (+ "/")))
- (* (syntax whitespace)))
- eos))
- ;; Same as `adaptive-fill-regexp'.
- (setq-local paragraph-start
- (rx (or (seq (* (syntax whitespace))
- (group (or (seq "/" (+ "/")) (* "*")))
- (* (syntax whitespace))
- ;; Add this eol so that in
- ;; `fill-context-prefix', `paragraph-start'
- ;; doesn't match the prefix.
- eol)
- "\f")))
- (setq-local paragraph-separate paragraph-start)
- (setq-local fill-paragraph-function #'c-ts-mode--fill-paragraph))
-
;;; Modes
(defvar-keymap c-ts-mode-map
@@ -741,11 +773,43 @@ Set up:
"struct_specifier"
"enum_specifier"
"union_specifier"
- "class_specifier"))
+ "class_specifier"
+ "namespace_definition"))
#'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)
+ (setq-local treesit-sentence-type-regexp
+ ;; compound_statement makes us jump over too big units
+ ;; of code, so skip that one, and include the other
+ ;; statements.
+ (regexp-opt '("preproc"
+ "declaration"
+ "specifier"
+ "attributed_statement"
+ "labeled_statement"
+ "expression_statement"
+ "if_statement"
+ "switch_statement"
+ "do_statement"
+ "while_statement"
+ "for_statement"
+ "return_statement"
+ "break_statement"
+ "continue_statement"
+ "goto_statement"
+ "case_statement")))
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt '("preproc"
+ "declarator"
+ "qualifier"
+ "type"
+ "parameter"
+ "expression"
+ "literal"
+ "string")))
+
;; Nodes like struct/enum/union_specifier can appear in
;; function_definitions, so we need to find the top-level node.
(setq-local treesit-defun-prefer-top-level t)
@@ -753,9 +817,11 @@ Set up:
;; Indent.
(when (eq c-ts-mode-indent-style 'linux)
(setq-local indent-tabs-mode t))
+ (setq-local c-ts-mode--statement-offset-post-processr
+ #'c-ts-mode--fix-bracketless-indent)
;; Comment
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
;; Electric
(setq-local electric-indent-chars
@@ -772,7 +838,7 @@ Set up:
("Class" ,(rx bos (or "class_specifier"
"function_definition")
eos)
- ,pred nil))))
+ c-ts-mode--defun-for-class-in-imenu-p nil))))
(setq-local treesit-font-lock-feature-list
'(( comment definition)
@@ -782,49 +848,131 @@ Set up:
;;;###autoload
(define-derived-mode c-ts-mode c-ts-base-mode "C"
- "Major mode for editing C, powered by tree-sitter."
- :group 'c
-
- (unless (treesit-ready-p 'c)
- (error "Tree-sitter for C isn't available"))
+ "Major mode for editing C, powered by tree-sitter.
- (treesit-parser-create 'c)
+This mode is independent from the classic cc-mode.el based
+`c-mode', so configuration variables of that mode, like
+`c-basic-offset', doesn't affect this mode.
- ;; Comments.
- (setq-local comment-start "/* ")
- (setq-local comment-end " */")
+To use tree-sitter C/C++ modes by default, evaluate
- (setq-local treesit-simple-indent-rules
- (c-ts-mode--set-indent-style 'c))
+ (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode))
+ (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode))
+ (add-to-list \\='major-mode-remap-alist
+ \\='(c-or-c++-mode . c-or-c++-ts-mode))
- ;; Font-lock.
- (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
+in your configuration."
+ :group 'c
- (treesit-major-mode-setup))
+ (when (treesit-ready-p 'c)
+ (treesit-parser-create 'c)
+ ;; Comments.
+ (setq-local comment-start "/* ")
+ (setq-local comment-end " */")
+ ;; Indent.
+ (setq-local treesit-simple-indent-rules
+ (c-ts-mode--set-indent-style 'c))
+ ;; Font-lock.
+ (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'c))
+ (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++
+ "Major mode for editing C++, powered by tree-sitter.
- (unless (treesit-ready-p 'cpp)
- (error "Tree-sitter for C++ isn't available"))
+This mode is independent from the classic cc-mode.el based
+`c++-mode', so configuration variables of that mode, like
+`c-basic-offset', don't affect this mode.
- (setq-local treesit-text-type-regexp
- (regexp-opt '("comment"
- "raw_string_literal")))
+To use tree-sitter C/C++ modes by default, evaluate
- (treesit-parser-create 'cpp)
- (setq-local syntax-propertize-function
- #'c-ts-mode--syntax-propertize)
+ (add-to-list \\='major-mode-remap-alist \\='(c-mode . c-ts-mode))
+ (add-to-list \\='major-mode-remap-alist \\='(c++-mode . c++-ts-mode))
+ (add-to-list \\='major-mode-remap-alist
+ \\='(c-or-c++-mode . c-or-c++-ts-mode))
- (setq-local treesit-simple-indent-rules
- (c-ts-mode--set-indent-style 'cpp))
+in your configuration."
+ :group 'c++
- ;; Font-lock.
- (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings 'cpp))
+ (when (treesit-ready-p 'cpp)
+ (setq-local treesit-text-type-regexp
+ (regexp-opt '("comment"
+ "raw_string_literal")))
+
+ (treesit-parser-create 'cpp)
+
+ ;; Syntax.
+ (setq-local syntax-propertize-function
+ #'c-ts-mode--syntax-propertize)
+
+ ;; Indent.
+ (setq-local treesit-simple-indent-rules
+ (c-ts-mode--set-indent-style 'cpp))
+
+ ;; Font-lock.
+ (setq-local treesit-font-lock-settings (c-ts-mode--font-lock-settings
'cpp))
+
+ (treesit-major-mode-setup)))
+
+;; We could alternatively use parsers, but if this works well, I don't
+;; see the need to change. This is copied verbatim from cc-guess.el.
+(defconst c-ts-mode--c-or-c++-regexp
+ (eval-when-compile
+ (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t]+") (ws-maybe "[ \t]*")
+ (headers '("string" "string_view" "iostream" "map" "unordered_map"
+ "set" "unordered_set" "vector" "tuple")))
+ (concat "^" ws-maybe "\\(?:"
+ "using" ws "\\(?:namespace" ws
+ "\\|" id "::"
+ "\\|" id ws-maybe "=\\)"
+ "\\|" "\\(?:inline" ws "\\)?namespace"
+ "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{"
+ "\\|" "class" ws id
+ "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]"
+ "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]"
+ "\\|" ws-maybe ":\\)"
+ "\\|" "template" ws-maybe "<.*?>"
+ "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">"
+ "\\)")))
+ "A regexp applied to C header files to check if they are really C++.")
- (treesit-major-mode-setup))
+;;;###autoload
+(defun c-or-c++-ts-mode ()
+ "Analyze buffer and enable either C or C++ mode.
+
+Some people and projects use .h extension for C++ header files
+which is also the one used for C header files. This makes
+matching on file name insufficient for detecting major mode that
+should be used.
+
+This function attempts to use file contents to determine whether
+the code is C or C++ and based on that chooses whether to enable
+`c-ts-mode' or `c++-ts-mode'."
+ (interactive)
+ (if (save-excursion
+ (save-restriction
+ (save-match-data ; Why `save-match-data'?
+ (widen)
+ (goto-char (point-min))
+ (re-search-forward c-ts-mode--c-or-c++-regexp nil t))))
+ (c++-ts-mode)
+ (c-ts-mode)))
+;; The entries for C++ must come first to prevent *.c files be taken
+;; as C++ on case-insensitive filesystems, since *.C files are C++,
+;; not C.
+(if (treesit-ready-p 'cpp)
+ (add-to-list 'auto-mode-alist
+
'("\\(\\.ii\\|\\.\\(CC?\\|HH?\\)\\|\\.[ch]\\(pp\\|xx\\|\\+\\+\\)\\|\\.\\(cc\\|hh\\)\\)\\'"
+ . c++-ts-mode)))
+
+(if (treesit-ready-p 'c)
+ (add-to-list 'auto-mode-alist
+ '("\\(\\.[chi]\\|\\.lex\\|\\.y\\(acc\\)?\\|\\.x[bp]m\\)\\'"
+ . c-ts-mode)))
+
+(if (and (treesit-ready-p 'cpp)
+ (treesit-ready-p 'c))
+ (add-to-list 'auto-mode-alist '("\\.h\\'" . c-or-c++-ts-mode)))
(provide 'c-ts-mode)
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 493035d38b4..bdbc03e7c94 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -1361,6 +1361,28 @@ nil; point is then left undefined."
(search-forward-regexp "\\(\n\\|.\\)") ; to set the match-data.
(point))))
+(defmacro c-search-forward-non-nil-char-property (property &optional limit)
+ "Search forward for a text-property PROPERTY value non-nil.
+LIMIT bounds the search.
+
+Leave point just after the character. The match data remain
+unchanged. Return the value of PROPERTY. If a non-nil value
+isn't found, return nil; point is then left undefined."
+ (declare (debug t))
+ `(let* ((-limit- (or ,limit (point-max)))
+ (value (c-get-char-property (point) ,property)))
+ (cond
+ ((>= (point) -limit-)
+ nil)
+ (value
+ (forward-char)
+ value)
+ (t (let ((place (c-next-single-property-change
+ (point) ,property nil -limit-)))
+ (when place
+ (goto-char (1+ place))
+ (c-get-char-property place ,property)))))))
+
(defmacro c-search-backward-char-property (property value &optional limit)
"Search backward for a text-property PROPERTY having value VALUE.
LIMIT bounds the search. The comparison is done with `equal'.
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 8ac3ef6808d..f1e93c1c23c 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -142,6 +142,10 @@
;; Put on the brace which introduces a brace list and on the commas
;; which separate the elements within it.
;;
+;; 'c-typedef This property is applied to the first character of a
+;; "typedef" keyword. It's value is a list of the identifiers that
+;; the "typedef" declares as types.
+;;
;; 'c-<>-c-types-set
;; This property is set on an opening angle bracket, and indicates that
;; any "," separators within the template/generic expression have been
@@ -7353,7 +7357,7 @@ multi-line strings (but not C++, for example)."
(cons (match-beginning 1)
(cons (match-end 1) (match-beginning 2))))
(goto-char here))))
-
+
(defun c-ml-string-opener-intersects-region (&optional start finish)
;; If any part of the region [START FINISH] is inside an ml-string opener,
;; return a dotted list of the start, end and double-quote position of that
@@ -8284,10 +8288,17 @@ multi-line strings (but not C++, for example)."
(setq c-record-ref-identifiers
(cons range c-record-ref-identifiers))))))
-(defmacro c-forward-keyword-prefixed-id (type)
+(defmacro c-forward-keyword-prefixed-id (type &optional stop-at-end)
;; Used internally in `c-forward-keyword-clause' to move forward
;; over a type (if TYPE is 'type) or a name (otherwise) which
;; possibly is prefixed by keywords and their associated clauses.
+ ;; Point should be at the type/name or a preceding keyword at the start of
+ ;; the macro, and it is left at the first token following the type/name,
+ ;; or (when STOP-AT-END is non-nil) immediately after that type/name.
+ ;;
+ ;; Note that both parameters are evaluated at compile time, not run time,
+ ;; so they must be constants.
+ ;;
;; Try with a type/name first to not trip up on those that begin
;; with a keyword. Return t if a known or found type is moved
;; over. The point is clobbered if nil is returned. If range
@@ -8296,51 +8307,84 @@ multi-line strings (but not C++, for example)."
;;
;; This macro might do hidden buffer changes.
(declare (debug t))
- `(let (res)
+ `(let (res pos)
(setq c-last-identifier-range nil)
(while (if (setq res ,(if (eq type 'type)
- '(c-forward-type)
- '(c-forward-name)))
- nil
- (cond ((looking-at c-keywords-regexp)
- (c-forward-keyword-clause 1))
- ((and c-opt-cpp-prefix
- (looking-at c-noise-macro-with-parens-name-re))
- (c-forward-noise-clause)))))
+ `(c-forward-type nil ,stop-at-end)
+ `(c-forward-name ,stop-at-end)))
+ (progn
+ (setq pos (point))
+ nil)
+ (and
+ (cond ((looking-at c-keywords-regexp)
+ (c-forward-keyword-clause 1 t))
+ ((and c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause t)))
+ (progn
+ (setq pos (point))
+ (c-forward-syntactic-ws)
+ t))))
(when (memq res '(t known found prefix maybe))
(when c-record-type-identifiers
- ,(if (eq type 'type)
- '(c-record-type-id c-last-identifier-range)
- '(c-record-ref-id c-last-identifier-range)))
+ ,(if (eq type 'type)
+ '(c-record-type-id c-last-identifier-range)
+ '(c-record-ref-id c-last-identifier-range)))
+ (when pos
+ (goto-char pos)
+ ,(unless stop-at-end
+ `(c-forward-syntactic-ws)))
t)))
-(defmacro c-forward-id-comma-list (type update-safe-pos)
+(defmacro c-forward-id-comma-list (type update-safe-pos &optional stop-at-end)
;; Used internally in `c-forward-keyword-clause' to move forward
;; over a comma separated list of types or names using
- ;; `c-forward-keyword-prefixed-id'.
+ ;; `c-forward-keyword-prefixed-id'. Point should start at the first token
+ ;; after the already scanned type/name, or (if STOP-AT-END is non-nil)
+ ;; immediately after that type/name. Point is left either before or
+ ;; after the whitespace following the last type/name in the list, depending
+ ;; on whether STOP-AT-END is non-nil or nil. The return value is without
+ ;; significance.
+ ;;
+ ;; Note that all three parameters are evaluated at compile time, not run
+ ;; time, so they must be constants.
;;
;; This macro might do hidden buffer changes.
(declare (debug t))
- `(while (and (progn
- ,(when update-safe-pos
- '(setq safe-pos (point)))
- (eq (char-after) ?,))
- (progn
- (forward-char)
- (c-forward-syntactic-ws)
- (c-forward-keyword-prefixed-id ,type)))))
+ `(let ((pos (point)))
+ (while (and (progn
+ ,(when update-safe-pos
+ `(setq safe-pos (point)))
+ (setq pos (point))
+ (c-forward-syntactic-ws)
+ (eq (char-after) ?,))
+ (progn
+ (forward-char)
+ (setq pos (point))
+ (c-forward-syntactic-ws)
+ (c-forward-keyword-prefixed-id ,type t))))
+ (goto-char pos)
+ ,(unless stop-at-end
+ `(c-forward-syntactic-ws))))
-(defun c-forward-noise-clause ()
+(defun c-forward-noise-clause (&optional stop-at-end)
;; Point is at a c-noise-macro-with-parens-names macro identifier. Go
;; forward over this name, any parenthesis expression which follows it, and
- ;; any syntactic WS, ending up at the next token or EOB. If there is an
+ ;; any syntactic WS, ending up either at the next token or EOB or (when
+ ;; STOP-AT-END is non-nil) directly after the clause. If there is an
;; unbalanced paren expression, leave point at it. Always Return t.
- (or (zerop (c-forward-token-2))
- (goto-char (point-max)))
- (if (and (eq (char-after) ?\()
- (c-go-list-forward))
+ (let (pos)
+ (or (c-forward-over-token)
+ (goto-char (point-max)))
+ (setq pos (point))
+ (c-forward-syntactic-ws)
+ (when (and (eq (char-after) ?\()
+ (c-go-list-forward))
+ (setq pos (point)))
+ (goto-char pos)
+ (unless stop-at-end
(c-forward-syntactic-ws))
- t)
+ t))
(defun c-forward-noise-clause-not-macro-decl (maybe-parens)
;; Point is at a noise macro identifier, which, when MAYBE-PARENS is
@@ -8374,11 +8418,12 @@ multi-line strings (but not C++, for example)."
(goto-char here)
nil)))
-(defun c-forward-keyword-clause (match)
+(defun c-forward-keyword-clause (match &optional stop-at-end)
;; Submatch MATCH in the current match data is assumed to surround a
;; token. If it's a keyword, move over it and any immediately
- ;; following clauses associated with it, stopping at the start of
- ;; the next token. t is returned in that case, otherwise the point
+ ;; following clauses associated with it, stopping either at the start
+ ;; of the next token, or (when STOP-AT-END is non-nil) at the end
+ ;; of the clause. t is returned in that case, otherwise the point
;; stays and nil is returned. The kind of clauses that are
;; recognized are those specified by `c-type-list-kwds',
;; `c-ref-list-kwds', `c-colon-type-list-kwds',
@@ -8408,19 +8453,23 @@ multi-line strings (but not C++, for example)."
(when kwd-sym
(goto-char (match-end match))
- (c-forward-syntactic-ws)
(setq safe-pos (point))
+ (c-forward-syntactic-ws)
(cond
((and (c-keyword-member kwd-sym 'c-type-list-kwds)
- (c-forward-keyword-prefixed-id type))
+ (c-forward-keyword-prefixed-id type t))
;; There's a type directly after a keyword in `c-type-list-kwds'.
- (c-forward-id-comma-list type t))
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)
+ (c-forward-id-comma-list type t t))
((and (c-keyword-member kwd-sym 'c-ref-list-kwds)
- (c-forward-keyword-prefixed-id ref))
+ (c-forward-keyword-prefixed-id ref t))
;; There's a name directly after a keyword in `c-ref-list-kwds'.
- (c-forward-id-comma-list ref t))
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)
+ (c-forward-id-comma-list ref t t))
((and (c-keyword-member kwd-sym 'c-paren-any-kwds)
(eq (char-after) ?\())
@@ -8440,20 +8489,20 @@ multi-line strings (but not C++, for example)."
(goto-char (match-end 0)))))
(goto-char pos)
- (c-forward-syntactic-ws)
- (setq safe-pos (point))))
+ (setq safe-pos (point)))
+ (c-forward-syntactic-ws))
((and (c-keyword-member kwd-sym 'c-<>-sexp-kwds)
(eq (char-after) ?<)
(c-forward-<>-arglist (c-keyword-member kwd-sym 'c-<>-type-kwds)))
- (c-forward-syntactic-ws)
- (setq safe-pos (point)))
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws))
((and (c-keyword-member kwd-sym 'c-nonsymbol-sexp-kwds)
(not (looking-at c-symbol-start))
(c-safe (c-forward-sexp) t))
- (c-forward-syntactic-ws)
- (setq safe-pos (point)))
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws))
((and (c-keyword-member kwd-sym 'c-protection-kwds)
(or (null c-post-protection-token)
@@ -8463,8 +8512,8 @@ multi-line strings (but not C++, for example)."
(not (c-end-of-current-token))))))
(if c-post-protection-token
(goto-char (match-end 0)))
- (c-forward-syntactic-ws)
- (setq safe-pos (point))))
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)))
(when (c-keyword-member kwd-sym 'c-colon-type-list-kwds)
(if (eq (char-after) ?:)
@@ -8473,8 +8522,10 @@ multi-line strings (but not C++, for example)."
(progn
(forward-char)
(c-forward-syntactic-ws)
- (when (c-forward-keyword-prefixed-id type)
- (c-forward-id-comma-list type t)))
+ (when (c-forward-keyword-prefixed-id type t)
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)
+ (c-forward-id-comma-list type t t)))
;; Not at the colon, so stop here. But the identifier
;; ranges in the type list later on should still be
;; recorded.
@@ -8484,15 +8535,18 @@ multi-line strings (but not C++, for example)."
;; this one, we move forward to the colon following the
;; clause matched above.
(goto-char safe-pos)
+ (c-forward-syntactic-ws)
(c-forward-over-colon-type-list))
(progn
(c-forward-syntactic-ws)
- (c-forward-keyword-prefixed-id type))
+ (c-forward-keyword-prefixed-id type t))
;; There's a type after the `c-colon-type-list-re' match
;; after a keyword in `c-colon-type-list-kwds'.
(c-forward-id-comma-list type nil))))
(goto-char safe-pos)
+ (unless stop-at-end
+ (c-forward-syntactic-ws))
t)))
;; cc-mode requires cc-fonts.
@@ -8823,11 +8877,12 @@ multi-line strings (but not C++, for example)."
(/= (point) start))))
-(defun c-forward-name ()
- ;; Move forward over a complete name if at the beginning of one,
- ;; stopping at the next following token. A keyword, as such,
- ;; doesn't count as a name. If the point is not at something that
- ;; is recognized as a name then it stays put.
+(defun c-forward-name (&optional stop-at-end)
+ ;; Move forward over a complete name if at the beginning of one, stopping
+ ;; either at the next following token or (when STOP-AT-END is non-nil) at
+ ;; the end of the name. A keyword, as such, doesn't count as a name. If
+ ;; the point is not at something that is recognized as a name then it stays
+ ;; put.
;;
;; A name could be something as simple as "foo" in C or something as
;; complex as "X<Y<class A<int>::B, BIT_MAX >> b>, ::operator<> ::
@@ -8849,7 +8904,7 @@ multi-line strings (but not C++, for example)."
;;
;; This function might do hidden buffer changes.
- (let ((pos (point)) (start (point)) res id-start id-end
+ (let ((pos (point)) pos2 pos3 (start (point)) res id-start id-end
;; Turn off `c-promote-possible-types' here since we might
;; call `c-forward-<>-arglist' and we don't want it to promote
;; every suspect thing in the arglist to a type. We're
@@ -8891,7 +8946,7 @@ multi-line strings (but not C++, for example)."
(c-forward-syntactic-ws lim+)
(cond ((eq (char-before id-end) ?e)
;; Got "... ::template".
- (let ((subres (c-forward-name)))
+ (let ((subres (c-forward-name t)))
(when subres
(setq pos (point)
res subres))))
@@ -8903,7 +8958,7 @@ multi-line strings (but not C++, for example)."
(and (eq (c-forward-token-2) 0)
(not (eq (char-after) ?\())))))
;; Got a cast operator.
- (when (c-forward-type)
+ (when (c-forward-type nil t)
(setq pos (point)
res 'operator)
;; Now we should match a sequence of either
@@ -8927,8 +8982,8 @@ multi-line strings (but not C++, for example)."
(forward-char)
t)))))
(while (progn
- (c-forward-syntactic-ws lim+)
(setq pos (point))
+ (c-forward-syntactic-ws lim+)
(and
(<= (point) lim+)
(looking-at c-opt-type-modifier-key)))
@@ -8943,30 +8998,34 @@ multi-line strings (but not C++, for example)."
;; operator"" has an (?)optional tag after it.
(progn
(goto-char (match-end 0))
+ (setq pos2 (point))
(c-forward-syntactic-ws lim+)
(when (c-on-identifier)
- (c-forward-token-2 1 nil lim+)))
- (goto-char (match-end 0))
- (c-forward-syntactic-ws lim+))
- (setq pos (point)
+ (c-forward-over-token nil lim+)))
+ (goto-char (match-end 0))
+ (setq pos2 (point))
+ (c-forward-syntactic-ws lim+))
+ (setq pos pos2
res 'operator)))
nil)
;; `id-start' is equal to `id-end' if we've jumped over
;; an identifier that doesn't end with a symbol token.
- ;; That can occur e.g. for Java import directives on the
+ ;; That can occur e.g. for Java import directives of the
;; form "foo.bar.*".
(when (and id-start (/= id-start id-end))
(setq c-last-identifier-range
(cons id-start id-end)))
(goto-char id-end)
+ (setq pos (point))
(c-forward-syntactic-ws lim+)
- (setq pos (point)
- res t)))
+ (setq res t)))
(progn
(goto-char pos)
+ (c-forward-syntactic-ws lim+)
+ (setq pos3 (point))
(when (or c-opt-identifier-concat-key
c-recognize-<>-arglists)
@@ -8977,7 +9036,6 @@ multi-line strings (but not C++, for example)."
;; cases with tricky syntactic whitespace that aren't
;; covered in `c-identifier-key'.
(goto-char (match-end 0))
- (c-forward-syntactic-ws lim+)
t)
((and c-recognize-<>-arglists
@@ -8989,11 +9047,12 @@ multi-line strings (but not C++, for example)."
;; `lim+'.
(setq lim+ (c-determine-+ve-limit 500))
+ (setq pos2 (point))
(c-forward-syntactic-ws lim+)
(unless (eq (char-after) ?\()
(setq c-last-identifier-range nil)
- (c-add-type start (1+ pos)))
- (setq pos (point))
+ (c-add-type start (1+ pos3)))
+ (setq pos pos2)
(if (and c-opt-identifier-concat-key
(looking-at c-opt-identifier-concat-key))
@@ -9003,7 +9062,7 @@ multi-line strings (but not C++, for example)."
(progn
(when (and c-record-type-identifiers id-start)
(c-record-ref-id (cons id-start id-end)))
- (forward-char 2)
+ (goto-char (match-end 0))
(c-forward-syntactic-ws lim+)
t)
@@ -9015,11 +9074,14 @@ multi-line strings (but not C++, for example)."
)))))
(goto-char pos)
+ (unless stop-at-end
+ (c-forward-syntactic-ws lim+))
res))
-(defun c-forward-type (&optional brace-block-too)
+(defun c-forward-type (&optional brace-block-too stop-at-end)
;; Move forward over a type spec if at the beginning of one,
- ;; stopping at the next following token. The keyword "typedef"
+ ;; stopping at the next following token (if STOP-AT-END is nil) or
+ ;; at the end of the type spec (otherwise). The keyword "typedef"
;; isn't part of a type spec here.
;;
;; BRACE-BLOCK-TOO, when non-nil, means move over the brace block in
@@ -9068,6 +9130,7 @@ multi-line strings (but not C++, for example)."
(when (looking-at c-no-type-key)
(setq res 'no-id)))
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
(or (eq res 'no-id)
(setq res 'prefix))))
@@ -9076,32 +9139,41 @@ multi-line strings (but not C++, for example)."
(cond
((looking-at c-typeof-key) ; e.g. C++'s "decltype".
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
(setq res (and (eq (char-after) ?\()
(c-safe (c-forward-sexp))
'decltype))
(if res
- (c-forward-syntactic-ws)
+ (progn
+ (setq pos (point))
+ (c-forward-syntactic-ws))
(goto-char start)))
((looking-at c-type-prefix-key) ; e.g. "struct", "class", but NOT
; "typedef".
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
(while (cond
((looking-at c-decl-hangon-key)
- (c-forward-keyword-clause 1))
+ (c-forward-keyword-clause 1 t)
+ (setq pos (point))
+ (c-forward-syntactic-ws))
((looking-at c-pack-key)
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws))
((and c-opt-cpp-prefix
(looking-at c-noise-macro-with-parens-name-re))
- (c-forward-noise-clause))))
+ (c-forward-noise-clause t)
+ (setq pos (point))
+ (c-forward-syntactic-ws))))
+ (setq id-start (point))
+ (setq name-res (c-forward-name t))
(setq pos (point))
-
- (setq name-res (c-forward-name))
(setq res (not (null name-res)))
(when (eq name-res t)
;; With some keywords the name can be used without the prefix, so we
@@ -9109,21 +9181,21 @@ multi-line strings (but not C++, for example)."
(when (save-excursion
(goto-char post-prefix-pos)
(looking-at c-self-contained-typename-key))
- (c-add-type pos (save-excursion
- (c-backward-syntactic-ws)
- (point))))
+ (c-add-type id-start
+ (point)))
(when (and c-record-type-identifiers
c-last-identifier-range)
(c-record-type-id c-last-identifier-range)))
+ (c-forward-syntactic-ws)
(when (and brace-block-too
(memq res '(t nil))
(eq (char-after) ?\{)
(save-excursion
(c-safe
(progn (c-forward-sexp)
- (c-forward-syntactic-ws)
(setq pos (point))))))
(goto-char pos)
+ (c-forward-syntactic-ws)
(setq res t))
(unless res (goto-char start))) ; invalid syntax
@@ -9137,7 +9209,7 @@ multi-line strings (but not C++, for example)."
(if (looking-at c-identifier-start)
(save-excursion
(setq id-start (point)
- name-res (c-forward-name))
+ name-res (c-forward-name t))
(when name-res
(setq id-end (point)
id-range c-last-identifier-range))))
@@ -9150,8 +9222,9 @@ multi-line strings (but not C++, for example)."
(>= (save-excursion
(save-match-data
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
- (setq pos (point))))
+ pos))
id-end)
(setq res nil)))))
;; Looking at a primitive or known type identifier. We've
@@ -9169,35 +9242,41 @@ multi-line strings (but not C++, for example)."
(looking-at c-opt-type-component-key)))
;; There might be more keywords for the type.
(let (safe-pos)
- (c-forward-keyword-clause 1)
+ (c-forward-keyword-clause 1 t)
(while (progn
(setq safe-pos (point))
+ (c-forward-syntactic-ws)
(looking-at c-opt-type-component-key))
(when (and c-record-type-identifiers
(looking-at c-primitive-type-key))
(c-record-type-id (cons (match-beginning 1)
(match-end 1))))
- (c-forward-keyword-clause 1))
+ (c-forward-keyword-clause 1 t))
(if (looking-at c-primitive-type-key)
(progn
(when c-record-type-identifiers
(c-record-type-id (cons (match-beginning 1)
(match-end 1))))
- (c-forward-keyword-clause 1)
+ (c-forward-keyword-clause 1 t)
(setq res t))
(goto-char safe-pos)
- (setq res 'prefix)))
- (unless (save-match-data (c-forward-keyword-clause 1))
+ (setq res 'prefix))
+ (setq pos (point)))
+ (if (save-match-data (c-forward-keyword-clause 1 t))
+ (setq pos (point))
(if pos
(goto-char pos)
(goto-char (match-end 1))
- (c-forward-syntactic-ws)))))
+ (setq pos (point)))))
+ (c-forward-syntactic-ws))
((and (eq name-res t)
(eq res 'prefix)
(c-major-mode-is 'c-mode)
(save-excursion
(goto-char id-end)
+ (setq pos (point))
+ (c-forward-syntactic-ws)
(and (not (looking-at c-symbol-start))
(not (looking-at c-type-decl-prefix-key)))))
;; A C specifier followed by an implicit int, e.g.
@@ -9209,13 +9288,11 @@ multi-line strings (but not C++, for example)."
(cond ((eq name-res t)
;; A normal identifier.
(goto-char id-end)
+ (setq pos (point))
(if (or res c-promote-possible-types)
(progn
(when (not (eq c-promote-possible-types 'just-one))
- (c-add-type id-start (save-excursion
- (goto-char id-end)
- (c-backward-syntactic-ws)
- (point))))
+ (c-add-type id-start id-end))
(when (and c-record-type-identifiers id-range)
(c-record-type-id id-range))
(unless res
@@ -9229,6 +9306,7 @@ multi-line strings (but not C++, for example)."
((eq name-res 'template)
;; A template is sometimes a type.
(goto-char id-end)
+ (setq pos (point))
(c-forward-syntactic-ws)
(setq res
(if (eq (char-after) ?\()
@@ -9254,6 +9332,7 @@ multi-line strings (but not C++, for example)."
(when c-opt-type-modifier-key
(while (looking-at c-opt-type-modifier-key) ; e.g. "const", "volatile"
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
(setq res t)))
@@ -9264,11 +9343,13 @@ multi-line strings (but not C++, for example)."
(when c-opt-type-suffix-key ; e.g. "..."
(while (looking-at c-opt-type-suffix-key)
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)))
;; Skip any "WS" identifiers (e.g. "final" or "override" in C++)
(while (looking-at c-type-decl-suffix-ws-ids-key)
(goto-char (match-end 1))
+ (setq pos (point))
(c-forward-syntactic-ws)
(setq res t))
@@ -9292,7 +9373,8 @@ multi-line strings (but not C++, for example)."
(progn
(goto-char (match-end 1))
(c-forward-syntactic-ws)
- (setq subres (c-forward-type))))
+ (setq subres (c-forward-type nil t))
+ (setq pos (point))))
(progn
;; If either operand certainly is a type then both are, but we
@@ -9328,9 +9410,11 @@ multi-line strings (but not C++, for example)."
;; `nconc' doesn't mind that the tail of
;; `c-record-found-types' is t.
(nconc c-record-found-types
- c-record-type-identifiers))))
+ c-record-type-identifiers)))))))
- (goto-char pos))))
+ (goto-char pos)
+ (unless stop-at-end
+ (c-forward-syntactic-ws))
(when (and c-record-found-types (memq res '(known found)) id-range)
(setq c-record-found-types
@@ -9733,7 +9817,7 @@ point unchanged and return nil."
;; (e.g. "," or ";" or "}").
(let ((here (point))
id-start id-end brackets-after-id paren-depth decorated
- got-init arglist double-double-quote)
+ got-init arglist double-double-quote pos)
(or limit (setq limit (point-max)))
(if (and
(< (point) limit)
@@ -9767,6 +9851,7 @@ point unchanged and return nil."
(eq (char-after (1+ (point))) ?\"))
(setq double-double-quote t))
(goto-char (match-end 0))
+ (setq pos (point))
(c-forward-syntactic-ws limit)
(setq got-identifier t)
nil)
@@ -9779,7 +9864,10 @@ point unchanged and return nil."
;; prefix only if it specifies a member pointer.
(progn
(setq id-start (point))
- (when (c-forward-name)
+ (when (c-forward-name t)
+ (setq pos (point))
+ (c-forward-syntactic-ws limit)
+
(if (save-match-data
(looking-at "\\(::\\)"))
;; We only check for a trailing "::" and
@@ -9808,10 +9896,12 @@ point unchanged and return nil."
(setq id-start (point)))
(cond
((or got-identifier
- (c-forward-name))
- (save-excursion
- (c-backward-syntactic-ws)
- (setq id-end (point))))
+ (c-forward-name t))
+ (setq id-end
+ (or pos
+ (point)))
+ (c-forward-syntactic-ws limit)
+ t)
(accept-anon
(setq id-start nil id-end nil)
t)
@@ -10024,10 +10114,10 @@ This function might do hidden buffer changes."
;; an identifier instead.
(declare (debug nil))
`(progn
+ (setq identifier-start type-start)
,(unless short
;; These identifiers are bound only in the inner let.
'(setq identifier-type at-type
- identifier-start type-start
got-parens nil
got-identifier t
got-suffix t
@@ -10102,10 +10192,11 @@ This function might do hidden buffer changes."
;; The second element of the return value is non-nil when something
;; indicating the identifier is a type occurs in the declaration.
;; Specifically it is nil, or a three element list (A B C) where C is t
- ;; when context is '<> and the "identifier" is a found type, B is t when a
- ;; `c-typedef-kwds' ("typedef") is present, and A is t when some other
- ;; `c-typedef-decl-kwds' (e.g. class, struct, enum) specifier is present.
- ;; I.e., (some of) the declared identifier(s) are types.
+ ;; when context is '<> and the "identifier" is a found type, B is the
+ ;; position of the `c-typedef-kwds' keyword ("typedef") when such is
+ ;; present, and A is t when some other `c-typedef-decl-kwds' (e.g. class,
+ ;; struct, enum) specifier is present. I.e., (some of) the declared
+ ;; identifier(s) are types.
;;
;; The third element of the return value is non-nil when the declaration
;; parsed might be an expression. The fourth element is the position of
@@ -10173,6 +10264,9 @@ This function might do hidden buffer changes."
;; `c-decl-hangon-kwds' and their associated clauses that
;; occurs after the type.
id-start
+ ;; The earlier value of `type-start' if we've shifted the type
+ ;; backwards.
+ identifier-start
;; These store `at-type', `type-start' and `id-start' of the
;; identifier before the one in those variables. The previous
;; identifier might turn out to be the real type in a
@@ -10183,7 +10277,8 @@ This function might do hidden buffer changes."
;; Set if we've found a specifier (apart from "typedef") that makes
;; the defined identifier(s) types.
at-type-decl
- ;; Set if we've a "typedef" keyword.
+ ;; If we've a "typedef" keyword (?or similar), the buffer position of
+ ;; its first character.
at-typedef
;; Set if `context' is '<> and the identifier is definitely a type, or
;; has already been recorded as a found type.
@@ -10266,7 +10361,7 @@ This function might do hidden buffer changes."
(looking-at "@[A-Za-z0-9]+")))
(save-match-data
(if (looking-at c-typedef-key)
- (setq at-typedef t)))
+ (setq at-typedef (point))))
(setq kwd-sym (c-keyword-sym (match-string 1)))
(save-excursion
(c-forward-keyword-clause 1)
@@ -10466,6 +10561,8 @@ This function might do hidden buffer changes."
got-prefix
;; True if the declarator is surrounded by a parenthesis pair.
got-parens
+ ;; True if there is a terminated argument list.
+ got-arglist
;; True if there is an identifier in the declarator.
got-identifier
;; True if we find a number where an identifier was expected.
@@ -10486,9 +10583,9 @@ This function might do hidden buffer changes."
;; True if we've parsed the type decl to a token that is
;; known to end declarations in this context.
at-decl-end
- ;; The earlier values of `at-type' and `type-start' if we've
- ;; shifted the type backwards.
- identifier-type identifier-start
+ ;; The earlier value of `at-type' if we've shifted the type
+ ;; backwards.
+ identifier-type
;; If `c-parse-and-markup-<>-arglists' is set we need to
;; turn it off during the name skipping below to avoid
;; getting `c-type' properties that might be bogus. That
@@ -10530,6 +10627,10 @@ This function might do hidden buffer changes."
(progn (setq got-identifier nil) t)
;; It turned out to be the real identifier,
;; so stop.
+ (save-excursion
+ (c-backward-syntactic-ws)
+ (c-simple-skip-symbol-backward)
+ (setq identifier-start (point)))
nil))
t))
@@ -10554,7 +10655,11 @@ This function might do hidden buffer changes."
(or got-identifier
(and (looking-at c-identifier-start)
(setq pos (point))
- (setq got-identifier (c-forward-name))
+ (setq got-identifier (c-forward-name t))
+ (save-excursion
+ (c-simple-skip-symbol-backward)
+ (setq identifier-start (point)))
+ (progn (c-forward-syntactic-ws) t)
(setq name-start pos))
(when (looking-at "[0-9]")
(setq got-number t)) ; We probably have an arithmetic expression.
@@ -10573,7 +10678,8 @@ This function might do hidden buffer changes."
(setq at-type nil
name-start type-start
id-start type-start
- got-identifier t)))
+ got-identifier t)
+ (setq identifier-start type-start)))
;; Skip over type decl suffix operators and trailing noise macros.
(while
@@ -10604,13 +10710,17 @@ This function might do hidden buffer changes."
(when (> paren-depth 0)
(setq paren-depth (1- paren-depth))
(forward-char)
+ (when (and (not got-parens)
+ (eq paren-depth 0))
+ (setq got-arglist t))
t)
- (when (if (save-match-data (looking-at "\\s("))
- (c-safe (c-forward-sexp 1) t)
- (if (save-match-data
- (looking-at c-fun-name-substitute-key)) ; requires
- (c-forward-c++-requires-clause)
- (goto-char (match-end 1))
+ (when (cond
+ ((save-match-data (looking-at "\\s("))
+ (c-safe (c-forward-sexp 1) t))
+ ((save-match-data
+ (looking-at c-fun-name-substitute-key)) ; C++ requires
+ (c-forward-c++-requires-clause))
+ (t (goto-char (match-end 1))
t))
(when (and (not got-suffix-after-parens)
(= paren-depth 0))
@@ -10672,8 +10782,11 @@ This function might do hidden buffer changes."
(goto-char pos)
(setq pd (1- pd)))
t)))
- (c-fdoc-shift-type-backward)
- t)))
+ (c-fdoc-shift-type-backward)
+ (when (and (not got-parens)
+ (eq paren-depth 0))
+ (setq got-arglist t))
+ t)))
(c-forward-syntactic-ws))
@@ -10741,6 +10854,9 @@ This function might do hidden buffer changes."
(not (or got-prefix got-parens)))
;; Got another identifier directly after the type, so it's a
;; declaration.
+ (when (and got-arglist
+ (eq at-type 'maybe))
+ (setq unsafe-maybe t))
(throw 'at-decl-or-cast t))
(when (and got-parens
@@ -10766,8 +10882,7 @@ This function might do hidden buffer changes."
type-start
(progn
(goto-char type-start)
- (c-forward-type)
- (c-backward-syntactic-ws)
+ (c-forward-type nil t)
(point)))))))))
;; Got a declaration of the form "foo bar (gnu);" or "bar
;; (gnu);" where we've recognized "bar" as the type and "gnu"
@@ -10863,7 +10978,13 @@ This function might do hidden buffer changes."
;; types; other identifiers could just as well be
;; constants in C++.
(memq at-type '(known found)))))
- (throw 'at-decl-or-cast t)
+ (progn
+ ;; The user may be part way through typing a statement
+ ;; beginning with an identifier. This makes a 'maybe
+ ;; type in the following "declarator"'s arglist suspect.
+ (when (eq at-type 'maybe)
+ (setq unsafe-maybe t))
+ (throw 'at-decl-or-cast t))
;; CASE 7
;; Can't be a valid declaration or cast, but if we've found a
;; specifier it can't be anything else either, so treat it as
@@ -11085,8 +11206,7 @@ This function might do hidden buffer changes."
(space-after-type
(save-excursion
(goto-char type-start)
- (and (c-forward-type)
- (progn (c-backward-syntactic-ws) t)
+ (and (c-forward-type nil t)
(or (eolp)
(memq (char-after) '(?\ ?\t)))))))
(when (not (eq (not space-before-id)
@@ -11123,9 +11243,17 @@ This function might do hidden buffer changes."
;; inside an arglist that contains declarations. Update (2017-09): We
;; now recognize a top-level "foo(bar);" as a declaration in C.
;; CASE 19
- (or (eq context 'decl)
- (and (c-major-mode-is 'c-mode)
- (or (eq context 'top) make-top))))))
+ (when
+ (or (eq context 'decl)
+ (and (c-major-mode-is 'c-mode)
+ (or (eq context 'top) make-top)))
+ (when (and (eq at-type 'maybe)
+ got-parens)
+ ;; If we've got "foo d(bar () ...)", the d could be a typing
+ ;; mistake, so we don't promote the 'maybe type "bar" to a 'found
+ ;; type.
+ (setq unsafe-maybe t))
+ t))))
;; The point is now after the type decl expression.
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index d84c4f8ad8a..c220d8d8789 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -85,6 +85,8 @@
(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs only.
+(declare-function cl-set-difference "cl-seq" (cl-list1 cl-list2 &rest cl-keys))
+
;; Need to declare these local symbols during compilation since
;; they're referenced from lambdas in `byte-compile' calls that are
;; executed at compile time. They don't need to have the proper
@@ -1109,10 +1111,12 @@ casts and declarations are fontified. Used on level 2
and higher."
;; additionally, mark the commas with c-type property 'c-decl-id-start or
;; 'c-decl-type-start (according to TYPES). Stop at LIMIT.
;;
- ;; If TYPES is t, fontify all identifiers as types, if it is nil fontify as
- ;; either variables or functions, otherwise TYPES is a face to use. If
- ;; NOT-TOP is non-nil, we are not at the top-level ("top-level" includes
- ;; being directly inside a class or namespace, etc.).
+ ;; If TYPES is t, fontify all identifiers as types; if it is a number, a
+ ;; buffer position, additionally set the `c-deftype' text property on the
+ ;; keyword at that position; if it is nil fontify as either variables or
+ ;; functions, otherwise TYPES is a face to use. If NOT-TOP is non-nil, we
+ ;; are not at the top-level ("top-level" includes being directly inside a
+ ;; class or namespace, etc.).
;;
;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
;; and was introduced by, e.g. "typename" or "class", such that if there is
@@ -1129,17 +1133,28 @@ casts and declarations are fontified. Used on level 2
and higher."
;;(message "c-font-lock-declarators from %s to %s" (point) limit)
(c-fontify-types-and-refs
()
+ ;; If we're altering the declarators in a typedef, we need to scan ALL of
+ ;; them because of the way we check for changes.
+ (let ((c-do-decl-limit (if (numberp types) (point-max) limit))
+ decl-ids)
(c-do-declarators
- limit list not-top
- (cond ((eq types t) 'c-decl-type-start)
+ c-do-decl-limit
+ list not-top
+ (cond ((or (numberp types)
+ (eq types t))
+ 'c-decl-type-start)
((null types) 'c-decl-id-start))
(lambda (id-start id-end end-pos _not-top is-function init-char)
- (if (eq types t)
+ (if (or (numberp types)
+ (eq types t))
(when id-start
;; Register and fontify the identifier as a type.
(let ((c-promote-possible-types t))
(goto-char id-start)
- (c-forward-type)))
+ (c-forward-type))
+ (when (numberp types)
+ (push (buffer-substring-no-properties id-start id-end)
+ decl-ids)))
(when id-start
(goto-char id-start)
(when c-opt-identifier-prefix-key
@@ -1147,7 +1162,7 @@ casts and declarations are fontified. Used on level 2
and higher."
(eq (match-end 1) id-end))
(while (and (< (point) id-end)
(re-search-forward c-opt-identifier-prefix-key
id-end t))
- (c-forward-syntactic-ws limit))))
+ (c-forward-syntactic-ws c-do-decl-limit))))
;; Only apply the face when the text doesn't have one yet.
;; Exception: The "" in C++'s operator"" will already wrongly have
;; string face.
@@ -1164,7 +1179,7 @@ casts and declarations are fontified. Used on level 2
and higher."
(equal (buffer-substring-no-properties id-start id-end)
"\"\""))
(goto-char id-end)
- (c-forward-syntactic-ws limit)
+ (c-forward-syntactic-ws c-do-decl-limit)
(when (c-on-identifier)
(c-put-font-lock-face
(point)
@@ -1174,10 +1189,21 @@ casts and declarations are fontified. Used on level 2
and higher."
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
(goto-char end-pos)
- (c-forward-token-2 1 nil limit) ; Over "="
+ (c-forward-token-2 1 nil c-do-decl-limit) ; Over "="
(let ((c-promote-possible-types t))
(c-forward-type t)))))
accept-anon) ; Last argument to c-do-declarators.
+ ;; If we've changed types declared by a "typedef", update the `c-typedef'
+ ;; text property.
+ (when (numberp types)
+ (let* ((old-decl-ids (c-get-char-property types 'c-typedef))
+ (old-types (c--set-difference old-decl-ids decl-ids :test #'equal))
+ (new-types (c--set-difference decl-ids old-decl-ids :test
#'equal)))
+ (dolist (type old-types)
+ (c-unfind-type type))
+ ;; The new types have already been added to `c-found-types', as needed.
+ (when (or old-types new-types)
+ (c-put-char-property types 'c-typedef decl-ids)))))
nil))
(defun c-get-fontification-context (match-pos not-front-decl &optional toplev)
@@ -1433,7 +1459,10 @@ casts and declarations are fontified. Used on level 2
and higher."
(c-font-lock-declarators
(min limit (point-max))
decl-list
- (not (null (cadr decl-or-cast)))
+ (cond ((null (cadr decl-or-cast))
+ nil)
+ ((cadr (cadr decl-or-cast)))
+ (t t))
(not toplev)
template-class
(memq context '(decl <>))))
@@ -1749,12 +1778,21 @@ casts and declarations are fontified. Used on level 2
and higher."
; speeds up lisp.h tremendously.
(save-excursion
(when (not (c-back-over-member-initializers decl-search-lim))
+ (setq paren-state (c-parse-state))
(unless (or (eobp)
(looking-at "\\s(\\|\\s)"))
(forward-char))
(c-syntactic-skip-backward "^;{}" decl-search-lim t)
- (when (eq (char-before) ?})
- (c-go-list-backward) ; brace block of struct, etc.?
+ ;; Do we have the brace block of a struct, etc.?
+ (when (cond
+ ((and (consp (car paren-state))
+ (eq (char-before) ?}))
+ (goto-char (caar paren-state))
+ t)
+ ((and (numberp (car paren-state))
+ (eq (char-after (car paren-state)) ?{))
+ (goto-char (car paren-state))
+ t))
(c-syntactic-skip-backward "^;{}" decl-search-lim t))
(when (or (bobp)
(memq (char-before) '(?\; ?{ ?})))
@@ -2530,8 +2568,8 @@ higher."
(get-text-property (match-beginning 0) 'fontified)
(not (memq (c-get-char-property (match-beginning 0) 'face)
c-literal-faces)))
- (c-put-font-lock-face (match-beginning 0) (match-end 0)
- font-lock-type-face))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'fontified nil))
(dolist (win-boundary window-boundaries)
(when (and (< (match-beginning 0) (cdr win-boundary))
(> (match-end 0) (car win-boundary))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index b04ed7584c4..330202bb5f9 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -2077,6 +2077,37 @@ with // and /*, not more generic line and block
comments."
(not (eobp))))
(forward-char))))))
+(defun c-before-change-de-typedef (beg end)
+ ;; For each "typedef" starting in (BEG END), remove the defined types from
+ ;; c-found-types
+ (let (prop)
+ (save-excursion
+ (goto-char beg)
+ (while (and (< (point) end)
+ (setq prop (c-search-forward-non-nil-char-property
+ 'c-typedef)))
+ (dolist (type prop)
+ (c-unfind-type type))))))
+
+(defun c-after-change-de-typedef (beg end _old-len)
+ ;; For each former "typedef" in (BEG END), remove the defined types from
+ ;; those which are no longer typedefs.
+ (let (prop)
+ (save-excursion
+ (goto-char beg)
+ (c-backward-token-2
+ 1 nil (- (point) 20))
+ (while (and (< (point) end)
+ (setq prop (c-search-forward-non-nil-char-property
+ 'c-typedef end)))
+ (backward-char)
+ (when (or (not (looking-at c-typedef-key))
+ (<= (match-end 1) beg))
+ (dolist (type prop)
+ (c-unfind-type type))
+ (c-clear-char-property (point) 'c-typedef))
+ (forward-char)))))
+
(defun c-update-new-id (end)
;; Note the bounds of any identifier that END is in or just after, in
;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to
@@ -2086,7 +2117,9 @@ with // and /*, not more generic line and block comments."
(let ((id-beg (c-on-identifier)))
(setq c-new-id-start id-beg
c-new-id-end (and id-beg
- (progn (c-end-of-current-token) (point)))
+ (progn (goto-char id-beg)
+ (c-forward-token-2)
+ (point)))
c-new-id-is-type nil))))
(defun c-post-command ()
@@ -2215,6 +2248,10 @@ with // and /*, not more generic line and block
comments."
term-pos)
(buffer-substring-no-properties beg end)))))))
+ ;; If we're about to delete "typedef"s, clear the identifiers from
+ ;; `c-found-types'.
+ (c-before-change-de-typedef beg end)
+
(if c-get-state-before-change-functions
(mapc (lambda (fn)
(funcall fn beg end))
@@ -2306,6 +2343,7 @@ with // and /*, not more generic line and block comments."
(c-update-new-id end)
(c-trim-found-types beg end old-len) ; maybe we don't
; need all of these.
+ (c-after-change-de-typedef beg end old-len)
(c-invalidate-sws-region-after beg end old-len)
;; (c-invalidate-state-cache beg) ; moved to
;; `c-before-change'.
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 2206e0fcab6..60ed3521b8a 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -1609,8 +1609,7 @@ as a type name.")
:type 'c-extra-types-widget
:group 'c)
-(defcustom objc-font-lock-extra-types
- (list (concat "[" c-upper "]\\sw*[" c-lower "]\\sw*"))
+(defcustom objc-font-lock-extra-types nil
(c-make-font-lock-extra-types-blurb "ObjC" "objc-mode" (concat
"For example, a value of (\"[" c-upper "]\\\\sw*[" c-lower "]\\\\sw*\") means
capitalized words are treated as type names (the requirement for a
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index a31250f68be..c241a2868e5 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -194,10 +194,6 @@ the subtrees."
(t
`((,name . ,marker))))))
-;;;###autoload
-(add-to-list 'auto-mode-alist
- '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode))
-
;;;###autoload
(define-derived-mode cmake-ts-mode prog-mode "CMake"
"Major mode for editing CMake files, powered by tree-sitter."
@@ -229,6 +225,10 @@ the subtrees."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'cmake)
+ (add-to-list 'auto-mode-alist
+ '("\\(?:CMakeLists\\.txt\\|\\.cmake\\)\\'" . cmake-ts-mode)))
+
(provide 'cmake-ts-mode)
;;; cmake-ts-mode.el ends here
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 32ec7721697..063cfffe1da 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -34,7 +34,7 @@
(require 'cc-mode)
(require 'cc-langs)
(require 'treesit)
-(require 'c-ts-mode) ; For comment indenting and filling.
+(require 'c-ts-common) ; For comment indenting and filling.
(eval-when-compile
(require 'cc-fonts)
@@ -634,12 +634,17 @@ 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)
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-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)
+ ((parent-is "initializer_expression") parent-bol
csharp-ts-mode-indent-offset)
+ ((match "{" "anonymous_object_creation_expression") parent-bol 0)
+ ((parent-is "anonymous_object_creation_expression") parent-bol
csharp-ts-mode-indent-offset)
+ ((match "{" "object_creation_expression") parent-bol 0)
+ ((parent-is "object_creation_expression") parent-bol 0)
((parent-is "method_declaration") parent-bol 0)
((parent-is "enum_declaration") parent-bol 0)
((parent-is "operator_declaration") parent-bol 0)
@@ -878,9 +883,6 @@ Return nil if there is no name or if NODE is not a defun
node."
node "name")
t))))
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-mode))
-
;;;###autoload
(define-derived-mode csharp-mode prog-mode "C#"
"Major mode for editing Csharp code.
@@ -906,7 +908,7 @@ Key bindings:
(treesit-parser-create 'c-sharp)
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("comment"
@@ -941,7 +943,9 @@ Key bindings:
("Struct" "\\`struct_declaration\\'" nil nil)
("Method" "\\`method_declaration\\'" nil nil)))
- (treesit-major-mode-setup))
+ (treesit-major-mode-setup)
+
+ (add-to-list 'auto-mode-alist '("\\.cs\\'" . csharp-ts-mode)))
(provide 'csharp-mode)
diff --git a/lisp/progmodes/dockerfile-ts-mode.el
b/lisp/progmodes/dockerfile-ts-mode.el
index 3f8766e6713..23ac48a6117 100644
--- a/lisp/progmodes/dockerfile-ts-mode.el
+++ b/lisp/progmodes/dockerfile-ts-mode.el
@@ -132,12 +132,6 @@ the subtrees."
(t
`((,name . ,marker))))))
-;;;###autoload
-(add-to-list 'auto-mode-alist
- ;; NOTE: We can't use `rx' here, as it breaks bootstrap.
- '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'"
- . dockerfile-ts-mode))
-
;;;###autoload
(define-derived-mode dockerfile-ts-mode prog-mode "Dockerfile"
"Major mode for editing Dockerfiles, powered by tree-sitter."
@@ -161,6 +155,10 @@ the subtrees."
(setq-local treesit-simple-indent-rules
dockerfile-ts-mode--indent-rules)
+ ;; Navigation
+ (setq-local treesit-sentence-type-regexp
+ "instruction")
+
;; Font-lock.
(setq-local treesit-font-lock-settings
dockerfile-ts-mode--font-lock-settings)
@@ -172,6 +170,12 @@ the subtrees."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'dockerfile)
+ (add-to-list 'auto-mode-alist
+ ;; NOTE: We can't use `rx' here, as it breaks bootstrap.
+ '("\\(?:Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'"
+ . dockerfile-ts-mode)))
+
(provide 'dockerfile-ts-mode)
;;; dockerfile-ts-mode.el ends here
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 6d192d9b333..4fa886bc788 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -2,12 +2,12 @@
;; Copyright (C) 2018-2023 Free Software Foundation, Inc.
-;; Version: 1.10
+;; Version: 1.11
;; Author: João Távora <joaotavora@gmail.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; URL: https://github.com/joaotavora/eglot
;; Keywords: convenience, languages
-;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1")
(project "0.9.3") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23")
(external-completion "0.1"))
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.16") (flymake "1.2.1")
(project "0.9.3") (xref "1.4.0") (eldoc "1.11.0") (seq "2.23")
(external-completion "0.1"))
;; This is a GNU ELPA :core package. Avoid adding functionality
;; that is not available in the version of Emacs recorded above or any
@@ -182,7 +182,7 @@ chosen (interactively or automatically)."
when probe return (cons probe args)
finally (funcall err)))))))
-(defvar eglot-server-programs `(((rust-ts-mode rust-mode) .
,(eglot-alternatives '("rust-analyzer" "rls")))
+(defvar eglot-server-programs `(((rust-ts-mode rust-mode) . ("rust-analyzer"))
((cmake-mode cmake-ts-mode) .
("cmake-language-server"))
(vimrc-mode . ("vim-language-server"
"--stdio"))
((python-mode python-ts-mode)
@@ -991,6 +991,7 @@ Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If
INTERACTIVE is
non-nil, maybe prompt user, else error as soon as something can't
be guessed."
(let* ((guessed-mode (if buffer-file-name major-mode))
+ (guessed-mode-name (and guessed-mode (symbol-name guessed-mode)))
(main-mode
(cond
((and interactive
@@ -1000,7 +1001,7 @@ be guessed."
(completing-read
"[eglot] Start a server to manage buffers of what major mode? "
(mapcar #'symbol-name (eglot--all-major-modes)) nil t
- (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+ guessed-mode-name nil guessed-mode-name nil)))
((not guessed-mode)
(eglot--error "Can't guess mode to manage for `%s'"
(current-buffer)))
(t guessed-mode)))
@@ -1074,7 +1075,7 @@ suitable root directory for a given LSP server's
purposes."
;;;###autoload
(defun eglot (managed-major-mode project class contact language-id
- &optional interactive)
+ &optional _interactive)
"Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
This starts a Language Server Protocol (LSP) server suitable for the
@@ -1111,17 +1112,17 @@ described in `eglot-server-programs', which see.
LANGUAGE-ID is the language ID string to send to the server for
MANAGED-MAJOR-MODE, which matters to a minority of servers.
-INTERACTIVE is t if called interactively."
- (interactive (append (eglot--guess-contact t) '(t)))
- (setq managed-major-mode (eglot--ensure-list managed-major-mode))
- (let* ((current-server (eglot-current-server))
- (live-p (and current-server (jsonrpc-running-p current-server))))
- (if (and live-p
- interactive
- (y-or-n-p "[eglot] Live process found, reconnect instead? "))
- (eglot-reconnect current-server interactive)
- (when live-p (ignore-errors (eglot-shutdown current-server)))
- (eglot--connect managed-major-mode project class contact language-id))))
+INTERACTIVE is ignored and provided for backward compatibility."
+ (interactive
+ (let ((current-server (eglot-current-server)))
+ (unless (or (null current-server)
+ (y-or-n-p "\
+[eglot] Shut down current connection before attempting new one?"))
+ (user-error "[eglot] Connection attempt aborted by user."))
+ (prog1 (append (eglot--guess-contact t) '(t))
+ (when current-server (ignore-errors (eglot-shutdown current-server))))))
+ (eglot--connect (eglot--ensure-list managed-major-mode)
+ project class contact language-id))
(defun eglot-reconnect (server &optional interactive)
"Reconnect to SERVER.
diff --git a/lisp/progmodes/go-ts-mode.el b/lisp/progmodes/go-ts-mode.el
index 1d6a8a30db5..93a3bcc594b 100644
--- a/lisp/progmodes/go-ts-mode.el
+++ b/lisp/progmodes/go-ts-mode.el
@@ -36,8 +36,9 @@
(declare-function treesit-node-child-by-field-name "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-search-subtree "treesit.c")
-(defcustom go-ts-mode-indent-offset 4
+(defcustom go-ts-mode-indent-offset 8
"Number of spaces for each indentation step in `go-ts-mode'."
:version "29.1"
:type 'integer
@@ -77,8 +78,10 @@
((parent-is "expression_switch_statement") parent-bol 0)
((parent-is "field_declaration_list") parent-bol go-ts-mode-indent-offset)
((parent-is "import_spec_list") parent-bol go-ts-mode-indent-offset)
+ ((parent-is "interface_type") parent-bol go-ts-mode-indent-offset)
((parent-is "labeled_statement") parent-bol go-ts-mode-indent-offset)
((parent-is "literal_value") parent-bol go-ts-mode-indent-offset)
+ ((parent-is "parameter_list") parent-bol go-ts-mode-indent-offset)
((parent-is "type_spec") parent-bol go-ts-mode-indent-offset)
((parent-is "var_declaration") parent-bol go-ts-mode-indent-offset)
(no-node parent-bol 0)))
@@ -173,50 +176,16 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `go-ts-mode'.")
-(defun go-ts-mode--imenu ()
- "Return Imenu alist for the current buffer."
- (let* ((node (treesit-buffer-root-node))
- (func-tree (treesit-induce-sparse-tree
- node "function_declaration" nil 1000))
- (type-tree (treesit-induce-sparse-tree
- node "type_spec" nil 1000))
- (func-index (go-ts-mode--imenu-1 func-tree))
- (type-index (go-ts-mode--imenu-1 type-tree)))
- (append
- (when func-index `(("Function" . ,func-index)))
- (when type-index `(("Type" . ,type-index))))))
-
-(defun go-ts-mode--imenu-1 (node)
- "Helper for `go-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 #'go-ts-mode--imenu-1
- children))
- (name (when ts-node
- (treesit-node-text
- (pcase (treesit-node-type ts-node)
- ("function_declaration"
- (treesit-node-child-by-field-name ts-node "name"))
- ("type_spec"
- (treesit-node-child-by-field-name ts-node "name"))))))
- (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))))))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode))
+(defvar-keymap go-ts-mode-map
+ :doc "Keymap used in Go mode, powered by tree-sitter"
+ :parent prog-mode-map
+ "C-c C-d" #'go-ts-mode-docstring)
;;;###autoload
(define-derived-mode go-ts-mode prog-mode "Go"
- "Major mode for editing Go, powered by tree-sitter."
+ "Major mode for editing Go, powered by tree-sitter.
+
+\\{go-ts-mode-map}"
:group 'go
:syntax-table go-ts-mode--syntax-table
@@ -228,14 +197,30 @@ the subtrees."
(setq-local comment-end "")
(setq-local comment-start-skip (rx "//" (* (syntax whitespace))))
+ ;; Navigation.
+ (setq-local treesit-defun-type-regexp
+ (regexp-opt '("method_declaration"
+ "function_declaration"
+ "type_declaration")))
+ (setq-local treesit-defun-name-function #'go-ts-mode--defun-name)
+
;; Imenu.
- (setq-local imenu-create-index-function #'go-ts-mode--imenu)
- (setq-local which-func-functions nil)
+ (setq-local treesit-simple-imenu-settings
+ `(("Function" "\\`function_declaration\\'" nil nil)
+ ("Method" "\\`method_declaration\\'" nil nil)
+ ("Struct" "\\`type_declaration\\'" go-ts-mode--struct-node-p
nil)
+ ("Interface" "\\`type_declaration\\'"
go-ts-mode--interface-node-p nil)
+ ("Type" "\\`type_declaration\\'"
go-ts-mode--other-type-node-p nil)
+ ("Alias" "\\`type_declaration\\'" go-ts-mode--alias-node-p
nil)))
;; Indent.
(setq-local indent-tabs-mode t
treesit-simple-indent-rules go-ts-mode--indent-rules)
+ ;; Electric
+ (setq-local electric-indent-chars
+ (append "{}()" electric-indent-chars))
+
;; Font-lock.
(setq-local treesit-font-lock-settings go-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
@@ -247,6 +232,83 @@ the subtrees."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'go)
+ (add-to-list 'auto-mode-alist '("\\.go\\'" . go-ts-mode)))
+
+(defun go-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)
+ ("function_declaration"
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ node "name")
+ t))
+ ("method_declaration"
+ (let* ((receiver-node (treesit-node-child-by-field-name node "receiver"))
+ (type-node (treesit-search-subtree receiver-node
"type_identifier"))
+ (name-node (treesit-node-child-by-field-name node "name")))
+ (concat
+ "(" (treesit-node-text type-node) ")."
+ (treesit-node-text name-node))))
+ ("type_declaration"
+ (treesit-node-text
+ (treesit-node-child-by-field-name
+ (treesit-node-child node 0 t) "name")
+ t))))
+
+(defun go-ts-mode--interface-node-p (node)
+ "Return t if NODE is an interface."
+ (and
+ (string-equal "type_declaration" (treesit-node-type node))
+ (treesit-search-subtree node "interface_type" nil nil 2)))
+
+(defun go-ts-mode--struct-node-p (node)
+ "Return t if NODE is a struct."
+ (and
+ (string-equal "type_declaration" (treesit-node-type node))
+ (treesit-search-subtree node "struct_type" nil nil 2)))
+
+(defun go-ts-mode--alias-node-p (node)
+ "Return t if NODE is a type alias."
+ (and
+ (string-equal "type_declaration" (treesit-node-type node))
+ (treesit-search-subtree node "type_alias" nil nil 1)))
+
+(defun go-ts-mode--other-type-node-p (node)
+ "Return t if NODE is a type, other than interface, struct or alias."
+ (and
+ (string-equal "type_declaration" (treesit-node-type node))
+ (not (go-ts-mode--interface-node-p node))
+ (not (go-ts-mode--struct-node-p node))
+ (not (go-ts-mode--alias-node-p node))))
+
+(defun go-ts-mode-docstring ()
+ "Add a docstring comment for the current defun.
+The added docstring is prefilled with the defun's name. If the
+comment already exists, jump to it."
+ (interactive)
+ (when-let ((defun-node (treesit-defun-at-point)))
+ (goto-char (treesit-node-start defun-node))
+ (if (go-ts-mode--comment-on-previous-line-p)
+ ;; go to top comment line
+ (while (go-ts-mode--comment-on-previous-line-p)
+ (forward-line -1))
+ (insert "// " (treesit-defun-name defun-node))
+ (newline)
+ (backward-char))))
+
+(defun go-ts-mode--comment-on-previous-line-p ()
+ "Return t if the previous line is a comment."
+ (when-let ((point (- (pos-bol) 1))
+ ((> point 0))
+ (node (treesit-node-at point)))
+ (and
+ ;; check point is actually inside the found node
+ ;; treesit-node-at can return nodes after point
+ (<= (treesit-node-start node) point (treesit-node-end node))
+ (string-equal "comment" (treesit-node-type node)))))
+
;; go.mod support.
(defvar go-mod-ts-mode--syntax-table
@@ -318,9 +380,6 @@ what the parent of the node would be if it were a node."
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `go-mod-ts-mode'.")
-;;;###autoload
-(add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode))
-
;;;###autoload
(define-derived-mode go-mod-ts-mode prog-mode "Go Mod"
"Major mode for editing go.mod files, powered by tree-sitter."
@@ -349,6 +408,9 @@ what the parent of the node would be if it were a node."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'gomod)
+ (add-to-list 'auto-mode-alist '("/go\\.mod\\'" . go-mod-ts-mode)))
+
(provide 'go-ts-mode)
;;; go-ts-mode.el ends here
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 20692d6c8df..92e018aaec1 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -3561,8 +3561,9 @@ Treats actions as defuns."
(kill-local-variable 'gdb-define-alist)
(remove-hook 'after-save-hook #'gdb-create-define-alist t))))
-(defcustom gud-tooltip-modes '(gud-mode c-mode c++-mode fortran-mode
- python-mode)
+(defcustom gud-tooltip-modes '( gud-mode c-mode c++-mode fortran-mode
+ python-mode c-ts-mode c++-ts-mode
+ python-ts-mode)
"List of modes for which to enable GUD tooltips."
:type '(repeat (symbol :tag "Major mode"))
:group 'tooltip)
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 30893638f0d..4405ce0fe04 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -113,6 +113,7 @@
;; Various floating point types and operations are also supported but the
;; actual precision is limited by the Emacs internal floating representation,
;; which is the C data type "double" or IEEE binary64 format.
+;; C99 and GNU style variadic arguments support is completed in 2022/E.
;;; Code:
@@ -392,8 +393,10 @@ If there is a marked region from START to END it only
shows the symbols within."
(add-hook 'after-revert-hook 'hif-after-revert-function)
(defun hif-end-of-line ()
+ "Find the end-point of line concatenation."
(end-of-line)
- (while (= (logand 1 (skip-chars-backward "\\\\")) 1)
+ (while (progn (skip-chars-backward " \t" (line-beginning-position))
+ (= ?\\ (char-before)))
(end-of-line 2)))
(defun hif-merge-ifdef-region (start end)
@@ -536,10 +539,10 @@ that form should be displayed.")
;;===%%SF%% parsing (Start) ===
;;; The code that understands what ifs and ifdef in files look like.
-(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
+(defconst hif-cpp-prefix "\\(^\\|\r\\)?[ \t]*#[ \t]*")
(defconst hif-ifxdef-regexp (concat hif-cpp-prefix "if\\(n\\)?def"))
(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
-(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
+(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\((\\|\\(n?def\\)?[
\t]+\\)"))
(defconst hif-elif-regexp (concat hif-cpp-prefix "elif"))
(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
@@ -547,18 +550,23 @@ that form should be displayed.")
(concat hif-ifx-regexp "\\|" hif-elif-regexp "\\|" hif-else-regexp "\\|"
hif-endif-regexp))
(defconst hif-macro-expr-prefix-regexp
- (concat hif-cpp-prefix "\\(if\\(n?def\\)?\\|elif\\|define\\)[ \t]+"))
+ (concat hif-cpp-prefix "\\(if(\\|if\\(n?def\\)?[ \t]+\\|elif\\|define[
\t]+\\)"))
-(defconst hif-white-regexp "[ \t]*")
+(defconst hif-line-concat "\\\\[ \t]*[\n\r]")
+;; If `hif-white-regexp' is modified, `hif-tokenize' might need to be modified
+;; accordingly.
+(defconst hif-white-regexp (concat "\\(?:\\(?:[ \t]\\|/\\*.*\\*/\\)*"
+ "\\(?:" hif-line-concat "\\)?\\)*"))
(defconst hif-define-regexp (concat hif-cpp-prefix "\\(define\\|undef\\)"))
(defconst hif-id-regexp (concat "[[:alpha:]_][[:alnum:]_]*"))
+(defconst hif-etc-regexp "\\.\\.\\.")
(defconst hif-macroref-regexp
(concat hif-white-regexp "\\(" hif-id-regexp "\\)"
"\\("
"(" hif-white-regexp
"\\(" hif-id-regexp "\\)?" hif-white-regexp
"\\(" "," hif-white-regexp hif-id-regexp hif-white-regexp "\\)*"
- "\\(\\.\\.\\.\\)?" hif-white-regexp
+ "\\(" "," hif-white-regexp "\\)?" "\\(" hif-etc-regexp "\\)?"
hif-white-regexp
")"
"\\)?" ))
@@ -936,7 +944,11 @@ Assuming we've just performed a `hif-token-regexp' lookup."
(defun hif-tokenize (start end)
"Separate string between START and END into a list of tokens."
(let ((token-list nil)
- (white-regexp "[ \t]+")
+ ;; Similar to `hif-white-regexp' but keep the spaces if there are
+ (white-regexp (concat "\\(?:"
+ "\\(?:\\([ \t]+\\)\\|\\(?:/\\*.*\\*/\\)?\\)*"
+ "\\(?:" hif-line-concat "\\)?"
+ "\\)*"))
token)
(setq hif-simple-token-only t)
(with-syntax-table hide-ifdef-syntax-table
@@ -956,29 +968,31 @@ Assuming we've just performed a `hif-token-regexp'
lookup."
(forward-char 2))
((looking-at hif-string-literal-regexp)
- (setq token (substring-no-properties (match-string 1)))
+ (setq token (match-string-no-properties 1))
(goto-char (match-end 0))
(when (looking-at white-regexp)
- (add-text-properties 0 1 '(hif-space t) token)
+ (if (not (zerop (length (match-string-no-properties 1))))
+ (add-text-properties 0 1 '(hif-space t) token))
(goto-char (match-end 0)))
(push token token-list))
((looking-at hif-token-regexp)
(goto-char (match-end 0))
- (setq token (hif-strtok
- (substring-no-properties (match-string 0))))
+ (setq token (hif-strtok (match-string-no-properties 0)))
(push token token-list)
(when (looking-at white-regexp)
- ;; We can't just append a space to the token string, otherwise
- ;; `0xf0 ' ## `01' will become `0xf0 01' instead of the
expected
- ;; `0xf001', hence a standalone `hif-space' is placed instead.
- (push 'hif-space token-list)
+ (if (not (zerop (length (match-string-no-properties 1))))
+ ;; We can't just append a space to the token string,
+ ;; otherwise `0xf0 ' ## `01' will become `0xf0 01' instead
+ ;; of the expected `0xf001', hence a standalone `hif-space'
+ ;; is placed instead.
+ (push 'hif-space token-list))
(goto-char (match-end 0))))
((looking-at "\r") ; Sometimes MS-Windows user will leave CR in
(forward-char 1)) ; the source code. Let's not get stuck here.
- (t (error "Bad #if expression: %s" (buffer-string)))))))
+ (t (error "Bad preprocessor expression: %s" (buffer-string)))))))
(if (eq 'hif-space (car token-list))
(setq token-list (cdr token-list))) ;; remove trailing white space
(nreverse token-list))))
@@ -1126,7 +1140,7 @@ this is to emulate the stringification behavior of C++
preprocessor."
(and (eq (car remains) 'hif-space)
(eq (cadr remains) 'hif-lparen)
(setq remains (cdr remains)))))
- ;; No argument, no invocation
+ ;; No argument list, no invocation
tok
;; Argumented macro, get arguments and invoke it.
;; Dynamically bind `hif-token-list' and `hif-token'
@@ -1369,8 +1383,9 @@ factor : `!' factor | `~' factor | `(' exprlist `)' |
`defined(' id `)' |
(parmlist nil) ; A "token" list of parameters, will later be parsed
(parm nil))
- (while (or (not (eq (hif-nexttoken keep-space) 'hif-rparen))
- (/= nest 0))
+ (while (and (or (not (eq (hif-nexttoken keep-space) 'hif-rparen))
+ (/= nest 0))
+ hif-token)
(if (eq (car (last parm)) 'hif-comma)
(setq parm nil))
(cond
@@ -1384,6 +1399,8 @@ factor : `!' factor | `~' factor | `(' exprlist `)' |
`defined(' id `)' |
(setq parm nil)))
(push hif-token parm))
+ (if (equal parm '(hif-comma)) ;; missing the last argument
+ (setq parm '(nil)))
(push (nreverse parm) parmlist) ; Okay even if PARM is nil
(hif-nexttoken keep-space) ; Drop the `hif-rparen', get next token
(nreverse parmlist)))
@@ -1609,11 +1626,21 @@ and `+='...)."
;; no need to reassemble the list if no `##' presents
l))
-(defun hif-delimit (lis atom)
- (nconc (mapcan (lambda (l) (list l atom))
+(defun hif-delimit (lis elem)
+ (nconc (mapcan (lambda (l) (list l elem))
(butlast lis))
(last lis)))
+(defun hif-delete-nth (n lst)
+ "Non-destructively delete the nth item from a list."
+ (if (zerop n)
+ (cdr lst)
+ ;; non-destructive
+ (let* ((duplst (copy-sequence lst))
+ (node (nthcdr (1- n) duplst)))
+ (setcdr node (cddr node))
+ duplst)))
+
;; Perform token replacement:
(defun hif-macro-supply-arguments (macro-name actual-parms)
"Expand a macro call, replace ACTUAL-PARMS in the macro body."
@@ -1633,49 +1660,160 @@ and `+='...)."
;; For each actual parameter, evaluate each one and associate it
;; with an actual parameter, put it into local table and finally
;; evaluate the macro body.
- (if (setq etc (eq (car formal-parms) 'hif-etc))
+ (if (setq etc (or (eq (car formal-parms) 'hif-etc)
+ (and (eq (car formal-parms) 'hif-etc-c99) 'c99)))
;; Take care of `hif-etc' first. Prefix `hif-comma' back if needed.
(setq formal-parms (cdr formal-parms)))
(setq formal-count (length formal-parms)
actual-count (length actual-parms))
- (if (> formal-count actual-count)
- (error "Too few parameters for macro %S" macro-name)
- (if (< formal-count actual-count)
- (or etc
- (error "Too many parameters for macro %S" macro-name))))
+ ;; Fix empty arguments applied
+ (if (and (= formal-count 1)
+ (null (car formal-parms)))
+ (setq formal-parms nil
+ formal-count (1- formal-count)))
+ (if (and (= actual-count 1)
+ (or (null (car actual-parms))
+ ;; white space as the only argument
+ (equal '(hif-space) (car actual-parms))))
+ (setq actual-parms nil
+ actual-count (1- actual-count)))
+
+ ;; Basic error checking
+ (if etc
+ (if (eq etc 'c99)
+ (if (and (> formal-count 1) ; f(a,b,...)
+ (< actual-count formal-count))
+ (error "C99 variadic argument macro %S need at least %d
arguments"
+ macro-name formal-count))
+ ;; GNU style variadic argument
+ (if (and (> formal-count 1)
+ (< actual-count (1- formal-count)))
+ (error "GNU variadic argument macro %S need at least %d
arguments"
+ macro-name (1- formal-count))))
+ (if (> formal-count actual-count)
+ (error "Too few parameters for macro %S; %d instead of %d"
+ macro-name actual-count formal-count)
+ (if (< formal-count actual-count)
+ (error "Too many parameters for macro %S; %d instead of %d"
+ macro-name actual-count formal-count))))
;; Perform token replacement on the MACRO-BODY with the parameters
- (while (setq formal (pop formal-parms))
- ;; Prevent repetitive substitution, thus cannot use `subst'
- ;; for example:
- ;; #define mac(a,b) (a+b)
- ;; #define testmac mac(b,y)
- ;; testmac should expand to (b+y): replace of argument a and b
- ;; occurs simultaneously, not sequentially. If sequentially,
- ;; according to the argument order, it will become:
- ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b)
- ;; becomes (b+b)
- ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b)
- ;; becomes (y+y).
- (setq macro-body
- ;; Unlike `subst', `substitute' replace only the top level
- ;; instead of the whole tree; more importantly, it's not
- ;; destructive.
- (cl-substitute (if (and etc (null formal-parms))
- (hif-delimit actual-parms 'hif-comma)
- (car actual-parms))
- formal macro-body))
- (setq actual-parms (cdr actual-parms)))
-
- ;; Replacement completed, stringifiy and concatenate the token list.
- ;; Stringification happens must take place before flattening, otherwise
- ;; only the first token will be stringified.
- (setq macro-body
- (flatten-tree (hif-token-stringification macro-body)))
-
- ;; Token concatenation happens here, keep single 'hif-space
- (hif-keep-single (hif-token-concatenation macro-body) 'hif-space))))
+
+ ;; Every substituted argument in the macro-body must be in list form so
+ ;; that it won't again be substituted incorrectly in later iterations.
+ ;; Finally we will flatten the list to fix that.
+ (cl-loop
+ do
+ ;; Note that C99 '...' and GNU 'x...' allow empty match
+ (setq formal (pop formal-parms))
+ ;;
+ ;; Prevent repetitive substitution, thus cannot use `subst'
+ ;; for example:
+ ;; #define mac(a,b) (a+b)
+ ;; #define testmac mac(b,y)
+ ;; testmac should expand to (b+y): replace of argument a and b
+ ;; occurs simultaneously, not sequentially. If sequentially,
+ ;; according to the argument order, it will become:
+ ;; 1. formal parm #1 'a' replaced by actual parm 'b', thus (a+b)
+ ;; becomes (b+b)
+ ;; 2. formal parm #2 'b' replaced by actual parm 'y', thus (b+b)
+ ;; becomes (y+y).
+ ;; Unlike `subst', `cl-substitute' replace only the top level
+ ;; instead of the whole tree; more importantly, it's not
+ ;; destructive.
+ ;;
+ (if (not (and (null formal-parms) etc))
+ ;; One formal with one actual
+ (setq macro-body
+ (cl-substitute (car actual-parms) formal macro-body))
+ ;; `formal-parms' used up, now take care of '...'
+ (cond
+
+ ((eq etc 'c99) ; C99 __VA_ARGS__ style '...'
+ (when formal
+ (setq macro-body
+ (cl-substitute (car actual-parms) formal macro-body))
+ ;; Now the whole __VA_ARGS__ represents the whole
+ ;; remaining actual params
+ (pop actual-parms))
+ ;; Replace if __VA_ARGS__ presents:
+ ;; if yes, see if it's prefixed with ", ##" or not,
+ ;; if yes, remove the "##", then if actual-params is
+ ;; exhausted, remove the prefixed ',' as well.
+ ;; Prepare for destructive operation
+ (let ((rem-body (copy-sequence macro-body))
+ new-body va left part)
+ ;; Find each __VA_ARGS__ and remove its immediate prefixed '##'
+ ;; and comma if presents and if `formal_param' is exhausted
+ (while (setq va (cl-position '__VA_ARGS__ rem-body))
+ ;; Split REM-BODY @ __VA_ARGS__ into LEFT and right
+ (setq part nil)
+ (if (zerop va)
+ (setq left nil ; __VA_ARGS__ trimed
+ rem-body (cdr rem-body))
+ (setq left rem-body
+ rem-body (cdr (nthcdr va rem-body))) ; _V_ removed
+ (setcdr (nthcdr va left) nil) ; now _V_ be the last in LEFT
+ ;; now LEFT=(, w? ## w? _V_) rem=(W X Y) where w = white space
+ (setq left (cdr (nreverse left)))) ; left=(w? ## w? ,)
+
+ ;; Try to recognize w?##w? and remove ", ##" if found
+ ;; (remember head = __VA_ARGS__ is temporarily removed)
+ (while (and left (eq 'hif-space (car left))) ; skip whites
+ (setq part (cons 'hif-space part)
+ left (cdr left)))
+
+ (if (eq (car left) 'hif-token-concat) ; match '##'
+ (if actual-parms
+ ;; Keep everything
+ (setq part (append part (cdr left)))
+ ;; `actual-params' exhausted, delete ',' if presents
+ (while (and left (eq 'hif-space (car left))) ; skip whites
+ (setq part (cons 'hif-space part)
+ left (cdr left)))
+ (setq part
+ (append part
+ (if (eq (car left) 'hif-comma) ; match ','
+ (cdr left)
+ left))))
+ ;; No immediate '##' found
+ (setq part (append part left)))
+
+ ;; Insert __VA_ARGS__ as a list
+ (push (hif-delimit actual-parms 'hif-comma) part)
+ ;; Reverse `left' back
+ (setq left (nreverse part)
+ new-body (append new-body left)))
+
+ ;; Replacement of __VA_ARGS__ done here, add rem-body back
+ (setq macro-body (append new-body rem-body)
+ actual-parms nil)))
+
+ (etc ; GNU style '...', substitute last argument
+ (if (null actual-parms)
+ ;; Must be non-destructive otherwise the original function
+ ;; definition defined in `hide-ifdef-env' will be destroyed.
+ (setq macro-body (remove formal macro-body))
+ (setq macro-body
+ (cl-substitute (hif-delimit actual-parms 'hif-comma)
+ formal macro-body)
+ actual-parms nil)))
+
+ (t
+ (error "Interal error: impossible case."))))
+
+ (pop actual-parms)
+ while actual-parms) ; end cl-loop
+
+ ;; Replacement completed, stringifiy and concatenate the token list.
+ ;; Stringification happens must take place before flattening, otherwise
+ ;; only the first token will be stringified.
+ (setq macro-body
+ (flatten-tree (hif-token-stringification macro-body))))
+
+ ;; Token concatenation happens here, keep single 'hif-space
+ (hif-keep-single (hif-token-concatenation macro-body) 'hif-space)))
(defun hif-invoke (macro-name actual-parms)
"Invoke a macro by expanding it, reparse macro-body and finally invoke it."
@@ -1710,7 +1848,9 @@ and `+='...)."
Do this when cursor is at the beginning of `regexp' (i.e. #ifX)."
(let ((case-fold-search nil))
(save-excursion
- (re-search-forward regexp)
+ (if (re-search-forward regexp)
+ (if (= ?\( (char-before)) ;; "#if(" found
+ (goto-char (1- (point)))))
(let* ((curr-regexp (match-string 0))
(defined (string-match hif-ifxdef-regexp curr-regexp))
(negate (and defined
@@ -1724,29 +1864,48 @@ Do this when cursor is at the beginning of `regexp'
(i.e. #ifX)."
(setq tokens (list 'hif-not tokens)))
(hif-parse-exp tokens)))))
+(defun hif-is-in-comment ()
+ "Check if we're currently within a C(++) comment."
+ (or (nth 4 (syntax-ppss))
+ (looking-at "/[/*]")))
+
+(defun hif-search-ifX-regexp (hif-regexp &optional backward)
+ "Search for a valid ifX regexp defined in hideif."
+ (let ((start (point))
+ (re-search-func (if backward
+ #'re-search-backward
+ #'re-search-forward))
+ (limit (if backward (point-min) (point-max)))
+ found)
+ (while (and (setq found
+ (funcall re-search-func hif-regexp limit t))
+ (hif-is-in-comment)))
+ ;; Jump to the pattern if found
+ (if found
+ (unless backward
+ (setq found
+ (goto-char (- (point) (length (match-string 0))))))
+ (goto-char start))
+ found))
+
(defun hif-find-any-ifX ()
"Move to next #if..., or #ifndef, at point or after."
;; (message "find ifX at %d" (point))
- (prog1
- (re-search-forward hif-ifx-regexp (point-max) t)
- (beginning-of-line)))
-
+ (hif-search-ifX-regexp hif-ifx-regexp))
(defun hif-find-next-relevant ()
"Move to next #if..., #elif..., #else, or #endif, after the current line."
;; (message "hif-find-next-relevant at %d" (point))
(end-of-line)
- ;; Avoid infinite recursion by only going to line-beginning if match found
- (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
- (beginning-of-line)))
+ ;; Avoid infinite recursion by going to the pattern only if a match is found
+ (hif-search-ifX-regexp hif-ifx-else-endif-regexp))
(defun hif-find-previous-relevant ()
"Move to previous #if..., #else, or #endif, before the current line."
;; (message "hif-find-previous-relevant at %d" (point))
(beginning-of-line)
- ;; Avoid infinite recursion by only going to line-beginning if match found
- (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
- (beginning-of-line)))
+ ;; Avoid infinite recursion by going to the pattern only if a match is found
+ (hif-search-ifX-regexp hif-ifx-else-endif-regexp 't))
(defun hif-looking-at-ifX ()
@@ -1931,6 +2090,7 @@ Point is left unchanged."
((hif-looking-at-else)
(setq else (point)))
(t
+ (beginning-of-line) ; otherwise #endif line will be hidden
(setq end (point)))))
;; If found #else, look for #endif.
(when else
@@ -1940,6 +2100,7 @@ Point is left unchanged."
(hif-ifdef-to-endif))
(if (hif-looking-at-else)
(error "Found two elses in a row? Broken!"))
+ (beginning-of-line) ; otherwise #endif line will be hidden
(setq end (point))) ; (line-end-position)
(hif-make-range start end else elif))))
@@ -2085,16 +2246,20 @@ Refer to `hide-ifdef-expand-reinclusion-guard' for more
details."
(eq (car def) 'hif-define-macro))
(let ((cdef (concat "#define " name))
(parmlist (cadr def))
- s)
+ p s etc)
(setq def (caddr def))
;; parmlist
(when parmlist
(setq cdef (concat cdef "("))
- (while (car parmlist)
- (setq cdef (concat cdef (symbol-name (car parmlist))
- (if (cdr parmlist) ","))
+ (if (setq etc (or (eq (setq p (car parmlist)) 'hif-etc)
+ (and (eq p 'hif-etc-c99) 'c99)))
+ (pop parmlist))
+ (while (setq p (car parmlist))
+ (setq cdef (concat cdef (symbol-name p) (if (cdr parmlist) ","))
parmlist (cdr parmlist)))
- (setq cdef (concat cdef ")")))
+ (setq cdef (concat cdef
+ (if etc (concat (if (eq etc 'c99) ",") "..."))
+ ")")))
(setq cdef (concat cdef " "))
;; body
(while def
@@ -2221,25 +2386,38 @@ however, when this command is prefixed, it will display
the error instead."
result))))
(defun hif-parse-macro-arglist (str)
- "Parse argument list formatted as `( arg1 [ , argn] [...] )'.
+ "Parse argument list formatted as `( arg1 [ , argn] [,] [...] )'.
The `...' is also included. Return a list of the arguments, if `...' exists
the
first arg will be `hif-etc'."
(let* ((hif-simple-token-only nil) ; Dynamic binding var for `hif-tokenize'
(tokenlist
(cdr (hif-tokenize
(- (point) (length str)) (point)))) ; Remove `hif-lparen'
- etc result token)
- (while (not (eq (setq token (pop tokenlist)) 'hif-rparen))
+ etc result token prevtok prev2tok)
+ (while (not (eq (setq prev2tok prevtok
+ prevtok token
+ token (pop tokenlist)) 'hif-rparen))
(cond
((eq token 'hif-etc)
- (setq etc t))
+ ;; GNU type "..." or C99 type
+ (setq etc (if (or (null prevtok)
+ (eq prevtok 'hif-comma)
+ (and (eq prevtok 'hif-space)
+ (eq prev2tok 'hif-comma)))
+ 'c99 t)))
((eq token 'hif-comma)
- t)
+ (if etc
+ (error "Syntax error: no comma allowed after `...'.")))
(t
(push token result))))
- (if etc
- (cons 'hif-etc (nreverse result))
- (nreverse result))))
+ (setq result (nreverse result))
+ (cond
+ ((eq etc 'c99)
+ (cons 'hif-etc-c99 result))
+ ((eq etc t)
+ (cons 'hif-etc result))
+ (t
+ result))))
;; The original version of hideif evaluates the macro early and store the
;; final values for the defined macro into the symbol database (aka
@@ -2280,9 +2458,11 @@ first arg will be `hif-etc'."
(let* ((defining (string= "define" (match-string 2)))
(name (and (re-search-forward hif-macroref-regexp max t)
(match-string 1)))
- (parmlist (or (and (match-string 3) ; First arg id found
+ (parmlist (or (and (or (match-string 3) ; First arg id found
+ (match-string 6)) ; '...' found
(delq 'hif-space
- (hif-parse-macro-arglist (match-string 2))))
+ (hif-parse-macro-arglist
+ (match-string 2))))
(and (match-string 2) ; empty arglist
(list nil)))))
(if defining
@@ -2325,7 +2505,8 @@ first arg will be `hif-etc'."
(expr (and tokens
;; `hif-simple-token-only' is checked only
;; here.
- (or (and hif-simple-token-only
+ (or (and (null parmlist)
+ hif-simple-token-only
(listp tokens)
(= (length tokens) 1)
(hif-parse-exp tokens))
@@ -2354,13 +2535,22 @@ first arg will be `hif-etc'."
(save-excursion
(save-restriction
;; (mark-region min max) ;; for debugging
+ (and min (goto-char min))
(setq hif-verbose-define-count 0)
(forward-comment (point-max))
- (while (hif-find-define min max)
- (forward-comment (point-max))
- (setf min (point)))
+ (setq min (point))
+ (let ((breakloop nil))
+ (while (and (not breakloop)
+ (hif-find-define min max))
+ (forward-comment (point-max))
+ (if (and max
+ (> (point) max))
+ (setq max (point)
+ breakloop t))
+ (setq min (point))))
(if max (goto-char max)
- (goto-char (point-max))))))
+ (goto-char (point-max))
+ nil))))
(defun hide-ifdef-guts ()
"Does most of the work of `hide-ifdefs'.
@@ -2376,7 +2566,7 @@ It does not do the work that's pointless to redo on a
recursive entry."
min max)
(setq hif-__COUNTER__ 0)
(goto-char (point-min))
- (setf min (point))
+ (setq min (point))
;; Without this `condition-case' it would be easier to see which
;; operation went wrong thru the backtrace `iff' user realize
;; the underlying meaning of all hif-* operation; for example,
@@ -2384,11 +2574,11 @@ It does not do the work that's pointless to redo on a
recursive entry."
;; operation arguments would be invalid.
(condition-case err
(cl-loop do
- (setf max (hif-find-any-ifX))
- (hif-add-new-defines min max)
+ (setq max (hif-find-any-ifX))
+ (setq max (hif-add-new-defines min max))
(if max
(hif-possibly-hide expand-header))
- (setf min (point))
+ (setq min (point))
while max)
(error (error "Error: failed at line %d %S"
(line-number-at-pos) err))))))
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index 87a4e2b90f8..dbd63698770 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -29,7 +29,7 @@
(require 'treesit)
(eval-when-compile (require 'rx))
-(require 'c-ts-mode) ; For comment indent and filling.
+(require 'c-ts-common) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
@@ -69,25 +69,32 @@
(defvar java-ts-mode--indent-rules
`((java
- ((parent-is "program") parent-bol 0)
+ ((parent-is "program") point-min 0)
((node-is "}") (and parent 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)
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-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 "annotation_type_body") parent-bol java-ts-mode-indent-offset)
((parent-is "interface_body") parent-bol java-ts-mode-indent-offset)
((parent-is "constructor_body") parent-bol java-ts-mode-indent-offset)
+ ((parent-is "enum_body_declarations") parent-bol 0)
((parent-is "enum_body") parent-bol java-ts-mode-indent-offset)
((parent-is "switch_block") parent-bol java-ts-mode-indent-offset)
((parent-is "record_declaration_body") parent-bol
java-ts-mode-indent-offset)
((query "(method_declaration (block _ @indent))") parent-bol
java-ts-mode-indent-offset)
((query "(method_declaration (block (_) @indent))") parent-bol
java-ts-mode-indent-offset)
+ ((parent-is "local_variable_declaration") parent-bol
java-ts-mode-indent-offset)
+ ((parent-is "expression_statement") parent-bol java-ts-mode-indent-offset)
+ ((parent-is "field_declaration") parent-bol java-ts-mode-indent-offset)
+ ((parent-is "return_statement") parent-bol java-ts-mode-indent-offset)
((parent-is "variable_declarator") parent-bol java-ts-mode-indent-offset)
((parent-is "method_invocation") parent-bol java-ts-mode-indent-offset)
((parent-is "switch_rule") parent-bol java-ts-mode-indent-offset)
+ ((parent-is "switch_label") parent-bol java-ts-mode-indent-offset)
((parent-is "ternary_expression") parent-bol java-ts-mode-indent-offset)
((parent-is "lambda_expression") parent-bol java-ts-mode-indent-offset)
((parent-is "element_value_array_initializer") parent-bol
java-ts-mode-indent-offset)
@@ -122,7 +129,8 @@
"provides" "public" "requires" "return" "sealed"
"static" "strictfp" "switch" "synchronized"
"throw" "throws" "to" "transient" "transitive"
- "try" "uses" "volatile" "while" "with" "record")
+ "try" "uses" "volatile" "while" "with" "record"
+ "@interface")
"Java keywords for tree-sitter font-locking.")
(defvar java-ts-mode--operators
@@ -183,7 +191,10 @@
:language 'java
:override t
:feature 'type
- '((interface_declaration
+ '((annotation_type_declaration
+ name: (identifier) @font-lock-type-face)
+
+ (interface_declaration
name: (identifier) @font-lock-type-face)
(class_declaration
@@ -217,7 +228,10 @@
:language 'java
:override t
:feature 'definition
- `((method_declaration
+ `((annotation_type_element_declaration
+ name: (identifier) @font-lock-function-name-face)
+
+ (method_declaration
name: (identifier) @font-lock-function-name-face)
(variable_declarator
@@ -281,7 +295,7 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-parser-create 'java)
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-text-type-regexp
(regexp-opt '("line_comment"
@@ -304,9 +318,33 @@ Return nil if there is no name or if NODE is not a defun
node."
"enum_declaration"
"import_declaration"
"package_declaration"
- "module_declaration")))
+ "module_declaration"
+ "constructor_declaration")))
(setq-local treesit-defun-name-function #'java-ts-mode--defun-name)
+ (setq-local treesit-sentence-type-regexp
+ (regexp-opt '("statement"
+ "local_variable_declaration"
+ "field_declaration"
+ "module_declaration"
+ "package_declaration"
+ "import_declaration")))
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt '("annotation"
+ "parenthesized_expression"
+ "argument_list"
+ "identifier"
+ "modifiers"
+ "block"
+ "body"
+ "literal"
+ "access"
+ "reference"
+ "_type"
+ "true"
+ "false")))
+
;; Font-lock.
(setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
@@ -323,6 +361,9 @@ Return nil if there is no name or if NODE is not a defun
node."
("Method" "\\`method_declaration\\'" nil nil)))
(treesit-major-mode-setup))
+(if (treesit-ready-p 'java)
+ (add-to-list 'auto-mode-alist '("\\.java\\'" . java-ts-mode)))
+
(provide 'java-ts-mode)
;;; java-ts-mode.el ends here
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index 881f4a83b17..dca93c856fc 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -54,7 +54,7 @@
(require 'json)
(require 'prog-mode)
(require 'treesit)
-(require 'c-ts-mode) ; For comment indent and filling.
+(require 'c-ts-common) ; For comment indent and filling.
(eval-when-compile
(require 'cl-lib)
@@ -3428,8 +3428,8 @@ 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)
- ((and (parent-is "comment") c-ts-mode--looking-at-star)
- c-ts-mode--comment-start-after-first-star -1)
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-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)
@@ -3454,13 +3454,16 @@ This function is intended for use in
`after-change-functions'."
((parent-is "statement_block") parent-bol js-indent-level)
;; JSX
- ((node-is "jsx_fragment") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_element") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_expression") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_self_closing_element") parent
typescript-ts-mode-indent-offset)
+ ((match "<" "jsx_fragment") parent 0)
+ ((parent-is "jsx_fragment") parent js-indent-level)
((node-is "jsx_closing_element") parent 0)
- ((node-is "/") parent 0)
- ((node-is ">") parent 0)))))
+ ((node-is "jsx_element") parent js-indent-level)
+ ((parent-is "jsx_element") parent js-indent-level)
+ ((parent-is "jsx_opening_element") parent js-indent-level)
+ ((parent-is "jsx_expression") parent-bol js-indent-level)
+ ((match "/" "jsx_self_closing_element") parent 0)
+ ((parent-is "jsx_self_closing_element") parent js-indent-level)
+ (no-node parent-bol 0)))))
(defvar js--treesit-keywords
'("as" "async" "await" "break" "case" "catch" "class" "const" "continue"
@@ -3542,7 +3545,10 @@ This function is intended for use in
`after-change-functions'."
(identifier)
(identifier)
@font-lock-function-name-face)
- value: (array (number) (function))))
+ value: (array (number) (function)))
+ (import_clause (identifier) @font-lock-variable-name-face)
+ (import_clause (named_imports (import_specifier (identifier))
+ @font-lock-variable-name-face)))
:language 'javascript
:feature 'property
@@ -3786,6 +3792,54 @@ Currently there are `js-mode' and `js-ts-mode'."
;;(syntax-propertize (point-max))
)
+(defvar js--treesit-sentence-nodes
+ '("import_statement"
+ "debugger_statement"
+ "expression_statement"
+ "if_statement"
+ "switch_statement"
+ "for_statement"
+ "for_in_statement"
+ "while_statement"
+ "do_statement"
+ "try_statement"
+ "with_statement"
+ "break_statement"
+ "continue_statement"
+ "return_statement"
+ "throw_statement"
+ "empty_statement"
+ "labeled_statement"
+ "variable_declaration"
+ "lexical_declaration"
+ "jsx_element"
+ "jsx_self_closing_element")
+ "Nodes that designate sentences in JavaScript.
+See `treesit-sentence-type-regexp' for more information.")
+
+(defvar js--treesit-sexp-nodes
+ '("expression"
+ "pattern"
+ "array"
+ "function"
+ "string"
+ "escape"
+ "template"
+ "regex"
+ "number"
+ "identifier"
+ "this"
+ "super"
+ "true"
+ "false"
+ "null"
+ "undefined"
+ "arguments"
+ "pair"
+ "jsx")
+ "Nodes that designate sexps in JavaScript.
+See `treesit-sexp-type-regexp' for more information.")
+
;;;###autoload
(define-derived-mode js-ts-mode js-base-mode "JavaScript"
"Major mode for editing JavaScript.
@@ -3800,7 +3854,7 @@ Currently there are `js-mode' and `js-ts-mode'."
;; Which-func.
(setq-local which-func-imenu-joiner-function #'js--which-func-joiner)
;; Comment.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local comment-multi-line t)
(setq-local treesit-text-type-regexp
@@ -3825,6 +3879,13 @@ Currently there are `js-mode' and `js-ts-mode'."
"function_declaration"
"lexical_declaration")))
(setq-local treesit-defun-name-function #'js--treesit-defun-name)
+
+ (setq-local treesit-sentence-type-regexp
+ (regexp-opt js--treesit-sentence-nodes))
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt js--treesit-sexp-nodes))
+
;; Fontification.
(setq-local treesit-font-lock-settings js--treesit-font-lock-settings)
(setq-local treesit-font-lock-feature-list
@@ -3842,7 +3903,10 @@ Currently there are `js-mode' and `js-ts-mode'."
"method_definition")
eos)
nil nil)))
- (treesit-major-mode-setup)))
+ (treesit-major-mode-setup)
+
+ (add-to-list 'auto-mode-alist
+ '("\\(\\.js[mx]\\|\\.har\\)\\'" . js-ts-mode))))
;;;###autoload
(define-derived-mode js-json-mode js-mode "JSON"
diff --git a/lisp/progmodes/json-ts-mode.el b/lisp/progmodes/json-ts-mode.el
index fbcda22acca..6bd9d30328e 100644
--- a/lisp/progmodes/json-ts-mode.el
+++ b/lisp/progmodes/json-ts-mode.el
@@ -147,6 +147,8 @@ Return nil if there is no name or if NODE is not a defun
node."
(rx (or "pair" "object")))
(setq-local treesit-defun-name-function #'json-ts-mode--defun-name)
+ (setq-local treesit-sentence-type-regexp "pair")
+
;; Font-lock.
(setq-local treesit-font-lock-settings json-ts-mode--font-lock-settings)
(setq-local treesit-font-lock-feature-list
@@ -160,6 +162,10 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-major-mode-setup))
+(if (treesit-ready-p 'json)
+ (add-to-list 'auto-mode-alist
+ '("\\.json\\'" . json-ts-mode)))
+
(provide 'json-ts-mode)
;;; json-ts-mode.el ends here
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 730998727ce..59270070484 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2023 Free Software Foundation, Inc.
-;; Version: 0.9.3
+;; Version: 0.9.5
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -514,11 +514,14 @@ project backend implementation of
`project-external-roots'.")
(lambda (b) (assoc-default b backend-markers-alist))
vc-handled-backends)))
(marker-re
- (mapconcat
- (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m)))
- (append backend-markers
- (project--value-in-dir 'project-vc-extra-root-markers
dir))
- "\\|"))
+ (concat
+ "\\`"
+ (mapconcat
+ (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m)))
+ (append backend-markers
+ (project--value-in-dir 'project-vc-extra-root-markers
dir))
+ "\\|")
+ "\\'"))
(locate-dominating-stop-dir-regexp
(or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp))
last-matches
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 59164d7d50c..a869cdc5fdb 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -1067,11 +1067,28 @@ fontified."
"expression_statement"))
'font-lock-doc-face
'font-lock-string-face)))
- (when (eq (char-after string-beg) ?f)
- (cl-incf string-beg))
+ ;; Don't highlight string prefixes like f/r/b.
+ (save-excursion
+ (goto-char string-beg)
+ (when (search-forward "\"" string-end t)
+ (setq string-beg (match-beginning 0))))
(treesit-fontify-with-override
string-beg string-end face override start end)))
+(defun python--treesit-fontify-string-interpolation
+ (node _ start end &rest _)
+ "Fontify string interpolation.
+NODE is the string node. Do not fontify the initial f for
+f-strings. START and END mark the region to be
+fontified."
+ ;; This is kind of a hack, it basically removes the face applied by
+ ;; the string feature, so that following features can apply their
+ ;; face.
+ (let ((n-start (treesit-node-start node))
+ (n-end (treesit-node-end node)))
+ (remove-text-properties
+ (max start n-start) (min end n-end) '(face))))
+
(defvar python--treesit-settings
(treesit-font-lock-rules
:feature 'comment
@@ -1082,10 +1099,12 @@ fontified."
:language 'python
'((string) @python--treesit-fontify-string)
+ ;; HACK: This feature must come after the string feature and before
+ ;; other features. Maybe we should make string-interpolation an
+ ;; option rather than a feature.
:feature 'string-interpolation
:language 'python
- :override t
- '((interpolation (identifier) @font-lock-variable-name-face))
+ '((interpolation) @python--treesit-fontify-string-interpolation)
:feature 'definition
:language 'python
@@ -3766,15 +3785,16 @@ the python shell:
(line-beginning-position)
start))))
(substring (buffer-substring-no-properties start end))
- (starts-at-point-min-p (save-restriction
- (widen)
- (= (point-min) start)))
+ (starts-at-first-line-p (save-restriction
+ (widen)
+ (goto-char start)
+ (= (line-number-at-pos) 1)))
(encoding (python-info-encoding))
(toplevel-p (zerop (save-excursion
(goto-char start)
(python-util-forward-comment 1)
(current-indentation))))
- (fillstr (cond (starts-at-point-min-p
+ (fillstr (cond (starts-at-first-line-p
nil)
((not no-cookie)
(concat
@@ -6693,7 +6713,10 @@ implementations: `python-mode' and `python-ts-mode'."
(treesit-major-mode-setup)
(when python-indent-guess-indent-offset
- (python-indent-guess-indent-offset))))
+ (python-indent-guess-indent-offset))
+
+ (add-to-list 'auto-mode-alist
+ '("\\.py[iw]?\\'\\|python[0-9.]*" . python-ts-mode))))
;;; Completion predicates for M-x
;; Commands that only make sense when editing Python code
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 2e8d335f151..dba9ff0a846 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -141,6 +141,81 @@ This should only be called after matching against
`ruby-here-doc-beg-re'."
It should match the part after \"def\" and until \"=\".")
+(defconst ruby-builtin-methods-with-reqs
+ '( ;; built-in methods on Kernel
+ "at_exit"
+ "autoload"
+ "autoload?"
+ "callcc"
+ "catch"
+ "eval"
+ "exec"
+ "format"
+ "lambda"
+ "load"
+ "loop"
+ "open"
+ "p"
+ "printf"
+ "proc"
+ "putc"
+ "require"
+ "require_relative"
+ "spawn"
+ "sprintf"
+ "syscall"
+ "system"
+ "throw"
+ "trace_var"
+ "trap"
+ "untrace_var"
+ "warn"
+ ;; keyword-like private methods on Module
+ "alias_method"
+ "attr"
+ "attr_accessor"
+ "attr_reader"
+ "attr_writer"
+ "define_method"
+ "extend"
+ "include"
+ "module_function"
+ "prepend"
+ "private_class_method"
+ "private_constant"
+ "public_class_method"
+ "public_constant"
+ "refine"
+ "using")
+ "List of built-in methods that require at least one argument.")
+
+(defconst ruby-builtin-methods-no-reqs
+ '("__callee__"
+ "__dir__"
+ "__method__"
+ "abort"
+ "binding"
+ "block_given?"
+ "caller"
+ "exit"
+ "exit!"
+ "fail"
+ "fork"
+ "global_variables"
+ "local_variables"
+ "print"
+ "private"
+ "protected"
+ "public"
+ "puts"
+ "raise"
+ "rand"
+ "readline"
+ "readlines"
+ "sleep"
+ "srand")
+ "List of built-in methods that only have optional arguments.")
+
(defvar ruby-use-smie t)
(make-obsolete-variable 'ruby-use-smie nil "28.1")
@@ -261,7 +336,15 @@ Only has effect when `ruby-use-smie' is t."
"If non-nil, align chained method calls.
Each method call on a separate line will be aligned to the column
-of its parent.
+of its parent. Example:
+
+ my_array.select { |str| str.size > 5 }
+ .map { |str| str.downcase }
+
+When nil, each method call is indented with the usual offset:
+
+ my_array.select { |str| str.size > 5 }
+ .map { |str| str.downcase }
Only has effect when `ruby-use-smie' is t."
:type 'boolean
@@ -271,12 +354,26 @@ Only has effect when `ruby-use-smie' is t."
(defcustom ruby-method-params-indent t
"Indentation of multiline method parameters.
-When t, the parameters list is indented to the method name.
+When t, the parameters list is indented to the method name:
+
+ def foo(
+ baz,
+ bar
+ )
+ hello
+ end
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.
+The value nil means the same as 0:
+
+ def foo(
+ baz,
+ bar
+ )
+ hello
+ end
Only has effect when `ruby-use-smie' is t."
:type '(choice (const :tag "Indent to the method name" t)
@@ -1927,7 +2024,7 @@ If the result is do-end block, it will always be
multiline."
(end-of-line)
(unless
(if (and (re-search-backward "\\(?:[^#]\\)\\({\\)\\|\\(\\_<do\\_>\\)")
- (progn
+ (let ((ruby-use-smie (and ruby-use-smie (consp
smie-grammar))))
(goto-char (or (match-beginning 1) (match-beginning 2)))
(setq beg (point))
(with-suppressed-warnings ((obsolete ruby-forward-sexp))
@@ -2292,84 +2389,13 @@ It will be properly highlighted even when the call
omits parens.")
;; Core methods that have required arguments.
(,(concat
ruby-font-lock-keyword-beg-re
- (regexp-opt
- '( ;; built-in methods on Kernel
- "at_exit"
- "autoload"
- "autoload?"
- "callcc"
- "catch"
- "eval"
- "exec"
- "format"
- "lambda"
- "load"
- "loop"
- "open"
- "p"
- "printf"
- "proc"
- "putc"
- "require"
- "require_relative"
- "spawn"
- "sprintf"
- "syscall"
- "system"
- "throw"
- "trace_var"
- "trap"
- "untrace_var"
- "warn"
- ;; keyword-like private methods on Module
- "alias_method"
- "attr"
- "attr_accessor"
- "attr_reader"
- "attr_writer"
- "define_method"
- "extend"
- "include"
- "module_function"
- "prepend"
- "private_class_method"
- "private_constant"
- "public_class_method"
- "public_constant"
- "refine"
- "using")
- 'symbols))
+ (regexp-opt ruby-builtin-methods-with-reqs 'symbols))
(1 (unless (looking-at " *\\(?:[]|,.)}=]\\|$\\)")
font-lock-builtin-face)))
;; Kernel methods that have no required arguments.
(,(concat
ruby-font-lock-keyword-beg-re
- (regexp-opt
- '("__callee__"
- "__dir__"
- "__method__"
- "abort"
- "binding"
- "block_given?"
- "caller"
- "exit"
- "exit!"
- "fail"
- "fork"
- "global_variables"
- "local_variables"
- "print"
- "private"
- "protected"
- "public"
- "puts"
- "raise"
- "rand"
- "readline"
- "readlines"
- "sleep"
- "srand")
- 'symbols))
+ (regexp-opt ruby-builtin-methods-no-reqs 'symbols))
(1 font-lock-builtin-face))
;; Here-doc beginnings.
(,ruby-here-doc-beg-re
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index 5f5de500435..1144caf79b6 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -5,6 +5,7 @@
;; Author: Perry Smith <pedz@easesoftware.com>
;; Created: December 2022
;; Keywords: ruby languages tree-sitter
+;; Version: 0.2
;; This file is part of GNU Emacs.
@@ -50,11 +51,11 @@
;; Currently tree treesit-font-lock-feature-list is set with the
;; following levels:
-;; 1: comment method-definition
+;; 1: comment method-definition parameter-definition
;; 2: keyword regexp string type
-;; 3: builtin-variable builtin-constant constant
+;; 3: builtin-variable builtin-constant builtin-function
;; delimiter escape-sequence
-;; global instance
+;; constant global instance
;; interpolation literal symbol assignment
;; 4: bracket error function operator punctuation
@@ -71,6 +72,8 @@
;; ruby-ts-mode tries to adhere to the indentation related user
;; options from ruby-mode, such as ruby-indent-level,
;; ruby-indent-tabs-mode, and so on.
+;;
+;; Type 'M-x customize-group RET ruby RET' to see the options.
;; * IMenu
;; * Navigation
@@ -82,6 +85,16 @@
(require 'ruby-mode)
(declare-function treesit-parser-create "treesit.c")
+(declare-function treesit-induce-sparse-tree "treesit.c")
+(declare-function treesit-node-child-by-field-name "treesit.c")
+(declare-function treesit-search-subtree "treesit.c")
+(declare-function treesit-node-parent "treesit.c")
+(declare-function treesit-node-next-sibling "treesit.c")
+(declare-function treesit-node-type "treesit.c")
+(declare-function treesit-node-child "treesit.c")
+(declare-function treesit-node-end "treesit.c")
+(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-string "treesit.c")
(defgroup ruby-ts nil
"Major mode for editing Ruby code."
@@ -104,21 +117,30 @@
"Ruby's punctuation characters.")
(defvar ruby-ts--predefined-constants
- (rx (or "ARGF" "ARGV" "DATA" "ENV" "RUBY_COPYRIGHT"
+ (rx string-start
+ (or "ARGF" "ARGV" "DATA" "ENV" "RUBY_COPYRIGHT"
"RUBY_DESCRIPTION" "RUBY_ENGINE" "RUBY_ENGINE_VERSION"
"RUBY_PATCHLEVEL" "RUBY_PLATFORM" "RUBY_RELEASE_DATE"
"RUBY_REVISION" "RUBY_VERSION" "STDERR" "STDIN" "STDOUT"
- "TOPLEVEL_BINDING"))
+ "TOPLEVEL_BINDING")
+ string-end)
"Ruby predefined global constants.")
(defvar ruby-ts--predefined-variables
- (rx (or "$!" "$@" "$~" "$&" "$‘" "$‘" "$+" "$=" "$/" "$\\" "$," "$;"
+ (rx string-start
+ (or "$!" "$@" "$~" "$&" "$`" "$'" "$+" "$=" "$/" "$\\" "$," "$;"
"$." "$<" "$>" "$_" "$*" "$$" "$?" "$:" "$LOAD_PATH"
"$LOADED_FEATURES" "$DEBUG" "$FILENAME" "$stderr" "$stdin"
"$stdout" "$VERBOSE" "$-a" "$-i" "$-l" "$-p"
- (seq "$" (+ digit))))
+ "$0" "$1" "$2" "$3" "$4" "$5" "$6" "$7" "$8" "$9")
+ string-end)
"Ruby predefined global variables.")
+(defvar ruby-ts--builtin-methods
+ (format "\\`%s\\'" (regexp-opt (append ruby-builtin-methods-no-reqs
+ ruby-builtin-methods-with-reqs)))
+ "Ruby built-in methods.")
+
(defconst ruby-ts--class-or-module-regex
(rx string-start
(or "class" "module" "singleton_class")
@@ -142,7 +164,6 @@
"then"
"ensure"
"body_statement"
- "parenthesized_statements"
"interpolation")
string-end)
"Regular expression of the nodes that can contain statements.")
@@ -188,6 +209,9 @@ values of OVERRIDE"
(treesit-fontify-with-override (max plus-1 start) (min node-end end)
font-lock-comment-face override)))
+(defun ruby-ts--builtin-method-p (node)
+ (string-match-p ruby-ts--builtin-methods (treesit-node-text node t)))
+
(defun ruby-ts--font-lock-settings (language)
"Tree-sitter font-lock settings for Ruby."
(treesit-font-lock-rules
@@ -211,9 +235,9 @@ values of OVERRIDE"
:language language
:feature 'constant
- '((true) @font-lock-doc-markup-face
- (false) @font-lock-doc-markup-face
- (nil) @font-lock-doc-markup-face)
+ '((true) @font-lock-constant-face
+ (false) @font-lock-constant-face
+ (nil) @font-lock-constant-face)
;; Before 'operator so (unary) works.
:language language
@@ -304,10 +328,20 @@ values of OVERRIDE"
(array_pattern
(identifier) @font-lock-variable-name-face)
(keyword_pattern
- key: (hash_key_symbol) @font-lock-variable-name-face)
+ value: (identifier) @font-lock-variable-name-face)
+ (keyword_pattern
+ key: (hash_key_symbol) @font-lock-variable-name-face
+ !value)
+ (as_pattern
+ name: (identifier) @font-lock-variable-name-face)
(in_clause
pattern: (identifier) @font-lock-variable-name-face))
+ :language language
+ :feature 'builtin-function
+ `((((identifier) @font-lock-builtin-face)
+ (:pred ruby-ts--builtin-method-p @font-lock-builtin-face)))
+
;; Yuan recommends also putting method definitions into the
;; 'function' category (thus keeping it in both). I've opted to
;; just use separate categories for them -- dgutov.
@@ -497,10 +531,6 @@ array or hash."
(first-child (ruby-ts--first-non-comment-child parent)))
(= (ruby-ts--lineno open-brace) (ruby-ts--lineno first-child))))
-(defun ruby-ts--assignment-ancestor (node &rest _)
- "Return the assignment ancestor of NODE if any."
- (treesit-parent-until node (ruby-ts--type-pred "\\`assignment\\'")))
-
(defun ruby-ts--statement-ancestor (node &rest _)
"Return the statement ancestor of NODE if any.
A statement is defined as a child of a statement container where
@@ -516,26 +546,6 @@ a statement container is a node that matches
parent (treesit-node-parent parent)))
statement))
-(defun ruby-ts--is-in-condition (node &rest _)
- "Return the condition node if NODE is within a condition."
- (while (and node
- (not (equal "condition" (treesit-node-field-name node)))
- (not (string-match-p ruby-ts--statement-container-regexp
- (treesit-node-type node))))
- (setq node (treesit-node-parent node)))
- (and (equal "condition" (treesit-node-field-name node)) node))
-
-(defun ruby-ts--endless-method (node &rest _)
- "Return the expression node if NODE is in an endless method.
-i.e. expr of def foo(args) = expr is returned."
- (let* ((method node))
- (while (and method
- (not (string-match-p ruby-ts--method-regex (treesit-node-type
method))))
- (setq method (treesit-node-parent method)))
- (when method
- (if (equal "=" (treesit-node-type (treesit-node-child method 3 nil)))
- (treesit-node-child method 4 nil)))))
-
;;
;; end of functions that can be used for queries
;;
@@ -545,7 +555,7 @@ i.e. expr of def foo(args) = expr is returned."
(let ((common
`(
;; Slam all top level nodes to the left margin
- ((parent-is "program") parent 0)
+ ((parent-is "program") point-min 0)
;; Do not indent here docs or the end. Not sure why it
;; takes the grand-parent but ok fine.
@@ -556,6 +566,12 @@ i.e. expr of def foo(args) = expr is returned."
((n-p-gp nil nil "regex") no-indent 0)
((parent-is "regex") no-indent 0)
+ ;; Incomplete buffer state, better not reindent (bug#61017).
+ ((and (parent-is "ERROR")
+ (or (node-is ,ruby-ts--class-or-module-regex)
+ (node-is "\\`def\\'")))
+ no-indent 0)
+
;; if then else elseif notes:
;;
;; 1. The "then" starts at the end of the line that ends
@@ -572,11 +588,11 @@ i.e. expr of def foo(args) = expr is returned."
;;
;; I'm using very restrictive patterns hoping to reduce rules
;; triggering unintentionally.
- ((match "else" "if")
+ ((match "else" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--parent-node) 0)
((match "elsif" "if")
(ruby-ts--align-keywords ruby-ts--parent-node) 0)
- ((match "end" "if")
+ ((match "end" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--parent-node) 0)
((n-p-gp nil "then\\|else\\|elsif" "if\\|unless")
(ruby-ts--align-keywords ruby-ts--grand-parent-node)
ruby-indent-level)
@@ -649,11 +665,15 @@ i.e. expr of def foo(args) = expr is returned."
;; else the second query aligns
;; `ruby-indent-level' spaces in from the parent.
((and ruby-ts--align-chain-p (match "\\." "call"))
ruby-ts--align-chain 0)
+ ;; Obery ruby-method-call-indent, whether the dot is on
+ ;; this line or the previous line.
+ ((and (not ruby-ts--method-call-indent-p)
+ (or
+ (match "\\." "call")
+ (query "(call \".\" (identifier) @indent)")))
+ (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level)
((match "\\." "call") parent ruby-indent-level)
- ;; ruby-indent-after-block-in-continued-expression
- ((match "begin" "assignment") parent ruby-indent-level)
-
;; method parameters -- four styles:
;; 1) With paren, first arg on same line:
((and (query "(method_parameters \"(\" _ @indent)")
@@ -682,31 +702,36 @@ i.e. expr of def foo(args) = expr is returned."
;; 2) With paren, 1st arg on next line
((and (query "(argument_list \"(\" _ @indent)")
(node-is ")"))
- (ruby-ts--bol ruby-ts--grand-parent-node) 0)
- ((query "(argument_list \"(\" _ @indent)")
- (ruby-ts--bol ruby-ts--grand-parent-node) ruby-indent-level)
+ ruby-ts--parent-call-or-bol 0)
+ ((or (query "(argument_list \"(\" _ @indent)")
+ ;; No arguments yet; NODE is nil in that case.
+ (match "\\`\\'" "argument_list"))
+ ruby-ts--parent-call-or-bol ruby-indent-level)
;; 3) No paren, ruby-parenless-call-arguments-indent is t
((and ruby-ts--parenless-call-arguments-indent-p (parent-is
"argument_list"))
first-sibling 0)
;; 4) No paren, ruby-parenless-call-arguments-indent is nil
- ((parent-is "argument_list") (ruby-ts--bol
ruby-ts--grand-parent-node) ruby-indent-level)
+ ((parent-is "argument_list")
+ (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level)
;; Old... probably too simple
((parent-is "block_parameters") first-sibling 1)
- ((and (parent-is "binary")
- (or ruby-ts--assignment-ancestor
- ruby-ts--is-in-condition
- ruby-ts--endless-method))
- first-sibling 0)
+ ((and (not ruby-ts--after-op-indent-p)
+ (parent-is "binary\\|conditional"))
+ (ruby-ts--bol ruby-ts--statement-ancestor) ruby-indent-level)
+
+ ((parent-is "binary")
+ ruby-ts--binary-indent-anchor 0)
+
+ ((parent-is "conditional") parent ruby-indent-level)
;; ruby-mode does not touch these...
((match "bare_string" "string_array") no-indent 0)
- ;; hash and array other than assignments. Note that the
- ;; first sibling is the "{" or "[". There is a special
- ;; case where the hash is an argument to a method. These
- ;; need to be processed first.
+ ;; hash and array. Note that the first sibling is the "{"
+ ;; or "[". There is a special case where the hash is an
+ ;; argument to a method. These need to be processed first.
((and ruby-ts--same-line-hash-array-p (match "}" "hash"))
first-sibling 0)
@@ -717,37 +742,15 @@ i.e. expr of def foo(args) = expr is returned."
((and ruby-ts--same-line-hash-array-p (parent-is "array"))
(nth-sibling 0 ruby-ts--true) 0)
- ;; NOTE to folks trying to understand my insanity...
- ;; I having trouble understanding the "logic" of why things
- ;; are indented like they are so I am adding special cases
- ;; hoping at some point I will be struck by lightning.
- ((and (n-p-gp "}" "hash" "pair")
- (not ruby-ts--same-line-hash-array-p))
- grand-parent 0)
- ((and (n-p-gp "pair" "hash" "pair")
- (not ruby-ts--same-line-hash-array-p))
- grand-parent ruby-indent-level)
- ((and (n-p-gp "}" "hash" "method")
- (not ruby-ts--same-line-hash-array-p))
- grand-parent 0)
- ((and (n-p-gp "pair" "hash" "method")
- (not ruby-ts--same-line-hash-array-p))
- grand-parent ruby-indent-level)
-
- ((n-p-gp "}" "hash" "assignment") (ruby-ts--bol
ruby-ts--grand-parent-node) 0)
- ((n-p-gp nil "hash" "assignment") (ruby-ts--bol
ruby-ts--grand-parent-node) ruby-indent-level)
- ((n-p-gp "]" "array" "assignment") (ruby-ts--bol
ruby-ts--grand-parent-node) 0)
- ((n-p-gp nil "array" "assignment") (ruby-ts--bol
ruby-ts--grand-parent-node) ruby-indent-level)
-
- ((n-p-gp "}" "hash" "argument_list") first-sibling 0)
- ((n-p-gp nil "hash" "argument_list") first-sibling
ruby-indent-level)
- ((n-p-gp "]" "array" "argument_list") first-sibling 0)
- ((n-p-gp nil "array" "argument_list") first-sibling
ruby-indent-level)
-
- ((match "}" "hash") first-sibling 0)
- ((parent-is "hash") first-sibling ruby-indent-level)
- ((match "]" "array") first-sibling 0)
- ((parent-is "array") first-sibling ruby-indent-level)
+ ((match "}" "hash") ruby-ts--parent-call-or-bol 0)
+ ((parent-is "hash") ruby-ts--parent-call-or-bol ruby-indent-level)
+ ((match "]" "array") ruby-ts--parent-call-or-bol 0)
+ ((parent-is "array") ruby-ts--parent-call-or-bol ruby-indent-level)
+
+ ((parent-is "pair") ruby-ts--parent-call-or-bol 0)
+
+ ((match ")" "parenthesized_statements") parent-bol 0)
+ ((parent-is "parenthesized_statements") parent-bol
ruby-indent-level)
;; If the previous method isn't finished yet, this will get
;; the next method indented properly.
@@ -765,12 +768,20 @@ i.e. expr of def foo(args) = expr is returned."
;; but with node set to the statement and parent set to
;; body_statement for all others. ... Fine. Be that way.
;; Ditto for "block" and "block_body"
- ((node-is "body_statement") parent-bol ruby-indent-level)
- ((parent-is "body_statement") (ruby-ts--bol
ruby-ts--grand-parent-node) ruby-indent-level)
- ((match "end" "do_block") parent-bol 0)
- ((n-p-gp "block_body" "block" nil) parent-bol ruby-indent-level)
- ((n-p-gp nil "block_body" "block") (ruby-ts--bol
ruby-ts--grand-parent-node) ruby-indent-level)
- ((match "}" "block") parent-bol 0)
+ ((node-is "body_statement")
+ (ruby-ts--block-indent-anchor ruby-ts--parent-node)
+ ruby-indent-level)
+ ((parent-is "body_statement")
+ (ruby-ts--block-indent-anchor ruby-ts--grand-parent-node)
+ ruby-indent-level)
+ ((match "end" "do_block") (ruby-ts--block-indent-anchor
ruby-ts--parent-node) 0)
+ ((n-p-gp "block_body" "block" nil)
+ (ruby-ts--block-indent-anchor ruby-ts--parent-node)
+ ruby-indent-level)
+ ((n-p-gp nil "block_body" "block")
+ (ruby-ts--block-indent-anchor ruby-ts--grand-parent-node)
+ ruby-indent-level)
+ ((match "}" "block") (ruby-ts--block-indent-anchor
ruby-ts--parent-node) 0)
;; Chained strings
((match "string" "chained_string") first-sibling 0)
@@ -779,6 +790,78 @@ i.e. expr of def foo(args) = expr is returned."
(catch-all parent-bol ruby-indent-level))))
`((ruby . ,common))))
+(defun ruby-ts--block-indent-anchor (block-node-getter)
+ (lambda (node parent _bol &rest _rest)
+ (let ((block-node (funcall block-node-getter node parent)))
+ (save-excursion
+ (goto-char
+ (treesit-node-start
+ (if ruby-block-indent
+ (ruby-ts--statement-ancestor block-node)
+ block-node)))
+ (back-to-indentation)
+ (point)))))
+
+(defun ruby-ts--binary-indent-anchor (_node parent _bol &rest _)
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (when (string-match-p ruby-ts--statement-container-regexp
+ (treesit-node-type (treesit-node-parent parent)))
+ ;; Hack alert: it's not the proper place to alter the offset.
+ ;; Redoing the analysis in the OFFSET form seems annoying,
+ ;; though. (**)
+ (forward-char ruby-indent-level))
+ (point)))
+
+(defun ruby-ts--parent-call-or-bol (_not parent _bol &rest _)
+ (let* ((parent-bol (save-excursion
+ (goto-char (treesit-node-start parent))
+ (back-to-indentation)
+ (point)))
+ (found
+ (treesit-parent-until
+ parent
+ (lambda (node)
+ (or (< (treesit-node-start node) parent-bol)
+ (string-match-p "\\`array\\|hash\\'" (treesit-node-type node))
+ ;; Method call on same line.
+ (equal (treesit-node-type node) "argument_list"))))))
+ (cond
+ ((null found)
+ parent-bol)
+ ;; No paren/curly/brace found on the same line.
+ ((< (treesit-node-start found) parent-bol)
+ parent-bol)
+ ;; Hash or array opener on the same line.
+ ((string-match-p "\\`array\\|hash\\'" (treesit-node-type found))
+ (save-excursion
+ (goto-char (treesit-node-start (treesit-node-child found 1)))
+ (point)))
+ ;; Parenless call found: indent to stmt with offset.
+ ((not ruby-parenless-call-arguments-indent)
+ (save-excursion
+ (goto-char (treesit-node-start
+ (ruby-ts--statement-ancestor found)))
+ ;; (**) Same.
+ (+ (point) ruby-indent-level)))
+ ;; Call with parens -- ident to first arg.
+ ((equal (treesit-node-type (treesit-node-child found 0))
+ "(")
+ (save-excursion
+ (goto-char (treesit-node-start (treesit-node-child found 1)))
+ (point)))
+ ;; Indent to the parenless call args beginning.
+ (t
+ (save-excursion
+ (goto-char (treesit-node-start found))
+ (point))))))
+
+(defun ruby-ts--after-op-indent-p (&rest _)
+ ruby-after-operator-indent)
+
+(defun ruby-ts--method-call-indent-p (&rest _)
+ ruby-method-call-indent)
+
(defun ruby-ts--class-or-module-p (node)
"Predicate if NODE is a class or module."
(string-match-p ruby-ts--class-or-module-regex (treesit-node-type node)))
@@ -949,6 +1032,20 @@ leading double colon is not added."
;; Navigation.
(setq-local treesit-defun-type-regexp ruby-ts--method-regex)
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt '("class"
+ "module"
+ "method"
+ "argument_list"
+ "array"
+ "hash"
+ "parenthesized_statements"
+ "if"
+ "case"
+ "block"
+ "do_block"
+ "begin")))
+
;; AFAIK, Ruby can not nest methods
(setq-local treesit-defun-prefer-top-level nil)
@@ -963,14 +1060,28 @@ leading double colon is not added."
(setq-local treesit-font-lock-feature-list
'(( comment method-definition parameter-definition)
( keyword regexp string type)
- ( builtin-variable builtin-constant constant
+ ( builtin-variable builtin-constant builtin-function
delimiter escape-sequence
- global instance
+ constant global instance
interpolation literal symbol assignment)
( bracket error function operator punctuation)))
(treesit-major-mode-setup))
+(if (treesit-ready-p 'ruby)
+ ;; Copied from ruby-mode.el.
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\(?:\\.\\(?:"
+ "rbw?\\|ru\\|rake\\|thor"
+ "\\|jbuilder\\|rabl\\|gemspec\\|podspec"
+ "\\)"
+ "\\|/"
+ "\\(?:Gem\\|Rake\\|Cap\\|Thor"
+ "\\|Puppet\\|Berks\\|Brew"
+ "\\|Vagrant\\|Guard\\|Pod\\)file"
+ "\\)\\'")
+ 'ruby-ts-mode)))
+
(provide 'ruby-ts-mode)
;;; ruby-ts-mode.el ends here
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index 7536726165e..3a6cb61b719 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -29,7 +29,7 @@
(require 'treesit)
(eval-when-compile (require 'rx))
-(require 'c-ts-mode) ; For comment indent and filling.
+(require 'c-ts-common) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-induce-sparse-tree "treesit.c")
@@ -71,8 +71,8 @@
((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)
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-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)
@@ -275,9 +275,6 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-node-text
(treesit-node-child-by-field-name node "name") t))))
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode))
-
;;;###autoload
(define-derived-mode rust-ts-mode prog-mode "Rust"
"Major mode for editing Rust, powered by tree-sitter."
@@ -288,7 +285,7 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-parser-create 'rust)
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
;; Font-lock.
(setq-local treesit-font-lock-settings rust-ts-mode--font-lock-settings)
@@ -322,6 +319,9 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'rust)
+ (add-to-list 'auto-mode-alist '("\\.rs\\'" . rust-ts-mode)))
+
(provide 'rust-ts-mode)
;;; rust-ts-mode.el ends here
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index 0a79ae01248..9c4f49efd5e 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -30,7 +30,7 @@
(require 'treesit)
(require 'js)
(eval-when-compile (require 'rx))
-(require 'c-ts-mode) ; For comment indent and filling.
+(require 'c-ts-common) ; For comment indent and filling.
(declare-function treesit-parser-create "treesit.c")
@@ -69,13 +69,13 @@
"Rules used for indentation.
Argument LANGUAGE is either `typescript' or `tsx'."
`((,language
- ((parent-is "program") parent-bol 0)
+ ((parent-is "program") point-min 0)
((node-is "}") parent-bol 0)
((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)
+ ((and (parent-is "comment") c-ts-common-looking-at-star)
+ c-ts-common-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)
@@ -97,13 +97,15 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((parent-is "binary_expression") parent-bol
typescript-ts-mode-indent-offset)
,@(when (eq language 'tsx)
- `(((node-is "jsx_fragment") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_element") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_expression") parent typescript-ts-mode-indent-offset)
- ((node-is "jsx_self_closing_element") parent
typescript-ts-mode-indent-offset)
+ `(((match "<" "jsx_fragment") parent 0)
+ ((parent-is "jsx_fragment") parent typescript-ts-mode-indent-offset)
((node-is "jsx_closing_element") parent 0)
- ((node-is "/") parent 0)
- ((node-is ">") parent 0)))
+ ((node-is "jsx_element") parent typescript-ts-mode-indent-offset)
+ ((parent-is "jsx_element") parent typescript-ts-mode-indent-offset)
+ ((parent-is "jsx_opening_element") parent
typescript-ts-mode-indent-offset)
+ ((parent-is "jsx_expression") parent-bol
typescript-ts-mode-indent-offset)
+ ((match "/" "jsx_self_closing_element") parent 0)
+ ((parent-is "jsx_self_closing_element") parent
typescript-ts-mode-indent-offset)))
(no-node parent-bol 0))))
(defvar typescript-ts-mode--keywords
@@ -130,26 +132,21 @@ Argument LANGUAGE is either `typescript' or `tsx'."
Argument LANGUAGE is either `typescript' or `tsx'."
(treesit-font-lock-rules
:language language
- :override t
:feature 'comment
`((comment) @font-lock-comment-face)
:language language
- :override t
:feature 'constant
`(((identifier) @font-lock-constant-face
(:match "^[A-Z_][A-Z_\\d]*$" @font-lock-constant-face))
-
[(true) (false) (null)] @font-lock-constant-face)
:language language
- :override t
:feature 'keyword
`([,@typescript-ts-mode--keywords] @font-lock-keyword-face
[(this) (super)] @font-lock-keyword-face)
:language language
- :override t
:feature 'string
`((regex pattern: (regex_pattern)) @font-lock-regexp-face
(string) @font-lock-string-face
@@ -157,7 +154,7 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(template_substitution ["${" "}"] @font-lock-misc-punctuation-face))
:language language
- :override t
+ :override t ;; for functions assigned to variables
:feature 'declaration
`((function
name: (identifier) @font-lock-function-name-face)
@@ -172,6 +169,10 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(required_parameter (identifier) @font-lock-variable-name-face)
(optional_parameter (identifier) @font-lock-variable-name-face)
+ (variable_declarator
+ name: (identifier) @font-lock-function-name-face
+ value: [(function) (arrow_function)])
+
(variable_declarator
name: (identifier) @font-lock-variable-name-face)
@@ -186,18 +187,19 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(arrow_function
parameter: (identifier) @font-lock-variable-name-face)
- (variable_declarator
- name: (identifier) @font-lock-function-name-face
- value: [(function) (arrow_function)])
-
(variable_declarator
name: (array_pattern
(identifier)
(identifier) @font-lock-function-name-face)
- value: (array (number) (function))))
+ value: (array (number) (function)))
+
+ (catch_clause
+ parameter: (identifier) @font-lock-variable-name-face)
+
+ (import_clause (identifier) @font-lock-variable-name-face)
+ (import_clause (named_imports (import_specifier (identifier))
@font-lock-variable-name-face)))
:language language
- :override t
:feature 'identifier
`((nested_type_identifier
module: (identifier) @font-lock-type-face)
@@ -223,20 +225,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
parameters:
[(_ (identifier) @font-lock-variable-name-face)
(_ (_ (identifier) @font-lock-variable-name-face))
- (_ (_ (_ (identifier) @font-lock-variable-name-face)))])
-
- (return_statement (identifier) @font-lock-variable-name-face)
-
- (binary_expression left: (identifier) @font-lock-variable-name-face)
- (binary_expression right: (identifier) @font-lock-variable-name-face)
-
- (arguments (identifier) @font-lock-variable-name-face)
-
- (parenthesized_expression (identifier) @font-lock-variable-name-face)
- (parenthesized_expression (_ (identifier) @font-lock-variable-name-face)))
+ (_ (_ (_ (identifier) @font-lock-variable-name-face)))]))
:language language
- :override t
:feature 'property
`((property_signature
name: (property_identifier) @font-lock-property-face)
@@ -245,15 +236,12 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(pair key: (property_identifier) @font-lock-variable-name-face)
- (pair value: (identifier) @font-lock-variable-name-face)
-
((shorthand_property_identifier) @font-lock-property-face)
((shorthand_property_identifier_pattern)
@font-lock-property-face))
:language language
- :override t
:feature 'expression
'((assignment_expression
left: [(identifier) @font-lock-function-name-face
@@ -270,7 +258,6 @@ Argument LANGUAGE is either `typescript' or `tsx'."
property: (property_identifier) @font-lock-function-name-face)]))
:language language
- :override t
:feature 'pattern
`((pair_pattern
key: (property_identifier) @font-lock-property-face)
@@ -278,7 +265,6 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(array_pattern (identifier) @font-lock-variable-name-face))
:language language
- :override t
:feature 'jsx
`((jsx_opening_element
[(nested_identifier (identifier)) (identifier)]
@@ -318,11 +304,51 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:override t
'((escape_sequence) @font-lock-escape-face)))
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode))
+(defvar typescript-ts-mode--sentence-nodes
+ '("import_statement"
+ "debugger_statement"
+ "expression_statement"
+ "if_statement"
+ "switch_statement"
+ "for_statement"
+ "for_in_statement"
+ "while_statement"
+ "do_statement"
+ "try_statement"
+ "with_statement"
+ "break_statement"
+ "continue_statement"
+ "return_statement"
+ "throw_statement"
+ "empty_statement"
+ "labeled_statement"
+ "variable_declaration"
+ "lexical_declaration"
+ "property_signature")
+ "Nodes that designate sentences in TypeScript.
+See `treesit-sentence-type-regexp' for more information.")
+
+(defvar typescript-ts-mode--sexp-nodes
+ '("expression"
+ "pattern"
+ "array"
+ "function"
+ "string"
+ "escape"
+ "template"
+ "regex"
+ "number"
+ "identifier"
+ "this"
+ "super"
+ "true"
+ "false"
+ "null"
+ "undefined"
+ "arguments"
+ "pair")
+ "Nodes that designate sexps in TypeScript.
+See `treesit-sexp-type-regexp' for more information.")
;;;###autoload
(define-derived-mode typescript-ts-base-mode prog-mode "TypeScript"
@@ -331,7 +357,7 @@ Argument LANGUAGE is either `typescript' or `tsx'."
:syntax-table typescript-ts-mode--syntax-table
;; Comments.
- (c-ts-mode-comment-setup)
+ (c-ts-common-comment-setup)
(setq-local treesit-defun-prefer-top-level t)
(setq-local treesit-text-type-regexp
@@ -350,6 +376,12 @@ Argument LANGUAGE is either `typescript' or `tsx'."
"lexical_declaration")))
(setq-local treesit-defun-name-function #'js--treesit-defun-name)
+ (setq-local treesit-sentence-type-regexp
+ (regexp-opt typescript-ts-mode--sentence-nodes))
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt typescript-ts-mode--sexp-nodes))
+
;; Imenu (same as in `js-ts-mode').
(setq-local treesit-simple-imenu-settings
`(("Function" "\\`function_declaration\\'" nil nil)
@@ -384,6 +416,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'typescript)
+ (add-to-list 'auto-mode-alist '("\\.ts\\'" . typescript-ts-mode)))
+
;;;###autoload
(define-derived-mode tsx-ts-mode typescript-ts-base-mode "TypeScript[TSX]"
"Major mode for editing TypeScript."
@@ -408,6 +443,18 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(setq-local treesit-simple-indent-rules
(typescript-ts-mode--indent-rules 'tsx))
+ ;; Navigation
+ (setq-local treesit-sentence-type-regexp
+ (regexp-opt (append
+ typescript-ts-mode--sentence-nodes
+ '("jsx_element"
+ "jsx_self_closing_element"))))
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt (append
+ typescript-ts-mode--sexp-nodes
+ '("jsx"))))
+
;; Font-lock.
(setq-local treesit-font-lock-settings
(typescript-ts-mode--font-lock-settings 'tsx))
@@ -419,6 +466,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'tsx)
+ (add-to-list 'auto-mode-alist '("\\.tsx\\'" . tsx-ts-mode)))
+
(provide 'typescript-ts-mode)
;;; typescript-ts-mode.el ends here
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index d5cee9fa84f..4db0df6c3b8 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,7 +1,7 @@
;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2023 Free Software Foundation, Inc.
-;; Version: 1.6.0
+;; Version: 1.6.1
;; Package-Requires: ((emacs "26.1"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -568,7 +568,8 @@ This can be used from `xref-after-jump-hook', for
instance.")
(dolist (l (list (car history) (cdr history)))
(dolist (m l)
(set-marker m nil nil)))
- (setq history (cons nil nil)))
+ (setcar history nil)
+ (setcdr history nil))
nil)
;;;###autoload
diff --git a/lisp/replace.el b/lisp/replace.el
index 2f063bbf66b..3c2b925ea92 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -824,11 +824,11 @@ by this function to the end of values available via
(defvar-keymap read-regexp-map
:parent minibuffer-local-map
- "M-c" #'read-regexp-toggle-case-folding)
+ "M-s c" #'read-regexp-toggle-case-fold)
(defvar read-regexp--case-fold nil)
-(defun read-regexp-toggle-case-folding ()
+(defun read-regexp-toggle-case-fold ()
(interactive)
(setq read-regexp--case-fold
(if (or (eq read-regexp--case-fold 'fold)
@@ -875,7 +875,7 @@ in \":\", followed by optional whitespace), DEFAULT is
added to the prompt.
The optional argument HISTORY is a symbol to use for the history list.
If nil, use `regexp-history'.
-If the user has used the
\\<read-regexp-map>\\[read-regexp-toggle-case-folding] command to specify case
+If the user has used the \\<read-regexp-map>\\[read-regexp-toggle-case-fold]
command to specify case
sensitivity, the returned string will have a text property named
`case-fold' that has a value of either `fold' or
`inhibit-fold'. (It's up to the caller of `read-regexp' to
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 8a1239e1aa2..5ebc5f7c6c3 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -118,17 +118,13 @@ Each element has the form (WINDOW . OVERLAY).")
;; overlay. Always reveal invisible text, but only reveal
;; display properties if `reveal-toggle-invisible' is
;; present.
- (let ((inv (overlay-get ol 'invisible))
- (disp (and (overlay-get ol 'display)
- (overlay-get ol 'reveal-toggle-invisible)))
- open)
- (when (and (or (and inv
- ;; There's an `invisible' property.
- ;; Make sure it's actually invisible,
- ;; and ellipsized.
- (and (consp buffer-invisibility-spec)
- (cdr (assq inv
buffer-invisibility-spec))))
- disp)
+ (let* ((inv (overlay-get ol 'invisible))
+ (disp (and (overlay-get ol 'display)
+ (overlay-get ol 'reveal-toggle-invisible)))
+ (hidden (invisible-p inv))
+ (ellipsis (and hidden (not (eq t hidden))))
+ open)
+ (when (and (or ellipsis disp)
(or (setq open
(or (overlay-get ol 'reveal-toggle-invisible)
(and (symbolp inv)
diff --git a/lisp/simple.el b/lisp/simple.el
index 690968ca938..561c7b568ab 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2207,15 +2207,39 @@ to get different commands to edit and resubmit."
"Predicate to use to determine which commands to include when completing.
If it's nil, include all the commands.
If it's a function, it will be called with two parameters: the
-symbol of the command and a buffer. The predicate should return
-non-nil if the command should be present when doing \\`M-x TAB'
-in that buffer."
+symbol of the command and the current buffer. The predicate should
+return non-nil if the command should be considered as a completion
+candidate for \\`M-x' in that buffer.
+
+Several predicate functions suitable for various optional behaviors
+are available:
+
+ `command-completion-default-include-p'
+ This excludes from completion candidates those commands
+ which have been marked specific to modes other than the
+ current buffer's mode. Commands that are not specific
+ to any mode are included.
+
+ `command-completion-using-modes-p'
+ This includes in completion candidates only commands
+ marked as specific to the current buffer's mode.
+
+ `command-completion-using-modes-and-keymaps-p'
+ This includes commands marked as specific to the current
+ buffer's modes and commands that have keybindings in the
+ current buffer's active local keymaps. It also includes
+ several commands, like Customize commands, which should
+ always be available."
:version "28.1"
:group 'completion
:type '(choice (const :tag "Don't exclude any commands" nil)
(const :tag "Exclude commands irrelevant to current buffer's
mode"
command-completion-default-include-p)
- (function :tag "Other function")))
+ (const :tag "Include only commands relevant to current
buffer's mode"
+ command-completion-using-modes-p)
+ (const :tag "Commands relevant to current buffer's mode or
bound in its keymaps"
+ command-completion-using-modes-and-keymaps-p)
+ (function :tag "Other predicate function")))
(defun execute-extended-command-cycle ()
"Choose the next version of the extended command predicates.
@@ -2401,6 +2425,35 @@ or (if one of MODES is a minor mode), if it is switched
on in BUFFER."
#'eq)
(seq-intersection modes global-minor-modes #'eq)))
+(defun command-completion-using-modes-and-keymaps-p (symbol buffer)
+ "Return non-nil if SYMBOL is marked for BUFFER's mode or bound in its
keymaps."
+ (with-current-buffer buffer
+ (let ((keymaps
+ ;; The major mode's keymap and any active minor modes.
+ (nconc
+ (and (current-local-map) (list (current-local-map)))
+ (mapcar
+ #'cdr
+ (seq-filter
+ (lambda (elem)
+ (symbol-value (car elem)))
+ minor-mode-map-alist)))))
+ (or (command-completion-using-modes-p symbol buffer)
+ ;; Include commands that are bound in a keymap in the
+ ;; current buffer.
+ (and (where-is-internal symbol keymaps)
+ ;; But not if they have a command predicate that
+ ;; says that they shouldn't. (This is the case
+ ;; for `ignore' and `undefined' and similar
+ ;; commands commonly found in keymaps.)
+ (or (null (get symbol 'completion-predicate))
+ (funcall (get symbol 'completion-predicate)
+ symbol buffer)))
+ ;; Include customize-* commands (do we need a list of such
+ ;; "always available" commands? customizable?)
+ (string-match-p "customize-" (symbol-name symbol))))))
+
+
(defun command-completion-button-p (category buffer)
"Return non-nil if there's a button of CATEGORY at point in BUFFER."
(with-current-buffer buffer
@@ -2502,7 +2555,11 @@ Also see `suggest-key-bindings'."
(defun execute-extended-command (prefixarg &optional command-name typed)
"Read a command name, then read the arguments and call the command.
To pass a prefix argument to the command you are
-invoking, give a prefix argument to `execute-extended-command'."
+invoking, give a prefix argument to `execute-extended-command'.
+
+This command provides completion when reading the command name.
+Which completion candidates are shown can be controlled by
+customizing `read-extended-command-predicate'."
(declare (interactive-only command-execute))
;; FIXME: Remember the actual text typed by the user before completion,
;; so that we don't later on suggest the same shortening.
@@ -2652,7 +2709,16 @@ function as needed."
(let ((doc (car body)))
(when (funcall docstring-p doc)
doc)))
- (_ (signal 'invalid-function (list function))))))
+ ((pred symbolp)
+ (let ((f (indirect-function function)))
+ (if f (function-documentation f)
+ (signal 'void-function (list function)))))
+ (`(macro . ,f) (function-documentation f))
+ (_
+ (let ((doc (internal-subr-documentation function)))
+ (if (eq t doc)
+ (signal 'invalid-function (list function))
+ doc))))))
(cl-defmethod function-documentation ((function accessor))
(oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
@@ -4664,6 +4730,18 @@ Also see the `async-shell-command-buffer' variable."
action))
(user-error "Shell command in progress"))))
+(defun file-user-uid ()
+ "Return the connection-local effective uid.
+This is similar to `user-uid', but may invoke a file name handler
+based on `default-directory'. See Info node `(elisp)Magic File
+Names'.
+
+If a file name handler is unable to retrieve the effective uid,
+this function will instead return -1."
+ (if-let ((handler (find-file-name-handler default-directory 'file-user-uid)))
+ (funcall handler 'file-user-uid)
+ (user-uid)))
+
(defun max-mini-window-lines (&optional frame)
"Compute maximum number of lines for echo area in FRAME.
As defined by `max-mini-window-height'. FRAME defaults to the
@@ -8436,37 +8514,39 @@ 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)))))
+(defun transpose-sexps-default-function (arg)
+ "Default method to locate a pair of points for transpose-sexps."
+ ;; 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)))))
+
+(defvar transpose-sexps-function #'transpose-sexps-default-function
"If non-nil, `transpose-sexps' delegates to this function.
This function takes one argument ARG, a number. Its expected
@@ -9673,7 +9753,11 @@ the completions is popped up and down."
"Move to the first item in the completion list."
(interactive)
(goto-char (point-min))
- (unless (get-text-property (point) 'mouse-face)
+ (if (get-text-property (point) 'mouse-face)
+ (unless (get-text-property (point) 'first-completion)
+ (let ((inhibit-read-only t))
+ (add-text-properties (point) (min (1+ (point)) (point-max))
+ '(first-completion t))))
(when-let ((pos (next-single-property-change (point) 'mouse-face)))
(goto-char pos))))
@@ -9706,6 +9790,14 @@ Also see the `completion-auto-wrap' variable."
(let ((tabcommand (member (this-command-keys) '("\t" [backtab])))
pos)
(catch 'bound
+ (when (and (bobp)
+ (> n 0)
+ (get-text-property (point) 'mouse-face)
+ (not (get-text-property (point) 'first-completion)))
+ (let ((inhibit-read-only t))
+ (add-text-properties (point) (1+ (point)) '(first-completion t)))
+ (setq n (1- n)))
+
(while (> n 0)
(setq pos (point))
;; If in a completion, move to the end of it.
@@ -10324,7 +10416,7 @@ call `normal-erase-is-backspace-mode' (which see)
instead."
(if (if (eq normal-erase-is-backspace 'maybe)
(and (not noninteractive)
(or (memq system-type '(ms-dos windows-nt))
- (memq window-system '(w32 ns pgtk))
+ (memq window-system '(w32 ns pgtk haiku))
(and (eq window-system 'x)
(fboundp 'x-backspace-delete-keys-p)
(x-backspace-delete-keys-p))
diff --git a/lisp/sqlite-mode.el b/lisp/sqlite-mode.el
index 83762b61943..c3047c786f7 100644
--- a/lisp/sqlite-mode.el
+++ b/lisp/sqlite-mode.el
@@ -55,10 +55,14 @@
(interactive "fSQLite file name: ")
(unless (sqlite-available-p)
(error "This Emacs doesn't have SQLite support, so it can't view SQLite
files"))
+ (if (file-remote-p file)
+ (error "Remote SQLite files are not yet supported"))
(pop-to-buffer (get-buffer-create
(format "*SQLite %s*" (file-name-nondirectory file))))
(sqlite-mode)
(setq-local sqlite--db (sqlite-open file))
+ (unless (sqlitep sqlite--db)
+ (error "`sqlite-open' failed to open SQLite file"))
(sqlite-mode-list-tables))
(defun sqlite-mode-list-tables ()
diff --git a/lisp/startup.el b/lisp/startup.el
index fa84985580e..06783a77c1e 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -1604,7 +1604,7 @@ please check its value")
(display-warning 'initialization
(format-message "\
Your `load-path' seems to contain\n\
-your `.emacs.d' directory: %s\n\
+your `user-emacs-directory': %s\n\
This is likely to cause problems...\n\
Consider using a subdirectory instead, e.g.: %s"
dir (expand-file-name
diff --git a/lisp/subr.el b/lisp/subr.el
index d1d3c76caf8..f909b63aabe 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2562,11 +2562,13 @@ The variable list SPEC is the same as in `if-let'."
Evaluate each binding in turn, stopping if a binding value is nil.
If all bindings are non-nil, eval BODY and repeat.
-The variable list SPEC is the same as in `if-let'."
+The variable list SPEC is the same as in `if-let*'."
(declare (indent 1) (debug if-let))
(let ((done (gensym "done")))
`(catch ',done
(while t
+ ;; This is `if-let*', not `if-let', deliberately, despite the
+ ;; name of this macro. See bug#60758.
(if-let* ,spec
(progn
,@body)
@@ -4966,21 +4968,20 @@ the function `undo--wrap-and-run-primitive-undo'."
beg
(marker-position end-marker)
#'undo--wrap-and-run-primitive-undo
- beg (marker-position end-marker) buffer-undo-list))
+ beg (marker-position end-marker)
+ ;; We will truncate this list by side-effect below.
+ buffer-undo-list))
(ptr buffer-undo-list))
(if (not (eq buffer-undo-list old-bul))
(progn
(while (and (not (eq (cdr ptr) old-bul))
;; In case garbage collection has removed OLD-BUL.
- (cdr ptr)
- ;; Don't include a timestamp entry.
- (not (and (consp (cdr ptr))
- (consp (cadr ptr))
- (eq (caadr ptr) t)
- (setq old-bul (cdr ptr)))))
+ (or (cdr ptr)
+ (progn
+ (message "combine-change-calls:
buffer-undo-list broken")
+ nil)))
(setq ptr (cdr ptr)))
- (unless (cdr ptr)
- (message "combine-change-calls: buffer-undo-list broken"))
+ ;; Truncate the list that's in the `apply' entry.
(setcdr ptr nil)
(push ap-elt buffer-undo-list)
(setcdr buffer-undo-list old-bul)))))
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 8991610a50f..a1d7d4bbbec 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1827,7 +1827,9 @@ can also be used to fill comments.
(setq-local treesit-simple-imenu-settings
`(( nil ,(rx bos (or "rule_set" "media_statement") eos)
nil nil)))
- (treesit-major-mode-setup)))
+ (treesit-major-mode-setup)
+
+ (add-to-list 'auto-mode-alist '("\\.css\\'" . css-ts-mode))))
;;;###autoload
(define-derived-mode css-mode css-base-mode "CSS"
diff --git a/lisp/textmodes/html-ts-mode.el b/lisp/textmodes/html-ts-mode.el
new file mode 100644
index 00000000000..58dcc7d8cad
--- /dev/null
+++ b/lisp/textmodes/html-ts-mode.el
@@ -0,0 +1,134 @@
+;;; html-ts-mode.el --- tree-sitter support for HTML -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author : Theodor Thornhill <theo@thornhill.no>
+;; Maintainer : Theodor Thornhill <theo@thornhill.no>
+;; Created : January 2023
+;; Keywords : html languages tree-sitter
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'treesit)
+(require 'sgml-mode)
+
+(declare-function treesit-parser-create "treesit.c")
+(declare-function treesit-node-type "treesit.c")
+
+(defcustom html-ts-mode-indent-offset 2
+ "Number of spaces for each indentation step in `html-ts-mode'."
+ :version "29.1"
+ :type 'integer
+ :safe 'integerp
+ :group 'html)
+
+(defvar html-ts-mode--indent-rules
+ `((html
+ ((parent-is "fragment") point-min 0)
+ ((node-is "/>") parent-bol 0)
+ ((node-is ">") parent-bol 0)
+ ((node-is "end_tag") parent-bol 0)
+ ((parent-is "comment") prev-adaptive-prefix 0)
+ ((parent-is "element") parent-bol html-ts-mode-indent-offset)
+ ((parent-is "script_element") parent-bol html-ts-mode-indent-offset)
+ ((parent-is "style_element") parent-bol html-ts-mode-indent-offset)
+ ((parent-is "start_tag") parent-bol html-ts-mode-indent-offset)
+ ((parent-is "self_closing_tag") parent-bol html-ts-mode-indent-offset)))
+ "Tree-sitter indent rules.")
+
+(defvar html-ts-mode--font-lock-settings
+ (treesit-font-lock-rules
+ :language 'html
+ :override t
+ :feature 'comment
+ `((comment) @font-lock-comment-face)
+ :language 'html
+ :override t
+ :feature 'keyword
+ `("doctype" @font-lock-keyword-face)
+ :language 'html
+ :override t
+ :feature 'definition
+ `((tag_name) @font-lock-function-name-face)
+ :language 'html
+ :override t
+ :feature 'string
+ `((quoted_attribute_value) @font-lock-string-face)
+ :language 'html
+ :override t
+ :feature 'property
+ `((attribute_name) @font-lock-variable-name-face))
+ "Tree-sitter font-lock settings for `html-ts-mode'.")
+
+(defun html-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."
+ (when (equal (treesit-node-type node) "tag_name")
+ (treesit-node-text node t)))
+
+;;;###autoload
+(define-derived-mode html-ts-mode html-mode "HTML"
+ "Major mode for editing Html, powered by tree-sitter."
+ :group 'html
+
+ (unless (treesit-ready-p 'html)
+ (error "Tree-sitter for HTML isn't available"))
+
+ (treesit-parser-create 'html)
+
+ ;; Comments.
+ (setq-local treesit-text-type-regexp
+ (regexp-opt '("comment" "text")))
+
+ ;; Indent.
+ (setq-local treesit-simple-indent-rules html-ts-mode--indent-rules)
+
+ ;; Navigation.
+ (setq-local treesit-defun-type-regexp "element")
+
+ (setq-local treesit-defun-name-function #'html-ts-mode--defun-name)
+
+ (setq-local treesit-sentence-type-regexp "tag")
+
+ (setq-local treesit-sexp-type-regexp
+ (regexp-opt '("element"
+ "text"
+ "attribute"
+ "value")))
+
+ ;; Font-lock.
+ (setq-local treesit-font-lock-settings html-ts-mode--font-lock-settings)
+ (setq-local treesit-font-lock-feature-list
+ '((comment keyword definition)
+ (property string)
+ () ()))
+
+ ;; Imenu.
+ (setq-local treesit-simple-imenu-settings
+ '(("Element" "\\`tag_name\\'" nil nil)))
+ (treesit-major-mode-setup))
+
+(if (treesit-ready-p 'html)
+ (add-to-list 'auto-mode-alist '("\\.html\\'" . html-ts-mode)))
+
+(provide 'html-ts-mode)
+
+;;; html-ts-mode.el ends here
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index 73abb155aaa..bf249fdcdfb 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -441,13 +441,12 @@ the current paragraph with the one containing the mark."
(if (< (point) (point-max))
(end-of-paragraph-text))))))
-(defun forward-sentence (&optional arg)
+(defun forward-sentence-default-function (&optional arg)
"Move forward to next end of sentence. With argument, repeat.
When ARG is negative, move backward repeatedly to start of sentence.
The variable `sentence-end' is a regular expression that matches ends of
sentences. Also, every paragraph boundary terminates sentences as well."
- (interactive "^p")
(or arg (setq arg 1))
(let ((opoint (point))
(sentence-end (sentence-end)))
@@ -480,6 +479,18 @@ sentences. Also, every paragraph boundary terminates
sentences as well."
(let ((npoint (constrain-to-field nil opoint t)))
(not (= npoint opoint)))))
+(defvar forward-sentence-function #'forward-sentence-default-function
+ "Function to be used to calculate sentence movements.
+See `forward-sentence' for a description of its behavior.")
+
+(defun forward-sentence (&optional arg)
+ "Move forward to next end of sentence. With argument ARG, repeat.
+If ARG is negative, move backward repeatedly to start of
+sentence. Delegates its work to `forward-sentence-function'."
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (funcall forward-sentence-function arg))
+
(defun count-sentences (start end)
"Count sentences in current buffer from START to END."
(let ((sentences 0)
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 77373707d65..6beae816257 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -636,7 +636,7 @@ command, it will add another key, ignoring the value of
The regular expression uses an expanded syntax: && is interpreted as `and'.
Thus, `aaaa&&bbb' matches entries which contain both `aaaa' and `bbb'.
-While entering the regexp, completion on knows citation keys is possible.
+While entering the regexp, completion on known citation keys is possible.
`=' is a good regular expression to match all entries in all files."
(interactive)
diff --git a/lisp/textmodes/toml-ts-mode.el b/lisp/textmodes/toml-ts-mode.el
index 2430c5f3e76..416542084f1 100644
--- a/lisp/textmodes/toml-ts-mode.el
+++ b/lisp/textmodes/toml-ts-mode.el
@@ -117,8 +117,6 @@ Return nil if there is no name or if NODE is not a defun
node."
(or (treesit-node-text (treesit-node-child node 1) t)
"Root table"))))
-(add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode))
-
;;;###autoload
(define-derived-mode toml-ts-mode text-mode "TOML"
"Major mode for editing TOML, powered by tree-sitter."
@@ -155,6 +153,9 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'toml)
+ (add-to-list 'auto-mode-alist '("\\.toml\\'" . toml-ts-mode)))
+
(provide 'toml-ts-mode)
;;; toml-ts-mode.el ends here
diff --git a/lisp/textmodes/yaml-ts-mode.el b/lisp/textmodes/yaml-ts-mode.el
index 8c61ee062cf..a25230e6e61 100644
--- a/lisp/textmodes/yaml-ts-mode.el
+++ b/lisp/textmodes/yaml-ts-mode.el
@@ -117,9 +117,6 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `yaml-ts-mode'.")
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode))
-
;;;###autoload
(define-derived-mode yaml-ts-mode text-mode "YAML"
"Major mode for editing YAML, powered by tree-sitter."
@@ -146,6 +143,9 @@
(treesit-major-mode-setup)))
+(if (treesit-ready-p 'yaml)
+ (add-to-list 'auto-mode-alist '("\\.ya?ml\\'" . yaml-ts-mode)))
+
(provide 'yaml-ts-mode)
;;; yaml-ts-mode.el ends here
diff --git a/lisp/treesit.el b/lisp/treesit.el
index a7f453a8899..29b29d2665a 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -905,6 +905,14 @@ This is not a general optimization and should be RARELY
needed!
See comments in `treesit-font-lock-fontify-region' for more
detail.")
+(defvar-local treesit--font-lock-fast-mode-grace-count 5
+ "Grace counts before we turn on the fast mode.
+
+When query takes abnormally long time to execute, we turn on the
+\"fast mode\", but just to be on the safe side, we only turn on
+the fast mode after this number of offenses. See bug#60691,
+bug#60223.")
+
;; Some details worth explaining:
;;
;; 1. When we apply face to a node, we clip the face into the
@@ -927,13 +935,13 @@ detail.")
;; parse it into a enormously tall tree (10k levels tall). In that
;; case querying the root node is very slow. So we try to get
;; top-level nodes and query them. This ensures that querying is fast
-;; everywhere else, except for the problematic region.
+;; everywhere else, except for the problematic region. (Bug#59415).
;;
;; Some other time the source file has a top-level node that contains
-;; a huge number of children (say, 10k children), querying that node
-;; is also very slow, so instead of getting the top-level node, we
-;; recursively go down the tree to find nodes that cover the region
-;; but are reasonably small.
+;; a huge number of immediate children (say, 10k children), querying
+;; that node is also very slow, so instead of getting the top-level
+;; node, we recursively go down the tree to find nodes that cover the
+;; region but are reasonably small. (Bug#59738).
;;
;; 3. It is possible to capture a node that's completely outside the
;; region between START and END: as long as the whole pattern
@@ -941,8 +949,8 @@ detail.")
;; returned. If the node is outside of that region, (max node-start
;; start) and friends return bad values, so we filter them out.
;; However, we don't filter these nodes out if a function will process
-;; the node, because could (and often do) fontify the relatives of the
-;; captured node, not just the node itself. If we took out those
+;; the node, because it could (and often do) fontify the relatives of
+;; the captured node, not just the node itself. If we took out those
;; nodes author of those functions would be very confused.
(defun treesit-font-lock-fontify-region (start end &optional loudly)
"Fontify the region between START and END.
@@ -979,9 +987,13 @@ If LOUDLY is non-nil, display some debugging information."
(end-time (current-time)))
;; If for any query the query time is strangely long,
;; switch to fast mode (see comments above).
- (when (> (time-to-seconds (time-subtract end-time start-time))
- 0.01)
- (setq-local treesit--font-lock-fast-mode t))
+ (when (and (null treesit--font-lock-fast-mode)
+ (> (time-to-seconds
+ (time-subtract end-time start-time))
+ 0.01))
+ (if (> treesit--font-lock-fast-mode-grace-count 0)
+ (cl-decf treesit--font-lock-fast-mode-grace-count)
+ (setq-local treesit--font-lock-fast-mode t)))
;; For each captured node, fontify that node.
(with-silent-modifications
@@ -1091,10 +1103,12 @@ See `treesit-simple-indent-presets'.")
(string-match-p
parent-t (treesit-node-type parent)))
(or (null grand-parent-t)
- (string-match-p
- grand-parent-t
- (treesit-node-type
- (treesit-node-parent parent))))))))
+ (and
+ (treesit-node-parent parent)
+ (string-match-p
+ grand-parent-t
+ (treesit-node-type
+ (treesit-node-parent parent)))))))))
(cons 'no-node (lambda (node &rest _) (null node)))
(cons 'parent-is (lambda (type)
(lambda (_n parent &rest _)
@@ -1143,20 +1157,19 @@ See `treesit-simple-indent-presets'.")
(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)))))))
+ (let ((comment-start-bol
+ (save-excursion
+ (goto-char (treesit-node-start parent))
+ (line-beginning-position))))
+ (save-excursion
+ (forward-line -1)
+ (and (>= (point) comment-start-bol)
+ adaptive-fill-regexp
+ (looking-at adaptive-fill-regexp)
+ ;; If previous line is an empty line, don't
+ ;; indent.
+ (not (looking-at (rx (* whitespace) eol)))
+ (match-end 0))))))
;; TODO: Document.
(cons 'grand-parent
(lambda (_n parent &rest _)
@@ -1187,9 +1200,12 @@ See `treesit-simple-indent-presets'.")
res))))
(cons 'or (lambda (&rest fns)
(lambda (node parent bol &rest _)
- (seq-find
- (lambda (fn) (funcall fn node parent bol))
- fns))))
+ (let (res)
+ (catch 'break
+ (dolist (fn fns)
+ (setq res (funcall fn node parent bol))
+ (and res (throw 'break t))))
+ res))))
(cons 'not (lambda (fn)
(lambda (node parent bol &rest _)
(not (funcall fn node parent bol)))))
@@ -1338,10 +1354,10 @@ and returns
(ANCHOR . OFFSET).
BOL is the position of the beginning of the line; NODE is the
-\"largest\" node that starts at BOL; PARENT is its parent; ANCHOR
-is a point (not a node), and OFFSET is a number. Emacs finds the
-column of ANCHOR and adds OFFSET to it as the final indentation
-of the current line.")
+\"largest\" node that starts at BOL (and isn't a root node);
+PARENT is its parent; ANCHOR is a point (not a node), and OFFSET
+is a number. Emacs finds the column of ANCHOR and adds OFFSET to
+it as the final indentation of the current line.")
(defun treesit--indent-1 ()
"Indent the current line.
@@ -1359,10 +1375,13 @@ Return (ANCHOR . OFFSET). This function is used by
((treesit-language-at (point))
(treesit-node-at bol (treesit-language-at (point))))
(t (treesit-node-at bol))))
+ (root (treesit-parser-root-node
+ (treesit-node-parser smallest-node)))
(node (treesit-parent-while
smallest-node
(lambda (node)
- (eq bol (treesit-node-start node))))))
+ (and (eq bol (treesit-node-start node))
+ (not (treesit-node-eq node root)))))))
(let*
((parser (if smallest-node
(treesit-node-parser smallest-node)
@@ -1508,10 +1527,15 @@ OFFSET."
return
(let ((anchor-pos
(treesit--simple-indent-eval
- (list anchor node parent bol))))
- (cons anchor-pos (if (symbolp offset)
- (symbol-value offset)
- offset)))
+ (list anchor node parent bol)))
+ (offset-val
+ (cond ((numberp offset) offset)
+ ((and (symbolp offset)
+ (boundp offset))
+ (symbol-value offset))
+ (t (treesit--simple-indent-eval
+ (list offset node parent bol))))))
+ (cons anchor-pos offset-val))
finally return
(progn (when treesit--indent-verbose
(message "No matched rule"))
@@ -1615,6 +1639,21 @@ BACKWARD and ALL are the same as in
`treesit-search-forward'."
(goto-char current-pos)))
node))
+(defvar-local treesit-sexp-type-regexp nil
+ "A regexp that matches the node type of sexp nodes.
+
+A sexp node is a node that is bigger than punctuation, and
+delimits medium sized statements in the source code. It is,
+however, smaller in scope than sentences. This is used by
+`treesit-forward-sexp' and friends.")
+
+(defun treesit-forward-sexp (&optional arg)
+ (interactive "^p")
+ (or arg (setq arg 1))
+ (funcall
+ (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing)
+ treesit-sexp-type-regexp (abs arg)))
+
(defun treesit-transpose-sexps (&optional arg)
"Tree-sitter `transpose-sexps' function.
Arg is the same as in `transpose-sexps'.
@@ -1792,6 +1831,31 @@ comments and multiline string literals. For example,
\"text_block\" in the case of a string. This is used by
`prog-fill-reindent-defun' and friends.")
+(defvar-local treesit-sentence-type-regexp nil
+ "A regexp that matches the node type of sentence nodes.
+
+A sentence node is a node that is bigger than a sexp, and
+delimits larger statements in the source code. It is, however,
+smaller in scope than defuns. This is used by
+`treesit-forward-sentence' and friends.")
+
+(defun treesit-forward-sentence (&optional arg)
+ "Tree-sitter `forward-sentence-function' function.
+
+ARG is the same as in `forward-sentence'.
+
+If inside comment or other nodes described in
+`treesit-sentence-type-regexp', use
+`forward-sentence-default-function', else move across nodes as
+described by `treesit-sentence-type-regexp'."
+ (if (string-match-p
+ treesit-text-type-regexp
+ (treesit-node-type (treesit-node-at (point))))
+ (funcall #'forward-sentence-default-function arg)
+ (funcall
+ (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing)
+ treesit-sentence-type-regexp (abs arg))))
+
(defun treesit-default-defun-skipper ()
"Skips spaces after navigating a defun.
This function tries to move to the beginning of a line, either by
@@ -2255,7 +2319,11 @@ before calling this function."
(setq-local add-log-current-defun-function
#'treesit-add-log-current-defun))
+ (when treesit-sexp-type-regexp
+ (setq-local forward-sexp-function #'treesit-forward-sexp))
(setq-local transpose-sexps-function #'treesit-transpose-sexps)
+ (when treesit-sentence-type-regexp
+ (setq-local forward-sentence-function #'treesit-forward-sentence))
;; Imenu.
(when treesit-simple-imenu-settings
@@ -2447,11 +2515,15 @@ in the region."
(window-start) (window-end) treesit--explorer-language))
;; Only highlight the current top-level construct.
;; Highlighting the whole buffer is slow and unnecessary.
- (top-level (treesit-node-first-child-for-pos
- root (if (eolp)
- (max (point-min) (1- (point)))
- (point))
- t))
+ ;; But if the buffer is small (ie, used in playground
+ ;; style), just highlight the whole buffer.
+ (top-level (if (< (buffer-size) 4000)
+ root
+ (treesit-node-first-child-for-pos
+ root (if (eolp)
+ (max (point-min) (1- (point)))
+ (point))
+ t)))
;; Only highlight node when region is active, if we
;; highlight node at point the syntax tree is too jumpy.
(nodes-hl
@@ -2631,6 +2703,11 @@ leaves point at the end of the last line of NODE."
(when (not named)
(overlay-put ov 'face 'treesit-explorer-anonymous-node)))))
+(defun treesit--explorer-kill-explorer-buffer ()
+ "Kill the explorer buffer of this buffer."
+ (when (buffer-live-p treesit--explorer-buffer)
+ (kill-buffer treesit--explorer-buffer)))
+
(define-derived-mode treesit--explorer-tree-mode special-mode
"TS Explorer"
"Mode for displaying syntax trees for `treesit-explore-mode'."
@@ -2642,30 +2719,46 @@ Pops up a window showing the syntax tree of the source
in the
current buffer in real time. The corresponding node enclosing
the text in the active region is highlighted in the explorer
window."
- :lighter " TSplay"
+ :lighter " TSexplore"
(if treesit-explore-mode
- (progn
- (unless (buffer-live-p treesit--explorer-buffer)
- (setq-local treesit--explorer-buffer
- (get-buffer-create
- (format "*tree-sitter explorer for %s*"
- (buffer-name))))
- (setq-local treesit--explorer-language
- (intern (completing-read
+ (let ((language (intern (completing-read
"Language: "
(mapcar #'treesit-parser-language
- (treesit-parser-list)))))
- (with-current-buffer treesit--explorer-buffer
- (treesit--explorer-tree-mode)))
- (display-buffer treesit--explorer-buffer
- (cons nil '((inhibit-same-window . t))))
- (treesit--explorer-refresh)
- (add-hook 'post-command-hook
- #'treesit--explorer-post-command 0 t)
- (setq-local treesit--explorer-last-node nil))
+ (treesit-parser-list))))))
+ (if (not (treesit-language-available-p language))
+ (user-error "Cannot find tree-sitter grammar for %s: %s"
+ language (cdr (treesit-language-available-p
+ language t)))
+ ;; Create explorer buffer.
+ (unless (buffer-live-p treesit--explorer-buffer)
+ (setq-local treesit--explorer-buffer
+ (get-buffer-create
+ (format "*tree-sitter explorer for %s*"
+ (buffer-name))))
+ (setq-local treesit--explorer-language language)
+ (with-current-buffer treesit--explorer-buffer
+ (treesit--explorer-tree-mode)))
+ (display-buffer treesit--explorer-buffer
+ (cons nil '((inhibit-same-window . t))))
+ (treesit--explorer-refresh)
+ ;; Setup variables and hooks.
+ (add-hook 'post-command-hook
+ #'treesit--explorer-post-command 0 t)
+ (add-hook 'kill-buffer-hook
+ #'treesit--explorer-kill-explorer-buffer 0 t)
+ (setq-local treesit--explorer-last-node nil)
+ ;; Tell `desktop-save' to not save explorer buffers.
+ (when (boundp 'desktop-modes-not-to-save)
+ (unless (memq 'treesit--explorer-tree-mode
+ desktop-modes-not-to-save)
+ (push 'treesit--explorer-tree-mode
+ desktop-modes-not-to-save)))))
+ ;; Turn off explore mode.
(remove-hook 'post-command-hook
#'treesit--explorer-post-command t)
- (kill-buffer treesit--explorer-buffer)))
+ (remove-hook 'post-command-hook
+ #'treesit--explorer-kill-explorer-buffer t)
+ (treesit--explorer-kill-explorer-buffer)))
;;; Install & build language grammar
@@ -2696,8 +2789,10 @@ See `treesit-language-source-alist' for details."
(if (equal string "") nil string)))
(list
lang
- (read-string
- "Enter the URL of the Git repository of the language grammar: ")
+ (let ((repo-default (format
"https://github.com/tree-sitter/tree-sitter-%s"; lang)))
+ (read-string
+ "Enter the URL of the Git repository of the language grammar: "
+ (and (treesit--check-repo-url repo-default) repo-default)))
(empty-string-to-nil
(read-string
"Enter the tag or branch (default: default branch): "))
@@ -2711,6 +2806,16 @@ See `treesit-language-source-alist' for details."
(read-string
"Enter the C++ compiler to use (default: auto-detect): "))))))
+(defun treesit--check-repo-url (url)
+ (defvar url-request-method)
+ (let ((url-request-method "HEAD"))
+ (let ((buffer (condition-case nil (url-retrieve-synchronously url t t)
+ (file-error nil))))
+ (and buffer
+ (eql
+ (buffer-local-value 'url-http-response-status buffer)
+ 200)))))
+
;;;###autoload
(defun treesit-install-language-grammar (lang)
"Build and install the tree-sitter language grammar library for LANG.
diff --git a/lisp/use-package/use-package-core.el
b/lisp/use-package/use-package-core.el
index 379e119b60f..7ab5bdc276f 100644
--- a/lisp/use-package/use-package-core.el
+++ b/lisp/use-package/use-package-core.el
@@ -65,7 +65,7 @@
:link '(custom-manual "(use-package) Top")
:version "29.1")
-(defconst use-package-version "2.4.4"
+(defconst use-package-version "2.4.5"
"This version of `use-package'.")
(defcustom use-package-keywords
diff --git a/lisp/use-package/use-package.el b/lisp/use-package/use-package.el
index 7682468522d..1b63a6d651a 100644
--- a/lisp/use-package/use-package.el
+++ b/lisp/use-package/use-package.el
@@ -5,7 +5,7 @@
;; Author: John Wiegley <johnw@newartisans.com>
;; Maintainer: John Wiegley <johnw@newartisans.com>
;; Created: 17 Jun 2012
-;; Version: 2.4.4
+;; Version: 2.4.5
;; Package-Requires: ((emacs "24.3") (bind-key "2.4"))
;; Keywords: dotemacs startup speed config package extensions
;; URL: https://github.com/jwiegley/use-package
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index acfd2c30f0c..eb01dede56e 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -485,17 +485,19 @@ use the face `diff-removed' for removed lines, and the
face
;; if below, use `diff-added'.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
- (if (save-excursion (re-search-backward
diff-context-mid-hunk-header-re limit t))
- diff-indicator-added-face
- diff-indicator-removed-face)))))
+ (when (< limit (point))
+ (if (save-excursion (re-search-backward
diff-context-mid-hunk-header-re limit t))
+ diff-indicator-added-face
+ diff-indicator-removed-face))))))
(2 (if diff-use-changed-face
'diff-changed-unspecified
;; Otherwise, use the same method as above.
(save-match-data
(let ((limit (save-excursion (diff-beginning-of-hunk))))
- (if (save-excursion (re-search-backward
diff-context-mid-hunk-header-re limit t))
- 'diff-added
- 'diff-removed))))))
+ (when (< limit (point))
+ (if (save-excursion (re-search-backward
diff-context-mid-hunk-header-re limit t))
+ 'diff-added
+ 'diff-removed)))))))
("^\\(?:Index\\|revno\\): \\(.+\\).*\n"
(0 'diff-header) (1 'diff-index prepend))
("^\\(?:index .*\\.\\.\\|diff \\).*\n" . 'diff-header)
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index 6443f6d57aa..f66e37fffa4 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -381,7 +381,9 @@ If PROMPT is non-nil, prompt for the Bzr command to run."
(setq-local compile-command
(concat vc-bzr-program " " command " "
(if args (mapconcat #'identity args " ") "")))))
- (vc-set-async-update buf))))
+ (vc-set-async-update buf)
+ ;; Return the process for `vc-pull-and-push'
+ (get-buffer-process buf))))
(defun vc-bzr-pull (prompt)
"Pull changes into the current Bzr branch.
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 312556f644a..53d58870b32 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -325,7 +325,6 @@ See `run-hooks'."
(define-key map "U" #'vc-dir-unmark-all-files)
(define-key map "\C-?" #'vc-dir-unmark-file-up)
(define-key map "\M-\C-?" #'vc-dir-unmark-all-files)
- (define-key map "%" #'vc-dir-mark-by-regexp)
;; Movement.
(define-key map "n" #'vc-dir-next-line)
(define-key map " " #'vc-dir-next-line)
@@ -361,8 +360,13 @@ See `run-hooks'."
(define-key branch-map "l" #'vc-print-branch-log)
(define-key branch-map "s" #'vc-switch-branch))
+ (let ((regexp-map (make-sparse-keymap)))
+ (define-key map "%" regexp-map)
+ (define-key regexp-map "m" #'vc-dir-mark-by-regexp))
+
(let ((mark-map (make-sparse-keymap)))
(define-key map "*" mark-map)
+ (define-key mark-map "%" #'vc-dir-mark-by-regexp)
(define-key mark-map "r" #'vc-dir-mark-registered-files))
;; Hook up the menu.
@@ -791,7 +795,7 @@ MARK-FILES should be a list of absolute filenames."
vc-ewoc))
(defun vc-dir-mark-registered-files ()
- "Mark files that are in one of registered state: edited, added or removed."
+ "Mark files that are in one of registered states: edited, added or removed."
(interactive)
(vc-dir-mark-state-files '(edited added removed)))
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index e1a3eff448d..fd5f655a0f6 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -608,7 +608,10 @@ reverting. NOQUERY should be t *only* if it is known the
only
difference between the buffer and the file is due to
modifications by the dispatcher client code, rather than user
editing!"
- (and (string= buffer-file-name file)
+ (and (string= buffer-file-name
+ (if (file-name-absolute-p file)
+ file
+ (expand-file-name file (vc-root-dir))))
(if keep
(when (file-exists-p file)
(when reset-vc-info
@@ -643,7 +646,10 @@ editing!"
(defun vc-resynch-buffer (file &optional keep noquery reset-vc-info)
"If FILE is currently visited, resynch its buffer."
- (if (string= buffer-file-name file)
+ (if (string= buffer-file-name
+ (if (file-name-absolute-p file)
+ file
+ (expand-file-name file (vc-root-dir))))
(vc-resynch-window file keep noquery reset-vc-info)
(if (file-directory-p file)
(vc-resynch-buffers-in-directory file keep noquery reset-vc-info)
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 7689d5f879f..a3469b71386 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1289,6 +1289,7 @@ If PROMPT is non-nil, prompt for the Git command to run."
(lambda (_name-of-mode) buffer)
nil))))
(vc-set-async-update buffer)
+ ;; Return the process for `vc-pull-and-push'
proc))
(defun vc-git-pull (prompt)
@@ -1303,25 +1304,6 @@ Normally, this runs \"git push\". If PROMPT is non-nil,
prompt
for the Git command to run."
(vc-git--pushpull "push" prompt nil))
-(defun vc-git-pull-and-push (prompt)
- "Pull changes into the current Git branch, and then push.
-The push will only be performed if the pull was successful.
-
-Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
-for the Git command to run."
- (let ((proc (vc-git--pushpull "pull" prompt '("--stat"))))
- (when (process-buffer proc)
- (with-current-buffer (process-buffer proc)
- (if (and (eq (process-status proc) 'exit)
- (zerop (process-exit-status proc)))
- (let ((vc--inhibit-async-window t))
- (vc-git-push nil))
- (vc-exec-after
- (lambda ()
- (let ((vc--inhibit-async-window t))
- (vc-git-push nil)))
- proc))))))
-
(defun vc-git-merge-branch ()
"Merge changes into the current Git branch.
This prompts for a branch to merge from."
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 13124509c27..72160c35f57 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3064,16 +3064,28 @@ On a distributed version control system, this runs a
\"pull\"
operation on the current branch, prompting for the precise
command if required. Optional prefix ARG non-nil forces a prompt
for the VCS command to run. If this is successful, a \"push\"
-operation will then be done.
+operation will then be done. This is supported only in backends
+where the pull operation returns a process.
On a non-distributed version control system, this signals an error.
It also signals an error in a Bazaar bound branch."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset t))
(backend (car vc-fileset)))
- (if (vc-find-backend-function backend 'pull-and-push)
- (vc-call-backend backend 'pull-and-push arg)
- (user-error "VC pull-and-push is unsupported for `%s'" backend))))
+ (if (vc-find-backend-function backend 'pull)
+ (let ((proc (vc-call-backend backend 'pull arg)))
+ (when (and (processp proc) (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (if (and (eq (process-status proc) 'exit)
+ (zerop (process-exit-status proc)))
+ (let ((vc--inhibit-async-window t))
+ (vc-push arg))
+ (vc-exec-after
+ (lambda ()
+ (let ((vc--inhibit-async-window t))
+ (vc-push arg)))
+ proc)))))
+ (user-error "VC pull is unsupported for `%s'" backend))))
(defun vc-version-backup-file (file &optional rev)
"Return name of backup file for revision REV of FILE.
diff --git a/lisp/window.el b/lisp/window.el
index 4099b707009..0cd30822ff6 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5670,8 +5670,11 @@ the original point in both windows."
(defun split-window-below (&optional size window-to-split)
"Split WINDOW-TO-SPLIT into two windows, one above the other.
-WINDOW-TO-SPLIT is above. The newly split-off window is
-below and displays the same buffer. Return the new window.
+WINDOW-TO-SPLIT defaults to the selected window if omitted or nil.
+The newly created window will be below WINDOW-TO-SPLIT and will show
+the same buffer as WINDOW-TO-SPLIT, if it is a live window, else the
+buffer shown in the WINDOW-TO-SPLIT's frame's selected window.
+Return the new window.
If optional argument SIZE is omitted or nil, both windows get the
same height, or close to it. If SIZE is positive, the upper
@@ -5691,7 +5694,9 @@ amount of redisplay; this is convenient on slow
terminals."
;; `split-window' would not signal an error here.
(error "Size of new window too small"))
(setq new-window (split-window window-to-split size))
- (unless split-window-keep-point
+ (when (and (null split-window-keep-point)
+ (or (null window-to-split)
+ (eq window-to-split (selected-window))))
(with-current-buffer (window-buffer window-to-split)
;; Use `save-excursion' around vertical movements below
;; (Bug#10971). Note: When WINDOW-TO-SPLIT's buffer has a
@@ -5732,8 +5737,11 @@ handled as in `split-window-below'."
(defun split-window-right (&optional size window-to-split)
"Split WINDOW-TO-SPLIT into two side-by-side windows.
-WINDOW-TO-SPLIT is on the left. The newly split-off window is on
-the right and displays the same buffer. Return the new window.
+WINDOW-TO-SPLIT defaults to the selected window if omitted or nil.
+The newly created window will be to the right of WINDOW-TO-SPLIT and
+will show the same buffer as WINDOW-TO-SPLIT, if it is a live window,
+else the buffer shown in the WINDOW-TO-SPLIT's frame's selected window.
+Return the new window.
If optional argument SIZE is omitted or nil, both windows get the
same width, or close to it. If SIZE is positive, the left-hand
diff --git a/lisp/woman.el b/lisp/woman.el
index dfb5e69778f..92cd425d32f 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -2355,7 +2355,7 @@ Currently set only from \\='\\\" t in the first line of
the source file.")
(point-max)))
(defun woman-horizontal-escapes (to)
- "Process \\h'+/-N' local horizontal motion escapes upto TO.
+ "Process \\h'+/-N' local horizontal motion escapes up to TO.
Implements arbitrary forward and non-overlapping backward motion.
Preserves location of `point'."
;; Moved from `woman-decode-region' for version 0.50.
@@ -3346,7 +3346,7 @@ Ignore the default face and underline only word
characters."
(defun woman2-tr (to)
".tr abcde -- Translate a -> b, c -> d, ..., e -> space.
-Format paragraphs upto TO. Supports special chars.
+Format paragraphs up to TO. Supports special chars.
\(Breaks, but should not.)"
;; This should be an update, but consing onto the front of the alist
;; has the same effect and match duplicates should not matter.
@@ -3402,7 +3402,7 @@ Format paragraphs upto TO. Supports special chars.
(defvar woman-registers ; these are all read-only
'((".H" 24) (".V" 48) ; resolution in basic units
(".g" 0) ; not groff
- ;; (Iff emulating groff need to implement groff italic correction
+ ;; (If emulating groff need to implement groff italic correction
;; \/, e.g. for pic.1)
(".i" left-margin) ; current indent
(".j" woman-adjust) ; current adjustment
@@ -3432,7 +3432,7 @@ Handle numeric arguments specially if optional argument
NUMERIC is non-nil."
(defun woman2-nr (to)
".nr R +/-N M -- Assign +/-N (wrt to previous value, if any) to register R.
The increment for auto-incrementing is set to M.
-Format paragraphs upto TO. (Breaks, but should not!)"
+Format paragraphs up to TO. (Breaks, but should not!)"
(let* ((name (buffer-substring
(point)
(progn (skip-syntax-forward "^ ") (point))))
@@ -3699,7 +3699,7 @@ regexp, \"\\(\\\\c\\)?\\n[.\\=']\"."
(defun woman2-PD (to)
".PD d -- Set the interparagraph distance to d.
-Round to whole lines, default 1 line. Format paragraphs upto TO.
+Round to whole lines, default 1 line. Format paragraphs up to TO.
\(Breaks, but should not.)"
;; .ie \\n[.$] .nr PD (v;\\$1)
;; .el .nr PD .4v>?\n[.V]
@@ -3718,7 +3718,7 @@ Round to whole lines, default 1 line. Format paragraphs
upto TO.
(setq woman-leave-blank-lines woman-interparagraph-distance))
(defun woman2-TH (to)
- ".TH n c x v m -- Begin a man page. Format paragraphs upto TO.
+ ".TH n c x v m -- Begin a man page. Format paragraphs up to TO.
n is the name of the page in chapter c; x is extra commentary;
v alters page foot left; m alters page head center.
\(Should set prevailing indent and tabs to 5.)"
@@ -3748,7 +3748,7 @@ v alters page foot left; m alters page head center.
(defun woman2-SH (to)
".SH -- Sub-head. Leave blank line and subhead.
-Format paragraphs upto TO. Set prevailing indent to 5."
+Format paragraphs up to TO. Set prevailing indent to 5."
(if (eolp) ; If no args then
(delete-char 1) ; apply to next line
(woman-unquote-args) ; else unquote to end of heading
@@ -3767,7 +3767,7 @@ Format paragraphs upto TO. Set prevailing indent to 5."
(defun woman2-SS (to)
".SS -- Sub-sub-head. Like .SH but indent heading 3 spaces.
-Format paragraphs upto TO."
+Format paragraphs up to TO."
(if (eolp) ; If no args then
(delete-char 1)) ; apply to next line.
(insert " ")
@@ -3776,7 +3776,7 @@ Format paragraphs upto TO."
(defun woman2-LP (to)
".LP,.PP -- Begin paragraph. Set prevailing indent to 5.
-Leave 1 blank line. Format paragraphs upto TO."
+Leave 1 blank line. Format paragraphs up to TO."
(woman-delete-line 1) ; ignore any arguments
(woman-interparagraph-space)
(setq woman-prevailing-indent woman-default-indent)
@@ -3786,21 +3786,21 @@ Leave 1 blank line. Format paragraphs upto TO."
(defalias 'woman2-P #'woman2-LP)
(defun woman2-ns (to)
- ".ns -- Turn on no-space mode. Format paragraphs upto TO."
+ ".ns -- Turn on no-space mode. Format paragraphs up to TO."
;; Should not cause a break!
(woman-delete-line 1) ; ignore argument(s)
(setq woman-nospace t)
(woman2-format-paragraphs to))
(defun woman2-rs (to)
- ".rs -- Turn off no-space mode. Format paragraphs upto TO."
+ ".rs -- Turn off no-space mode. Format paragraphs up to TO."
;; Should not cause a break!
(woman-delete-line 1) ; ignore argument(s)
(setq woman-nospace nil)
(woman2-format-paragraphs to))
(defun woman2-sp (to)
- ".sp N -- If N > 0 then leave 1 blank line. Format paragraphs upto TO."
+ ".sp N -- If N > 0 then leave 1 blank line. Format paragraphs up to TO."
(let ((N (if (eolp) 1 (woman-get-numeric-arg))))
(if (>= N 0)
(woman-delete-line 1) ; ignore argument(s)
@@ -3955,13 +3955,13 @@ Optional argument NUMERIC, if non-nil, means the
argument is numeric."
;;; 4. Text Filling, Adjusting, and Centering
(defun woman2-br (to)
- ".br -- Break. Leave no blank line. Format paragraphs upto TO."
+ ".br -- Break. Leave no blank line. Format paragraphs up to TO."
(woman-delete-line 1) ; ignore any arguments
(woman2-format-paragraphs to))
(defun woman2-fi (to)
".fi -- Fill subsequent output lines. Leave no blank line.
-Format paragraphs upto TO."
+Format paragraphs up to TO."
(setq woman-nofill nil)
(woman-delete-line 1) ; ignore any arguments
;; Preserve any final blank line in the nofill region:
@@ -3981,7 +3981,7 @@ for the current line length. Format paragraphs up to TO."
(defun woman2-ad (to)
".ad c -- Line adjustment is begun (once fill mode is on).
Set justification mode to c if specified.
-Format paragraphs upto TO. (Breaks, but should not.)"
+Format paragraphs up to TO. (Breaks, but should not.)"
;; c = l -- left, r -- right, c -- center, b or n -- both,
;; absent -- unchanged. Initial mode adj,both.
(setq woman-adjust
@@ -3997,7 +3997,7 @@ Format paragraphs upto TO. (Breaks, but should not.)"
(woman2-format-paragraphs to))
(defun woman2-na (to)
- ".na -- No adjusting. Format paragraphs upto TO.
+ ".na -- No adjusting. Format paragraphs up to TO.
\(Breaks, but should not.)"
(setq woman-adjust-previous woman-adjust
woman-justify-previous woman-justify
@@ -4037,7 +4037,7 @@ non-nil and non-zero."
(defvar woman-temp-indent nil)
(defun woman2-format-paragraphs (to &optional new-left)
- "Indent, fill and adjust paragraphs upto TO to current left margin.
+ "Indent, fill and adjust paragraphs up to TO to current left margin.
If optional arg NEW-LEFT is non-nil then reset current left margin.
If `woman-nofill' is non-nil then indent without filling or adjusting."
;; Blank space should only ever be output before text.
@@ -4103,7 +4103,7 @@ If `woman-nofill' is non-nil then indent without filling
or adjusting."
;;; Tagged, indented and hanging paragraphs:
(defun woman2-TP (to)
- ".TP i -- Set prevailing indent to i. Format paragraphs upto TO.
+ ".TP i -- Set prevailing indent to i. Format paragraphs up to TO.
Begin indented paragraph with hanging tag given by next text line.
If tag doesn't fit, place it on a separate line."
(let ((i (woman2-get-prevailing-indent)))
@@ -4111,7 +4111,7 @@ If tag doesn't fit, place it on a separate line."
(woman2-tagged-paragraph to i)))
(defun woman2-IP (to)
- ".IP x i -- Same as .TP with tag x. Format paragraphs upto TO."
+ ".IP x i -- Same as .TP with tag x. Format paragraphs up to TO."
(woman-interparagraph-space)
(if (eolp) ; no args
;; Like LP without resetting prevailing indent
@@ -4152,7 +4152,7 @@ If tag doesn't fit, place it on a separate line."
(defun woman2-tagged-paragraph (to i)
"Begin indented paragraph with hanging tag given by current text line.
If tag doesn't fit, leave it on separate line.
-Format paragraphs upto TO. Set prevailing indent to I."
+Format paragraphs up to TO. Set prevailing indent to I."
(if (not (looking-at "\\s *$")) ; non-empty tag
(setq woman-leave-blank-lines nil))
@@ -4206,7 +4206,7 @@ Format paragraphs upto TO. Set prevailing indent to I."
(goto-char to)))))
(defun woman2-HP (to)
- ".HP i -- Set prevailing indent to i. Format paragraphs upto TO.
+ ".HP i -- Set prevailing indent to i. Format paragraphs up to TO.
Begin paragraph with hanging indent."
(let ((i (woman2-get-prevailing-indent)))
(woman-interparagraph-space)
@@ -4228,7 +4228,7 @@ Delete line from point and eol unless LEAVE-EOL is
non-nil."
(defun woman2-RS (to)
".RS i -- Start relative indent, move left margin in distance i.
-Set prevailing indent to 5 for nested indents. Format paragraphs upto TO."
+Set prevailing indent to 5 for nested indents. Format paragraphs up to TO."
(push woman-left-margin woman-RS-left-margin)
(push woman-prevailing-indent woman-RS-prevailing-indent)
(setq woman-left-margin (+ woman-left-margin
@@ -4237,7 +4237,7 @@ Set prevailing indent to 5 for nested indents. Format
paragraphs upto TO."
(woman2-format-paragraphs to woman-left-margin))
(defun woman2-RE (to)
- ".RE -- End of relative indent. Format paragraphs upto TO.
+ ".RE -- End of relative indent. Format paragraphs up to TO.
Set prevailing indent to amount of starting .RS."
(when woman-RS-left-margin
(setq woman-left-margin (pop woman-RS-left-margin)))
@@ -4274,18 +4274,18 @@ otherwise set PREVIOUS. Delete the whole remaining
control line."
(defun woman2-ll (to)
".ll +/-N -- Set, increment or decrement line length.
-Format paragraphs upto TO. (Breaks, but should not.)"
+Format paragraphs up to TO. (Breaks, but should not.)"
(woman-set-arg 'fill-column 'woman-ll-fill-column)
(woman2-format-paragraphs to))
(defun woman2-in (to)
".in +/-N -- Set, increment or decrement the indent.
-Format paragraphs upto TO."
+Format paragraphs up to TO."
(woman-set-arg 'left-margin 'woman-in-left-margin)
(woman2-format-paragraphs to))
(defun woman2-ti (to)
- ".ti +/-N -- Temporary indent. Format paragraphs upto TO."
+ ".ti +/-N -- Temporary indent. Format paragraphs up to TO."
;; Ignore if no argument.
;; Indent next output line only wrt current indent.
;; Current indent is not changed.
@@ -4300,7 +4300,7 @@ Format paragraphs upto TO."
".ta Nt ... -- Set tabs, left type, unless t=R(right), C(centered).
\(Breaks, but should not.) The tab stops are separated by spaces;
a value preceded by + represents an increment to the previous stop value.
-Format paragraphs upto TO."
+Format paragraphs up to TO."
(setq tab-stop-list nil)
(woman2-process-escapes-to-eol 'numeric)
(save-excursion
@@ -4350,7 +4350,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R
or C."
(insert ?\s))))
(defun woman2-DT (to)
- ".DT -- Restore default tabs. Format paragraphs upto TO.
+ ".DT -- Restore default tabs. Format paragraphs up to TO.
\(Breaks, but should not.)"
;; Currently just terminates special tab processing.
(setq tab-stop-list nil)
@@ -4359,7 +4359,7 @@ tab stop columns or pairs (COLUMN . TYPE) where TYPE is R
or C."
(defun woman2-fc (to)
".fc a b -- Set field delimiter a and pad character b.
-Format paragraphs upto TO.
+Format paragraphs up to TO.
A VERY FIRST ATTEMPT to make fields at least readable!
Needs doing properly!"
(if (eolp)
@@ -4395,7 +4395,7 @@ Needs doing properly!"
(defun woman2-TS (to)
".TS -- Start of table code for the tbl processor.
-Format paragraphs upto TO."
+Format paragraphs up to TO."
(when woman-emulate-tbl
;; Assumes column separator is \t and intercolumn spacing is 3.
;; The first line may optionally be a list of options terminated by
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index adfa480bc0f..4ccd35d5277 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -151,16 +151,22 @@ If `xterm-mouse-utf-8' was non-nil when
`turn-on-xterm-mouse-tracking-on-terminal' was called, reads the
coordinate as an UTF-8 code unit sequence; otherwise, reads a
single byte."
- (let ((previous-keyboard-coding-system (keyboard-coding-system)))
+ (let ((previous-keyboard-coding-system (keyboard-coding-system))
+ (utf-8-p (terminal-parameter nil 'xterm-mouse-utf-8))
+ ;; Prevent conversions inside 'read-char' due to input method,
+ ;; when we call 'read-char' below with 2nd argument non-nil.
+ (input-method-function nil))
(unwind-protect
(progn
- (set-keyboard-coding-system
- (if (terminal-parameter nil 'xterm-mouse-utf-8)
- 'utf-8-unix
- 'no-conversion))
- ;; Wait only a little; we assume that the entire escape sequence
- ;; has already been sent when this function is called.
- (read-char nil nil 0.1))
+ (set-keyboard-coding-system (if utf-8-p 'utf-8-unix 'no-conversion))
+ (read-char nil
+ ;; Force 'read-char' to decode UTF-8 sequences if
+ ;; 'xterm-mouse-utf-8' is non-nil.
+ utf-8-p
+ ;; Wait only a little; we assume that the entire
+ ;; escape sequence has already been sent when
+ ;; this function is called.
+ 0.1))
(set-keyboard-coding-system previous-keyboard-coding-system))))
;; In default mode, each numeric parameter of XTerm's mouse report is
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index 903461a2f4a..70f6cd17d78 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -63,7 +63,7 @@ AUTO_DEPEND = @AUTO_DEPEND@
DEPDIR = deps
ifeq ($(AUTO_DEPEND),yes)
DEPFLAGS = -MMD -MF $(DEPDIR)/$*.d -MP
- -include $(ALLOBJS:%.o=$(DEPDIR)/%.d)
+ -include $(OBJS:%.o=$(DEPDIR)/%.d)
else
DEPFLAGS =
include $(srcdir)/deps.mk
diff --git a/m4/acl.m4 b/m4/acl.m4
index 6c2db7d3203..dc9853a156d 100644
--- a/m4/acl.m4
+++ b/m4/acl.m4
@@ -1,5 +1,5 @@
# acl.m4 - check for access control list (ACL) primitives
-# serial 25
+# serial 27
# Copyright (C) 2002, 2004-2023 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -17,7 +17,7 @@ AC_DEFUN([gl_FUNC_ACL_ARG],
])
-AC_DEFUN([gl_FUNC_ACL],
+AC_DEFUN_ONCE([gl_FUNC_ACL],
[
AC_REQUIRE([gl_FUNC_ACL_ARG])
AC_CHECK_FUNCS_ONCE([fchmod])
@@ -141,7 +141,6 @@ int type = ACL_TYPE_EXTENDED;]])],
fi
if test -n "$gl_need_lib_has_acl"; then
FILE_HAS_ACL_LIB=$LIB_ACL
- LIB_HAS_ACL="$FILE_HAS_ACL_LIB"
fi
AC_SUBST([LIB_ACL])
AC_DEFINE_UNQUOTED([USE_ACL], [$use_acl],
@@ -211,7 +210,4 @@ AC_DEFUN([gl_FILE_HAS_ACL],
FILE_HAS_ACL_LIB=$LIB_ACL
fi
AC_SUBST([FILE_HAS_ACL_LIB])
- dnl For backward compatibility (e.g. coreutils still uses LIB_HAS_ACL).
- LIB_HAS_ACL="$FILE_HAS_ACL_LIB"
- AC_SUBST([LIB_HAS_ACL])
])
diff --git a/m4/assert_h.m4 b/m4/assert_h.m4
index 6275f633a69..3801452ef0d 100644
--- a/m4/assert_h.m4
+++ b/m4/assert_h.m4
@@ -18,7 +18,7 @@ AC_DEFUN([gl_ASSERT_H],
[AC_LANG_PROGRAM(
[[#if defined __clang__ && __STDC_VERSION__ < 202311
#pragma clang diagnostic error "-Wc2x-extensions"
- #pragma clang diagnostic error "-Wc++17-extensions"
+ #pragma clang diagnostic error "-Wc++1z-extensions"
#endif
#ifdef INCLUDE_ASSERT_H
#include <assert.h>
@@ -60,7 +60,7 @@ AC_DEFUN([gl_ASSERT_H],
/* Solaris 11.4 <assert.h> defines static_assert as a macro with 2 arguments.
We need it also to be invocable with a single argument. */
#if defined __sun && (__STDC_VERSION__ - 0 >= 201112L) && !defined __cplusplus
- #undef static_assert
+ #undef/**/static_assert
#define static_assert _Static_assert
#endif
#endif])
diff --git a/m4/clock_time.m4 b/m4/clock_time.m4
index 411e0710e7f..d624a73d35d 100644
--- a/m4/clock_time.m4
+++ b/m4/clock_time.m4
@@ -1,14 +1,14 @@
-# clock_time.m4 serial 11
+# clock_time.m4 serial 12
dnl Copyright (C) 2002-2006, 2009-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
# Check for clock_getres, clock_gettime and clock_settime,
-# and set LIB_CLOCK_GETTIME.
+# and set CLOCK_TIME_LIB.
# For a program named, say foo, you should add a line like the following
# in the corresponding Makefile.am file:
-# foo_LDADD = $(LDADD) $(LIB_CLOCK_GETTIME)
+# foo_LDADD = $(LDADD) $(CLOCK_TIME_LIB)
AC_DEFUN([gl_CLOCK_TIME],
[
@@ -21,12 +21,15 @@ AC_DEFUN([gl_CLOCK_TIME],
# Save and restore LIBS so e.g., -lrt, isn't added to it. Otherwise, *all*
# programs in the package would end up linked with that potentially-shared
# library, inducing unnecessary run-time overhead.
- LIB_CLOCK_GETTIME=
- AC_SUBST([LIB_CLOCK_GETTIME])
+ CLOCK_TIME_LIB=
+ AC_SUBST([CLOCK_TIME_LIB])
gl_saved_libs=$LIBS
AC_SEARCH_LIBS([clock_gettime], [rt posix4],
[test "$ac_cv_search_clock_gettime" = "none required" ||
- LIB_CLOCK_GETTIME=$ac_cv_search_clock_gettime])
+ CLOCK_TIME_LIB=$ac_cv_search_clock_gettime])
AC_CHECK_FUNCS([clock_getres clock_gettime clock_settime])
LIBS=$gl_saved_libs
+ # For backward compatibility.
+ LIB_CLOCK_GETTIME="$CLOCK_TIME_LIB"
+ AC_SUBST([LIB_CLOCK_GETTIME])
])
diff --git a/m4/euidaccess.m4 b/m4/euidaccess.m4
index 0dc757820ee..f0eb5bde84a 100644
--- a/m4/euidaccess.m4
+++ b/m4/euidaccess.m4
@@ -1,4 +1,4 @@
-# euidaccess.m4 serial 15
+# euidaccess.m4 serial 16
dnl Copyright (C) 2002-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -41,12 +41,15 @@ AC_DEFUN([gl_PREREQ_EUIDACCESS], [
# Save and restore LIBS so -lgen isn't added to it. Otherwise, *all*
# programs in the package would end up linked with that potentially-shared
# library, inducing unnecessary run-time overhead.
- LIB_EACCESS=
- AC_SUBST([LIB_EACCESS])
+ EUIDACCESS_LIBGEN=
+ AC_SUBST([EUIDACCESS_LIBGEN])
gl_saved_libs=$LIBS
AC_SEARCH_LIBS([eaccess], [gen],
[test "$ac_cv_search_eaccess" = "none required" ||
- LIB_EACCESS=$ac_cv_search_eaccess])
+ EUIDACCESS_LIBGEN=$ac_cv_search_eaccess])
AC_CHECK_FUNCS([eaccess])
LIBS=$gl_saved_libs
+ # For backward compatibility.
+ LIB_EACCESS="$EUIDACCESS_LIBGEN"
+ AC_SUBST([LIB_EACCESS])
])
diff --git a/m4/getrandom.m4 b/m4/getrandom.m4
index f2010c0213f..c508f1a55c3 100644
--- a/m4/getrandom.m4
+++ b/m4/getrandom.m4
@@ -1,4 +1,4 @@
-# getrandom.m4 serial 9
+# getrandom.m4 serial 10
dnl Copyright 2020-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -62,13 +62,16 @@ AC_DEFUN([gl_FUNC_GETRANDOM],
if test $gl_cv_lib_assume_bcrypt = yes; then
AC_DEFINE([HAVE_LIB_BCRYPT], [1],
[Define to 1 if the bcrypt library is guaranteed to be present.])
- LIB_GETRANDOM='-lbcrypt'
+ GETRANDOM_LIB='-lbcrypt'
else
- LIB_GETRANDOM='-ladvapi32'
+ GETRANDOM_LIB='-ladvapi32'
fi
;;
*)
- LIB_GETRANDOM= ;;
+ GETRANDOM_LIB= ;;
esac
+ AC_SUBST([GETRANDOM_LIB])
+ dnl For backward compatibility.
+ LIB_GETRANDOM="$GETRANDOM_LIB"
AC_SUBST([LIB_GETRANDOM])
])
diff --git a/m4/gettime.m4 b/m4/gettime.m4
index 06f32fe26c2..7e353fcd00e 100644
--- a/m4/gettime.m4
+++ b/m4/gettime.m4
@@ -1,4 +1,4 @@
-# gettime.m4 serial 12
+# gettime.m4 serial 13
dnl Copyright (C) 2002, 2004-2006, 2009-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -26,17 +26,24 @@ AC_DEFUN([gl_CHECK_FUNC_TIMESPEC_GET],
dnl We can't use AC_CHECK_FUNC here, because timespec_get() is defined as a
dnl static inline function in <time.h> on MSVC 14.
- AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get],
- [AC_LINK_IFELSE(
- [AC_LANG_PROGRAM(
- [[#include <time.h>
- struct timespec ts;
- ]],
- [[return timespec_get (&ts, 0);]])
- ],
- [gl_cv_func_timespec_get=yes],
- [gl_cv_func_timespec_get=no])
- ])
+ dnl But at the same time, we need to notice a missing declaration, like
+ dnl gl_CHECK_FUNCS_ANDROID does.
+ AC_CHECK_DECL([timespec_get], , , [[#include <time.h>]])
+ if test $ac_cv_have_decl_timespec_get = yes; then
+ AC_CACHE_CHECK([for timespec_get], [gl_cv_func_timespec_get],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <time.h>
+ struct timespec ts;
+ ]],
+ [[return timespec_get (&ts, 0);]])
+ ],
+ [gl_cv_func_timespec_get=yes],
+ [gl_cv_func_timespec_get=no])
+ ])
+ else
+ gl_cv_func_timespec_get=no
+ fi
])
AC_DEFUN([gl_GETTIME_RES],
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 26239caa2b1..2db3376b01e 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -71,7 +71,7 @@ AC_DEFUN([gl_COMMON_BODY], [
&& (!defined __clang_minor__ \
|| (defined __apple_build_version__ \
? 6000000 <= __apple_build_version__ \
- : 3 < __clang_major__ + (5 <= __clang_minor__))))
+ : 5 <= __clang_major__)))
# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
#else
# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index ae5001c44b5..10c74fa2392 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -456,6 +456,14 @@ AC_DEFUN([gl_INIT],
gl_PREREQ_PTHREAD_SIGMASK
])
gl_SIGNAL_MODULE_INDICATOR([pthread_sigmask])
+ gl_FUNC_XATTR
+ AC_REQUIRE([gl_FUNC_ACL])
+ if test "$use_xattr" = yes; then
+ QCOPY_ACL_LIB="$LIB_XATTR"
+ else
+ QCOPY_ACL_LIB="$LIB_ACL"
+ fi
+ AC_SUBST([QCOPY_ACL_LIB])
gl_FUNC_READLINK
gl_CONDITIONAL([GL_COND_OBJ_READLINK],
[test $HAVE_READLINK = 0 || test $REPLACE_READLINK = 1])
@@ -1543,5 +1551,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/warnings.m4
m4/wchar_t.m4
m4/wint_t.m4
+ m4/xattr.m4
m4/zzgnulib.m4
])
diff --git a/m4/nanosleep.m4 b/m4/nanosleep.m4
index 21ee5a21daf..e21a3e343cb 100644
--- a/m4/nanosleep.m4
+++ b/m4/nanosleep.m4
@@ -1,4 +1,4 @@
-# serial 42
+# serial 43
dnl From Jim Meyering.
dnl Check for the nanosleep function.
@@ -25,11 +25,11 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
# Solaris 2.5.1 needs -lposix4 to get the nanosleep function.
# Solaris 7 prefers the library name -lrt to the obsolescent name -lposix4.
- LIB_NANOSLEEP=
- AC_SUBST([LIB_NANOSLEEP])
+ NANOSLEEP_LIB=
+ AC_SUBST([NANOSLEEP_LIB])
AC_SEARCH_LIBS([nanosleep], [rt posix4],
[test "$ac_cv_search_nanosleep" = "none required" ||
- LIB_NANOSLEEP=$ac_cv_search_nanosleep])
+ NANOSLEEP_LIB=$ac_cv_search_nanosleep])
if test "x$ac_cv_search_nanosleep" != xno; then
dnl The system has a nanosleep function.
@@ -143,4 +143,8 @@ AC_DEFUN([gl_FUNC_NANOSLEEP],
HAVE_NANOSLEEP=0
fi
LIBS=$nanosleep_save_libs
+
+ # For backward compatibility.
+ LIB_NANOSLEEP="$NANOSLEEP_LIB"
+ AC_SUBST([LIB_NANOSLEEP])
])
diff --git a/m4/pthread_sigmask.m4 b/m4/pthread_sigmask.m4
index 5110668155e..27795282bee 100644
--- a/m4/pthread_sigmask.m4
+++ b/m4/pthread_sigmask.m4
@@ -1,4 +1,4 @@
-# pthread_sigmask.m4 serial 21
+# pthread_sigmask.m4 serial 22
dnl Copyright (C) 2011-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -24,7 +24,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
[gl_cv_func_pthread_sigmask_macro=no])
])
- LIB_PTHREAD_SIGMASK=
+ PTHREAD_SIGMASK_LIB=
if test $gl_cv_func_pthread_sigmask_macro = yes; then
dnl pthread_sigmask is a dummy macro.
@@ -62,7 +62,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
])
if test $gl_cv_func_pthread_sigmask_in_LIBMULTITHREAD = yes; then
dnl pthread_sigmask is available with -pthread or -lpthread.
- LIB_PTHREAD_SIGMASK="$LIBMULTITHREAD"
+ PTHREAD_SIGMASK_LIB="$LIBMULTITHREAD"
else
dnl pthread_sigmask is not available at all.
HAVE_PTHREAD_SIGMASK=0
@@ -101,6 +101,9 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
])
fi
+ AC_SUBST([PTHREAD_SIGMASK_LIB])
+ dnl For backward compatibility.
+ LIB_PTHREAD_SIGMASK="$PTHREAD_SIGMASK_LIB"
AC_SUBST([LIB_PTHREAD_SIGMASK])
dnl We don't need a variable LTLIB_PTHREAD_SIGMASK, because when
dnl "$gl_threads_api" = posix, $LTLIBMULTITHREAD and $LIBMULTITHREAD are the
@@ -114,7 +117,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
dnl On FreeBSD 13.0, MidnightBSD 1.1, HP-UX 11.31, Solaris 9, in programs
dnl that are not linked with -lpthread, the pthread_sigmask() function
dnl always returns 0 and has no effect.
- if test -z "$LIB_PTHREAD_SIGMASK"; then
+ if test -z "$PTHREAD_SIGMASK_LIB"; then
case " $LIBS " in
*' -pthread '*) ;;
*' -lpthread '*) ;;
@@ -162,7 +165,7 @@ AC_DEFUN([gl_FUNC_PTHREAD_SIGMASK],
[gl_cv_func_pthread_sigmask_return_works],
[
gl_save_LIBS="$LIBS"
- LIBS="$LIBS $LIB_PTHREAD_SIGMASK"
+ LIBS="$LIBS $PTHREAD_SIGMASK_LIB"
AC_RUN_IFELSE(
[AC_LANG_SOURCE([[
#include <pthread.h>
@@ -208,7 +211,7 @@ int main ()
gl_cv_func_pthread_sigmask_unblock_works="guessing yes";;
esac
m4_ifdef([gl_][THREADLIB],
- [dnl Link against $LIBMULTITHREAD, not only $LIB_PTHREAD_SIGMASK.
+ [dnl Link against $LIBMULTITHREAD, not only $PTHREAD_SIGMASK_LIB.
dnl Otherwise we get a false positive on those platforms where
dnl $gl_cv_func_pthread_sigmask_in_libc_works is "no".
gl_save_LIBS=$LIBS
diff --git a/m4/timer_time.m4 b/m4/timer_time.m4
index 4c2608b58e8..437d1dc5428 100644
--- a/m4/timer_time.m4
+++ b/m4/timer_time.m4
@@ -1,10 +1,10 @@
-# timer_time.m4 serial 5
+# timer_time.m4 serial 6
dnl Copyright (C) 2011-2023 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
-# Check for timer_settime, and set LIB_TIMER_TIME.
+# Check for timer_settime, and set TIMER_TIME_LIB.
AC_DEFUN([gl_TIMER_TIME],
[
@@ -21,13 +21,13 @@ AC_DEFUN([gl_TIMER_TIME],
AC_CHECK_DECL([timer_settime], [], [],
[[#include <time.h>
]])
- LIB_TIMER_TIME=
- AC_SUBST([LIB_TIMER_TIME])
+ TIMER_TIME_LIB=
+ AC_SUBST([TIMER_TIME_LIB])
AS_IF([test "$ac_cv_have_decl_timer_settime" = yes], [
gl_saved_libs=$LIBS
AC_SEARCH_LIBS([timer_settime], [rt posix4],
[test "$ac_cv_search_timer_settime" = "none required" ||
- LIB_TIMER_TIME=$ac_cv_search_timer_settime])
+ TIMER_TIME_LIB=$ac_cv_search_timer_settime])
m4_ifdef([gl_][PTHREADLIB],
[dnl GLIBC uses threads to emulate posix timers when kernel support
dnl is not available (like Linux < 2.6 or when used with kFreeBSD)
@@ -42,8 +42,11 @@ AC_DEFUN([gl_TIMER_TIME],
#endif
#endif
],
- [LIB_TIMER_TIME="$LIB_TIMER_TIME $LIBPMULTITHREAD"])])
+ [TIMER_TIME_LIB="$TIMER_TIME_LIB $LIBPMULTITHREAD"])])
AC_CHECK_FUNCS([timer_settime])
LIBS=$gl_saved_libs
])
+ dnl For backward compatibility.
+ LIB_TIMER_TIME="$TIMER_TIME_LIB"
+ AC_SUBST([LIB_TIMER_TIME])
])
diff --git a/m4/utimens.m4 b/m4/utimens.m4
index ae35ef789b8..c5d9b69e6f5 100644
--- a/m4/utimens.m4
+++ b/m4/utimens.m4
@@ -3,7 +3,7 @@ dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
dnl with or without modifications, as long as this notice is preserved.
-dnl serial 11
+dnl serial 12
AC_DEFUN([gl_UTIMENS],
[
@@ -11,7 +11,9 @@ AC_DEFUN([gl_UTIMENS],
AC_REQUIRE([gl_FUNC_UTIMES])
AC_REQUIRE([gl_CHECK_TYPE_STRUCT_TIMESPEC])
AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
- AC_CHECK_FUNCS_ONCE([futimes futimesat futimens utimensat lutimes])
+ AC_CHECK_FUNCS_ONCE([futimens utimensat lutimes])
+ gl_CHECK_FUNCS_ANDROID([futimes], [[#include <sys/time.h>]])
+ gl_CHECK_FUNCS_ANDROID([futimesat], [[#include <sys/time.h>]])
if test $ac_cv_func_futimens = no && test $ac_cv_func_futimesat = yes; then
dnl FreeBSD 8.0-rc2 mishandles futimesat(fd,NULL,time). It is not
diff --git a/m4/xattr.m4 b/m4/xattr.m4
new file mode 100644
index 00000000000..0e179cc0d1d
--- /dev/null
+++ b/m4/xattr.m4
@@ -0,0 +1,53 @@
+# xattr.m4 - check for Extended Attributes (Linux)
+# serial 6
+
+# Copyright (C) 2003-2023 Free Software Foundation, Inc.
+# This file is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+AC_DEFUN([gl_FUNC_XATTR],
+[
+ AC_ARG_ENABLE([xattr],
+ AS_HELP_STRING([--disable-xattr],
+ [do not support extended attributes]),
+ [use_xattr=$enableval], [use_xattr=yes])
+
+ LIB_XATTR=
+ AC_SUBST([LIB_XATTR])
+
+ if test "$use_xattr" = yes; then
+ AC_CACHE_CHECK([for xattr library with ATTR_ACTION_PERMISSIONS],
+ [gl_cv_xattr_lib],
+ [gl_cv_xattr_lib=no
+ AC_LANG_CONFTEST(
+ [AC_LANG_PROGRAM(
+ [[#include <attr/error_context.h>
+ #include <attr/libattr.h>
+ static int
+ is_attr_permissions (const char *name, struct error_context *ctx)
+ {
+ return attr_copy_action (name, ctx) == ATTR_ACTION_PERMISSIONS;
+ }
+ ]],
+ [[return attr_copy_fd ("/", 0, "/", 0, is_attr_permissions, 0);
+ ]])])
+ AC_LINK_IFELSE([],
+ [gl_cv_xattr_lib='none required'],
+ [xattr_saved_LIBS=$LIBS
+ LIBS="-lattr $LIBS"
+ AC_LINK_IFELSE([], [gl_cv_xattr_lib=-lattr])
+ LIBS=$xattr_saved_LIBS])])
+ if test "$gl_cv_xattr_lib" = no; then
+ AC_MSG_WARN([libattr development library was not found or not usable.])
+ AC_MSG_WARN([AC_PACKAGE_NAME will be built without xattr support.])
+ use_xattr=no
+ elif test "$gl_cv_xattr_lib" != 'none required'; then
+ LIB_XATTR=$gl_cv_xattr_lib
+ fi
+ fi
+ if test "$use_xattr" = yes; then
+ AC_DEFINE([USE_XATTR], [1],
+ [Define to 1 to use the Linux extended attributes library.])
+ fi
+])
diff --git a/msdos/autogen/Makefile.in b/msdos/autogen/Makefile.in
index 7f44c9867fe..df9b7797989 100644
--- a/msdos/autogen/Makefile.in
+++ b/msdos/autogen/Makefile.in
@@ -921,13 +921,11 @@ LIBXT_OTHER = @LIBXT_OTHER@
LIBX_OTHER = @LIBX_OTHER@
LIBZ = @LIBZ@
LIB_ACL = @LIB_ACL@
-LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
-LIB_EACCESS = @LIB_EACCESS@
+CLOCK_TIME_LIB = @CLOCK_TIME_LIB@
+EUIDACCESS_LIBGEN = @EUIDACCESS_LIBGEN@
LIB_EXECINFO = @LIB_EXECINFO@
-LIB_FDATASYNC = @LIB_FDATASYNC@
LIB_MATH = @LIB_MATH@
LIB_PTHREAD = @LIB_PTHREAD@
-LIB_PTHREAD_SIGMASK = @LIB_PTHREAD_SIGMASK@
LIB_TIMER_TIME = @LIB_TIMER_TIME@
LIB_WSOCK32 = @LIB_WSOCK32@
LN_S_FILEONLY = @LN_S_FILEONLY@
diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp
index 4d4c80a6b1a..162ccb3e8d8 100644
--- a/msdos/sed1v2.inp
+++ b/msdos/sed1v2.inp
@@ -48,9 +48,8 @@ s/\.h\.in/.h-in/
/^LIB_MATH *=/s/@LIB_MATH@/-lm/
/^LIB_PTHREAD *=/s/@LIB_PTHREAD@//
/^LIB_ACL *=/s/@LIB_ACL@//
-/^LIB_EACCESS *=/s/@LIB_EACCESS@//
-/^LIB_FDATASYNC *=/s/@LIB_FDATASYNC@//
-/^LIB_NANOSLEEP *=/s/@LIB_NANOSLEEP@//
+/^EUIDACCESS_LIBGEN *=/s/@EUIDACCESS_LIBGEN@//
+/^NANOSLEEP_LIB *=/s/@NANOSLEEP_LIB@//
s/ *@LIBTIFF@//
s/ *@LIBJPEG@//
s/ *@LIBPNG@//
@@ -140,7 +139,7 @@ s/ *@WEBP_LIBS@//
/^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@//
/^LIBSYSTEMD_LIBS *=/s/@LIBSYSTEMD_LIBS@//
/^LIBSYSTEMD_CFLAGS *=/s/@LIBSYSTEMD_CFLAGS@//
-/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^CLOCK_TIME_LIB *=/s/@[^@\n]*@//g
/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
/^LIB_EXECINFO *=/s/@[^@\n]*@//g
/^LIBGNUTLS_LIBS *=/s/@[^@\n]*@//
@@ -183,6 +182,7 @@ s/ *@WEBP_LIBS@//
/^TREE_SITTER_CFLAGS *=/s/@TREE_SITTER_CFLAGS@//
/^HARFBUZZ_CFLAGS *=/s/@HARFBUZZ_CFLAGS@//
/^HARFBUZZ_LIBS *=/s/@HARFBUZZ_LIBS@//
+/^QCOPY_ACL_LIB *=/s/@QCOPY_ACL_LIB@//
/^LCMS2_CFLAGS *=/s/@LCMS2_CFLAGS@//
/^LCMS2_LIBS *=/s/@LCMS2_LIBS@//
/^LIBGMP *=/s/@LIBGMP@//
diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp
index dc9eaff27c8..9688a27b066 100644
--- a/msdos/sed3v2.inp
+++ b/msdos/sed3v2.inp
@@ -32,9 +32,9 @@
/^LIBRESOLV *=/s/@[^@\n]*@//g
/^LIBS_MAIL *=/s/@[^@\n]*@//g
/^LIBS_SYSTEM *=/s/@[^@\n]*@//g
-/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
+/^CLOCK_TIME_LIB *=/s/@[^@\n]*@//g
/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
-/^LIB_GETRANDOM *=/s/@[^@\n]*@//g
+/^GETRANDOM_LIB *=/s/@[^@\n]*@//g
/^CFLAGS *=/s!=.*$!=-O2 -g!
/^CPPFLAGS *=/s/@CPPFLAGS@//
/^LDFLAGS *=/s/@LDFLAGS@//
@@ -49,7 +49,6 @@
/^ALLOCA *=/s!@ALLOCA@!!
/^EXEEXT *=/s!@EXEEXT@!.exe!
/^CLIENTW *=/s/@CLIENTW@//
-/^LIB_FDATASYNC *=/s/@LIB_FDATASYNC@//
/^LIB_WSOCK32 *=/s/@LIB_WSOCK32@//
/^LIBS_ECLIENT *=/s/@LIBS_ECLIENT@//
/^NTLIB *=/s/@NTLIB@//
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 497aedb2096..634bf999e50 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -270,7 +270,6 @@ s/@PACKAGE@/emacs/
/^LDFLAGS *=/s/@[^@\n]*@//
/^LD_FIRSTFLAG *=/s/@[^@\n]*@//
/^LIB_PTHREAD *=/s/@[^@\n]*@//
-/^LIB_PTHREAD_SIGMASK *=/s/@[^@\n]*@//
/^LIBS *=/s/@[^@\n]*@//
/^MAKEINFO *=/s/@MAKEINFO@/makeinfo/
# MKDIR_P lines are edited further below
@@ -323,7 +322,7 @@ s/@PACKAGE@/emacs/
/^REPLACE_MKTIME *=/s/@[^@\n]*@/1/
# We don't want any other gnulib replacement functions
/^REPLACE_[^ =]* *= *@/s/@[^@\n]*@/0/
-/^LIB_GETRANDOM[^ =]* *= *@/s/@[^@\n]*@//
+/^GETRANDOM_LIB[^ =]* *= *@/s/@[^@\n]*@//
/^SIG_ATOMIC_T_SUFFIX *=/s/@SIG_ATOMIC_T_SUFFIX@//
/^SIZE_T_SUFFIX *=/s/@SIZE_T_SUFFIX@/u/
/^ASSERT_H *=/s/@[^@\n]*@/assert.h/
diff --git a/src/Makefile.in b/src/Makefile.in
index 0c1af375efd..faca7f0d608 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -144,9 +144,10 @@ M17N_FLT_CFLAGS = @M17N_FLT_CFLAGS@
M17N_FLT_LIBS = @M17N_FLT_LIBS@
LIB_ACL=@LIB_ACL@
-LIB_CLOCK_GETTIME=@LIB_CLOCK_GETTIME@
-LIB_EACCESS=@LIB_EACCESS@
-LIB_NANOSLEEP=@LIB_NANOSLEEP@
+CLOCK_TIME_LIB=@CLOCK_TIME_LIB@
+EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@
+NANOSLEEP_LIB=@NANOSLEEP_LIB@
+QCOPY_ACL_LIB=@QCOPY_ACL_LIB@
LIB_TIMER_TIME=@LIB_TIMER_TIME@
DBUS_CFLAGS = @DBUS_CFLAGS@
@@ -558,9 +559,9 @@ lisp = $(addprefix ${lispsource}/,${shortlisp})
## Construct full set of libraries to be linked.
LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(PGTK_LIBS) $(LIBX_BASE)
$(LIBIMAGE) \
$(LIBX_OTHER) $(LIBSOUND) \
- $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(LIB_CLOCK_GETTIME) \
- $(LIB_NANOSLEEP) $(WEBKIT_LIBS) \
- $(LIB_EACCESS) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
+ $(RSVG_LIBS) $(IMAGEMAGICK_LIBS) $(LIB_ACL) $(CLOCK_TIME_LIB) \
+ $(NANOSLEEP_LIB) $(QCOPY_ACL_LIB) $(WEBKIT_LIBS) \
+ $(EUIDACCESS_LIBGEN) $(LIB_TIMER_TIME) $(DBUS_LIBS) \
$(LIB_EXECINFO) $(XRANDR_LIBS) $(XINERAMA_LIBS) $(XFIXES_LIBS) \
$(XDBE_LIBS) $(XSYNC_LIBS) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
diff --git a/src/buffer.c b/src/buffer.c
index 100e42fc1f9..88ca69b0dd8 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -525,14 +525,14 @@ get_truename_buffer (register Lisp_Object filename)
return Qnil;
}
-/* Run buffer-list-update-hook if Vrun_hooks is non-nil, and BUF is NULL
- or does not have buffer hooks inhibited. BUF is NULL when called by
- make-indirect-buffer, since it does not inhibit buffer hooks. */
+/* Run buffer-list-update-hook if Vrun_hooks is non-nil and BUF does
+ not have buffer hooks inhibited. */
static void
run_buffer_list_update_hook (struct buffer *buf)
{
- if (! (NILP (Vrun_hooks) || (buf && buf->inhibit_buffer_hooks)))
+ eassert (buf);
+ if (! (NILP (Vrun_hooks) || buf->inhibit_buffer_hooks))
call1 (Vrun_hooks, Qbuffer_list_update_hook);
}
@@ -907,7 +907,7 @@ does not run the hooks `kill-buffer-hook',
set_buffer_internal_1 (old_b);
}
- run_buffer_list_update_hook (NULL);
+ run_buffer_list_update_hook (b);
return buf;
}
diff --git a/src/callint.c b/src/callint.c
index c60a376b958..d8d2b278458 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -105,11 +105,13 @@ If the string begins with `^' and `shift-select-mode' is
non-nil,
You may use `@', `*', and `^' together. They are processed in the
order that they appear, before reading any arguments.
-If MODES is present, it should be a list of mode names (symbols) that
-this command is applicable for. The main effect of this is that
-`M-x TAB' (by default) won't list this command if the current buffer's
-mode doesn't match the list. That is, if either the major mode isn't
-derived from them, or (when it's a minor mode) the mode isn't in effect.
+If MODES is present, it should be one or more mode names (symbols)
+for which this command is applicable. This is so that `M-x TAB'
+will be able to exclude this command from the list of completion
+candidates if the current buffer's mode doesn't match the list.
+Which commands are excluded from the list of completion
+candidates based on this information is controlled by the value
+of `read-extended-command-predicate', which see.
usage: (interactive &optional ARG-DESCRIPTOR &rest MODES) */
attributes: const)
diff --git a/src/ccl.c b/src/ccl.c
index 4bd83c3528b..c33bb434afd 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -1987,7 +1987,7 @@ ccl_get_compiled_code (Lisp_Object ccl_prog, ptrdiff_t
*idx)
/* Setup fields of the structure pointed by CCL appropriately for the
execution of CCL program CCL_PROG. CCL_PROG is the name (symbol)
of the CCL program or the already compiled code (vector).
- Return true iff successful.
+ Return true if successful.
If CCL_PROG is nil, just reset the structure pointed by CCL. */
bool
diff --git a/src/coding.c b/src/coding.c
index 4e59f2b6a1b..a2e0d7040f8 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -651,6 +651,12 @@ growable_destination (struct coding_system *coding)
consumed_chars++; \
} while (0)
+/* Suppress clang warnings about consumed_chars never being used.
+ Although correct, the warnings are too much trouble to code around. */
+#if 13 <= __clang_major__ - defined __apple_build_version__
+# pragma clang diagnostic ignored "-Wunused-but-set-variable"
+#endif
+
/* Safely get two bytes from the source text pointed by SRC which ends
at SRC_END, and set C1 and C2 to those bytes while skipping the
heading multibyte characters. If there are not enough bytes in the
@@ -1431,7 +1437,7 @@ encode_coding_utf_8 (struct coding_system *coding)
ptrdiff_t produced_chars = 0;
int c;
- if (CODING_UTF_8_BOM (coding) == utf_with_bom)
+ if (CODING_UTF_8_BOM (coding) != utf_without_bom)
{
ASSURE_DESTINATION (3);
EMIT_THREE_BYTES (UTF_8_BOM_1, UTF_8_BOM_2, UTF_8_BOM_3);
diff --git a/src/doc.c b/src/doc.c
index df57f84603e..174341523d7 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -330,19 +330,7 @@ string is passed through `substitute-command-keys'. */)
xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
-#ifdef HAVE_NATIVE_COMP
- if (!NILP (Fsubr_native_elisp_p (fun)))
- doc = native_function_doc (fun);
- else
-#endif
- if (SUBRP (fun))
- doc = make_fixnum (XSUBR (fun)->doc);
-#ifdef HAVE_MODULES
- else if (MODULE_FUNCTIONP (fun))
- doc = module_function_documentation (XMODULE_FUNCTION (fun));
-#endif
- else
- doc = call1 (Qfunction_documentation, fun);
+ doc = call1 (Qfunction_documentation, fun);
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
@@ -371,6 +359,25 @@ string is passed through `substitute-command-keys'. */)
return doc;
}
+DEFUN ("internal-subr-documentation", Fsubr_documentation,
Ssubr_documentation, 1, 1, 0,
+ doc: /* Return the raw documentation info of a C primitive. */)
+ (Lisp_Object function)
+{
+#ifdef HAVE_NATIVE_COMP
+ if (!NILP (Fsubr_native_elisp_p (function)))
+ return native_function_doc (function);
+ else
+#endif
+ if (SUBRP (function))
+ return make_fixnum (XSUBR (function)->doc);
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (function))
+ return module_function_documentation (XMODULE_FUNCTION (function));
+#endif
+ else
+ return Qt;
+}
+
DEFUN ("documentation-property", Fdocumentation_property,
Sdocumentation_property, 2, 3, 0,
doc: /* Return the documentation string that is SYMBOL's PROP property.
@@ -713,6 +720,7 @@ compute the correct value for the current terminal in the
nil case. */);
/* Initialized by ‘main’. */
defsubr (&Sdocumentation);
+ defsubr (&Ssubr_documentation);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Stext_quoting_style);
diff --git a/src/fns.c b/src/fns.c
index bbc9a7f9621..59d5b5c0850 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -38,6 +38,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "puresize.h"
#include "gnutls.h"
+#ifdef HAVE_TREE_SITTER
+#include "treesit.h"
+#endif
+
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
static bool internal_equal (Lisp_Object, Lisp_Object,
enum equal_kind, int, Lisp_Object);
@@ -2828,6 +2832,11 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
bool_vector_bytes (size)));
}
+#ifdef HAVE_TREE_SITTER
+ if (TS_NODEP (o1))
+ return treesit_node_eq (o1, o2);
+#endif
+
/* Aside from them, only true vectors, char-tables, compiled
functions, and fonts (font-spec, font-entity, font-object)
are sensible to compare, so eliminate the others now. */
@@ -3173,13 +3182,14 @@ DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1,
0,
Return t if answer is yes, and nil if the answer is no.
PROMPT is the string to display to ask the question; `yes-or-no-p'
-adds \"(yes or no) \" to it.
+appends `yes-or-no-prompt' (default \"(yes or no) \") to it.
The user must confirm the answer with RET, and can edit it until it
has been confirmed.
If the `use-short-answers' variable is non-nil, instead of asking for
-\"yes\" or \"no\", this function will ask for \"y\" or \"n\".
+\"yes\" or \"no\", this function will ask for \"y\" or \"n\" (and
+ignore the value of `yes-or-no-prompt').
If dialog boxes are supported, a dialog box will be used
if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil. */)
@@ -3204,8 +3214,7 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is
non-nil. */)
if (use_short_answers)
return call1 (intern ("y-or-n-p"), prompt);
- AUTO_STRING (yes_or_no, "(yes or no) ");
- prompt = CALLN (Fconcat, prompt, yes_or_no);
+ prompt = CALLN (Fconcat, prompt, Vyes_or_no_prompt);
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qenable_recursive_minibuffers, Qt);
@@ -6256,9 +6265,15 @@ When non-nil, `yes-or-no-p' will use `y-or-n-p' to read
the answer.
We recommend against setting this variable non-nil, because `yes-or-no-p'
is intended to be used when users are expected not to respond too
quickly, but to take their time and perhaps think about the answer.
-The same variable also affects the function `read-answer'. */);
+The same variable also affects the function `read-answer'. See also
+`yes-or-no-prompt'. */);
use_short_answers = false;
+ DEFVAR_LISP ("yes-or-no-prompt", Vyes_or_no_prompt,
+ doc: /* String to append when `yes-or-no-p' asks a question.
+For best results this should end in a space. */);
+ Vyes_or_no_prompt = make_unibyte_string ("(yes or no) ", strlen ("(yes or
no) "));
+
defsubr (&Sidentity);
defsubr (&Srandom);
defsubr (&Slength);
diff --git a/src/gnutls.c b/src/gnutls.c
index e8528381efd..ca7e9fc4c73 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -2405,6 +2405,9 @@ gnutls_symmetric_aead (bool encrypting,
gnutls_cipher_algorithm_t gca,
aead_auth_size = aend_byte - astart_byte;
}
+ /* Only block ciphers require that ISIZE be a multiple of the block
+ size, and AEAD ciphers are not block ciphers. */
+#if 0
ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
@@ -2414,6 +2417,7 @@ gnutls_symmetric_aead (bool encrypting,
gnutls_cipher_algorithm_t gca,
"is not %"pD"d greater than a multiple of the required %"pD"d"),
gnutls_cipher_get_name (gca), desc,
isize, expected_remainder, cipher_block_size);
+#endif
ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt)
(acipher, vdata, vsize, aead_auth_data, aead_auth_size,
diff --git a/src/insdel.c b/src/insdel.c
index b51767bf527..0e1e98664b3 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -1175,9 +1175,20 @@ insert_from_buffer (struct buffer *buf,
{
ptrdiff_t opoint = PT;
+#ifdef HAVE_TREE_SITTER
+ ptrdiff_t obyte = PT_BYTE;
+#endif
+
insert_from_buffer_1 (buf, charpos, nchars, inherit);
signal_after_change (opoint, 0, PT - opoint);
update_compositions (opoint, PT, CHECK_BORDER);
+
+#ifdef HAVE_TREE_SITTER
+ eassert (PT_BYTE >= BEG_BYTE);
+ eassert (obyte >= BEG_BYTE);
+ eassert (PT_BYTE >= obyte);
+ treesit_record_change (obyte, obyte, PT_BYTE);
+#endif
}
static void
@@ -1305,12 +1316,6 @@ insert_from_buffer_1 (struct buffer *buf,
/* Insert those intervals. */
graft_intervals_into_buffer (intervals, PT, nchars, current_buffer, inherit);
-#ifdef HAVE_TREE_SITTER
- eassert (outgoing_nbytes >= 0);
- eassert (PT_BYTE >= 0);
- treesit_record_change (PT_BYTE, PT_BYTE, PT_BYTE + outgoing_nbytes);
-#endif
-
adjust_point (nchars, outgoing_nbytes);
}
diff --git a/src/keyboard.c b/src/keyboard.c
index 0ed28070335..6f0f075e54e 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10010,7 +10010,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object
prompt,
if (/* first_unbound < indec.start && first_unbound < fkey.start && */
first_unbound < keytran.start)
- { /* The prefix upto first_unbound has no binding and has
+ { /* The prefix up to first_unbound has no binding and has
no translation left to do either, so we know it's unbound.
If we don't stop now, we risk staying here indefinitely
(if the user keeps entering fkey or keytran prefixes
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index 6b3a0459d36..6e5bb22375a 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -1902,7 +1902,7 @@ parse_resource_key (const char *res_key, char
*setting_key)
/* check existence of setting_key */
GSettingsSchemaSource *ssrc = g_settings_schema_source_get_default ();
- GSettingsSchema *scm = g_settings_schema_source_lookup (ssrc, SCHEMA_ID,
FALSE);
+ GSettingsSchema *scm = g_settings_schema_source_lookup (ssrc, SCHEMA_ID,
TRUE);
if (!scm)
return NULL; /* *.schema.xml is not installed. */
if (!g_settings_schema_has_key (scm, setting_key))
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 5158492ca09..c00e13550bd 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -2959,7 +2959,8 @@ pgtk_draw_window_cursor (struct window *w, struct
glyph_row *glyph_row, int x,
if (w == XWINDOW (f->selected_window))
{
int frame_x = (WINDOW_TO_FRAME_PIXEL_X (w, x)
- + WINDOW_LEFT_FRINGE_WIDTH (w));
+ + WINDOW_LEFT_FRINGE_WIDTH (w)
+ + WINDOW_LEFT_MARGIN_WIDTH (w));
int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y);
pgtk_im_set_cursor_location (f, frame_x, frame_y,
w->phys_cursor_width,
diff --git a/src/print.c b/src/print.c
index d4a9ff89246..e65b4c40b0e 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2034,8 +2034,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
/* Now the node must be up-to-date, and calling functions like
Ftreesit_node_start will not signal. */
bool named = treesit_named_node_p (XTS_NODE (obj)->node);
- const char *delim1 = named ? "(" : "\"";
- const char *delim2 = named ? ")" : "\"";
+ /* We used to use () as delimiters for named nodes, but that
+ confuses pretty-printing a tad bit. There might be more
+ little breakages here and there if we print parenthesizes
+ inside an object, so I guess better not do it.
+ (bug#60696) */
+ const char *delim1 = named ? "" : "\"";
+ const char *delim2 = named ? "" : "\"";
print_c_string (delim1, printcharfun);
print_string (Ftreesit_node_type (obj), printcharfun);
print_c_string (delim2, printcharfun);
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 6b2fa5df037..2dca0d16ad9 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -223,7 +223,7 @@ typedef enum
is followed by a range table:
2 bytes of flags for character sets (low 8 bits, high 8 bits)
See RANGE_TABLE_WORK_BITS below.
- 2 bytes, the number of pairs that follow (upto 32767)
+ 2 bytes, the number of pairs that follow (up to 32767)
pairs, each 2 multibyte characters,
each multibyte character represented as 3 bytes. */
charset,
diff --git a/src/treesit.c b/src/treesit.c
index 55463122d14..917db582676 100644
--- a/src/treesit.c
+++ b/src/treesit.c
@@ -42,8 +42,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#undef ts_node_end_byte
#undef ts_node_eq
#undef ts_node_field_name_for_child
-#undef ts_node_first_child_for_byte
-#undef ts_node_first_named_child_for_byte
#undef ts_node_has_error
#undef ts_node_is_extra
#undef ts_node_is_missing
@@ -99,8 +97,6 @@ DEF_DLL_FN (TSNode, ts_node_descendant_for_byte_range,
DEF_DLL_FN (uint32_t, ts_node_end_byte, (TSNode));
DEF_DLL_FN (bool, ts_node_eq, (TSNode, TSNode));
DEF_DLL_FN (const char *, ts_node_field_name_for_child, (TSNode, uint32_t));
-DEF_DLL_FN (TSNode, ts_node_first_child_for_byte, (TSNode, uint32_t));
-DEF_DLL_FN (TSNode, ts_node_first_named_child_for_byte, (TSNode, uint32_t));
DEF_DLL_FN (bool, ts_node_has_error, (TSNode));
DEF_DLL_FN (bool, ts_node_is_extra, (TSNode));
DEF_DLL_FN (bool, ts_node_is_missing, (TSNode));
@@ -174,8 +170,6 @@ init_treesit_functions (void)
LOAD_DLL_FN (library, ts_node_end_byte);
LOAD_DLL_FN (library, ts_node_eq);
LOAD_DLL_FN (library, ts_node_field_name_for_child);
- LOAD_DLL_FN (library, ts_node_first_child_for_byte);
- LOAD_DLL_FN (library, ts_node_first_named_child_for_byte);
LOAD_DLL_FN (library, ts_node_has_error);
LOAD_DLL_FN (library, ts_node_is_extra);
LOAD_DLL_FN (library, ts_node_is_missing);
@@ -232,8 +226,6 @@ init_treesit_functions (void)
#define ts_node_end_byte fn_ts_node_end_byte
#define ts_node_eq fn_ts_node_eq
#define ts_node_field_name_for_child fn_ts_node_field_name_for_child
-#define ts_node_first_child_for_byte fn_ts_node_first_child_for_byte
-#define ts_node_first_named_child_for_byte
fn_ts_node_first_named_child_for_byte
#define ts_node_has_error fn_ts_node_has_error
#define ts_node_is_extra fn_ts_node_is_extra
#define ts_node_is_missing fn_ts_node_is_missing
@@ -406,6 +398,24 @@ init_treesit_functions (void)
/*** Initialization */
+static Lisp_Object Vtreesit_str_libtree_sitter;
+static Lisp_Object Vtreesit_str_tree_sitter;
+static Lisp_Object Vtreesit_str_dot;
+static Lisp_Object Vtreesit_str_question_mark;
+static Lisp_Object Vtreesit_str_star;
+static Lisp_Object Vtreesit_str_plus;
+static Lisp_Object Vtreesit_str_pound_equal;
+static Lisp_Object Vtreesit_str_pound_match;
+static Lisp_Object Vtreesit_str_pound_pred;
+static Lisp_Object Vtreesit_str_open_bracket;
+static Lisp_Object Vtreesit_str_close_bracket;
+static Lisp_Object Vtreesit_str_open_paren;
+static Lisp_Object Vtreesit_str_close_paren;
+static Lisp_Object Vtreesit_str_space;
+static Lisp_Object Vtreesit_str_equal;
+static Lisp_Object Vtreesit_str_match;
+static Lisp_Object Vtreesit_str_pred;
+
/* This is the limit on recursion levels for some tree-sitter
functions. Remember to update docstrings when changing this
value. */
@@ -534,9 +544,9 @@ treesit_load_language (Lisp_Object language_symbol,
/* Figure out the library name and C name. */
Lisp_Object lib_base_name
- = concat2 (build_pure_c_string ("libtree-sitter-"), symbol_name);
+ = concat2 (Vtreesit_str_libtree_sitter, symbol_name);
Lisp_Object base_name
- = concat2 (build_pure_c_string ("tree-sitter-"), symbol_name);
+ = concat2 (Vtreesit_str_tree_sitter, symbol_name);
/* Override the library name and C name, if appropriate. */
Lisp_Object override_name;
@@ -945,7 +955,7 @@ treesit_check_buffer_size (struct buffer *buffer)
ptrdiff_t buffer_size_bytes = (BUF_Z_BYTE (buffer) - BUF_BEG_BYTE (buffer));
if (buffer_size_bytes > UINT32_MAX)
xsignal2 (Qtreesit_buffer_too_large,
- build_pure_c_string ("Buffer size cannot be larger than 4GB"),
+ build_string ("Buffer size cannot be larger than 4GB"),
make_fixnum (buffer_size_bytes));
}
@@ -1200,7 +1210,7 @@ treesit_compose_query_signal_data (uint32_t error_offset,
return list4 (build_string (treesit_query_error_to_string (error_type)),
make_fixnum (error_offset + 1),
query_source,
- build_pure_c_string ("Debug the query with
`treesit-query-validate'"));
+ build_string ("Debug the query with `treesit-query-validate'"));
}
/* Ensure the QUERY is compiled. Return the TSQuery. It could be
@@ -1498,8 +1508,8 @@ treesit_check_range_argument (Lisp_Object ranges)
EMACS_INT end = XFIXNUM (XCDR (range));
if (!(last_point <= beg && beg <= end && end <= point_max))
xsignal2 (Qtreesit_range_invalid,
- build_pure_c_string ("RANGE is either overlapping,"
- " out-of-order or out-of-range"),
+ build_string ("RANGE is either overlapping,"
+ " out-of-order or out-of-range"),
ranges);
last_point = end;
}
@@ -1607,7 +1617,7 @@ buffer. */)
if (!success)
xsignal2 (Qtreesit_range_invalid,
- build_pure_c_string ("Something went wrong when setting ranges"),
+ build_string ("Something went wrong when setting ranges"),
ranges);
XTS_PARSER (parser)->need_reparse = true;
@@ -2077,6 +2087,41 @@ return nil. */)
return make_treesit_node (XTS_NODE (node)->parser, sibling);
}
+/* Our reimplementation of ts_node_first_child_for_byte. The current
+ implementation of that function has problems (see bug#60127), so
+ before it's fixed upstream, we use our own reimplementation of it.
+ Return true if there is a valid sibling, return false otherwise.
+ If the return value is false, the position of the cursor is
+ undefined. (We use cursor because technically we can't make a null
+ node for ourselves, also, using cursor is more convenient.)
+
+ TODO: Remove this function once tree-sitter fixed the bug. */
+static bool treesit_cursor_first_child_for_byte
+(TSTreeCursor *cursor, ptrdiff_t pos, bool named)
+{
+ if (!ts_tree_cursor_goto_first_child (cursor))
+ return false;
+
+ TSNode node = ts_tree_cursor_current_node (cursor);
+ while (ts_node_end_byte (node) <= pos)
+ {
+ if (ts_tree_cursor_goto_next_sibling (cursor))
+ node = ts_tree_cursor_current_node (cursor);
+ else
+ /* Reached the end and still can't find a valid sibling. */
+ return false;
+ }
+ while (named && (!ts_node_is_named (node)))
+ {
+ if (ts_tree_cursor_goto_next_sibling (cursor))
+ node = ts_tree_cursor_current_node (cursor);
+ else
+ /* Reached the end and still can't find a named sibling. */
+ return false;
+ }
+ return true;
+}
+
DEFUN ("treesit-node-first-child-for-pos",
Ftreesit_node_first_child_for_pos,
Streesit_node_first_child_for_pos, 2, 3, 0,
@@ -2101,16 +2146,17 @@ Note that this function returns an immediate child, not
the smallest
ptrdiff_t byte_pos = buf_charpos_to_bytepos (buf, XFIXNUM (pos));
TSNode treesit_node = XTS_NODE (node)->node;
- TSNode child;
- if (NILP (named))
- child = ts_node_first_child_for_byte (treesit_node, byte_pos -
visible_beg);
- else
- child = ts_node_first_named_child_for_byte (treesit_node,
- byte_pos - visible_beg);
- if (ts_node_is_null (child))
- return Qnil;
+ TSTreeCursor cursor = ts_tree_cursor_new (treesit_node);
+ ptrdiff_t treesit_pos = byte_pos - visible_beg;
+ bool success;
+ success = treesit_cursor_first_child_for_byte (&cursor, treesit_pos,
+ !NILP (named));
+ TSNode child = ts_tree_cursor_current_node (&cursor);
+ ts_tree_cursor_delete (&cursor);
+ if (!success)
+ return Qnil;
return make_treesit_node (XTS_NODE (node)->parser, child);
}
@@ -2154,11 +2200,24 @@ If NODE is nil, return nil. */)
return make_treesit_node (XTS_NODE (node)->parser, child);
}
+/* Return true if NODE1 and NODE2 are the same node. Assumes they are
+ TS_NODE type. */
+bool treesit_node_eq (Lisp_Object node1, Lisp_Object node2)
+{
+ treesit_initialize ();
+ TSNode treesit_node_1 = XTS_NODE (node1)->node;
+ TSNode treesit_node_2 = XTS_NODE (node2)->node;
+ return ts_node_eq (treesit_node_1, treesit_node_2);
+}
+
DEFUN ("treesit-node-eq",
Ftreesit_node_eq,
Streesit_node_eq, 2, 2, 0,
- doc: /* Return non-nil if NODE1 and NODE2 are the same node.
-If any one of NODE1 and NODE2 is nil, return nil. */)
+ doc: /* Return non-nil if NODE1 and NODE2 refer to the same node.
+If any one of NODE1 and NODE2 is nil, return nil.
+This function uses the same equivalence metric as `equal', and returns
+non-nil if NODE1 and NODE2 refer to the same node in a syntax tree
+produced by tree-sitter. */)
(Lisp_Object node1, Lisp_Object node2)
{
if (NILP (node1) || NILP (node2))
@@ -2166,12 +2225,7 @@ If any one of NODE1 and NODE2 is nil, return nil. */)
CHECK_TS_NODE (node1);
CHECK_TS_NODE (node2);
- treesit_initialize ();
-
- TSNode treesit_node_1 = XTS_NODE (node1)->node;
- TSNode treesit_node_2 = XTS_NODE (node2)->node;
-
- bool same_node = ts_node_eq (treesit_node_1, treesit_node_2);
+ bool same_node = treesit_node_eq (node1, node2);
return same_node ? Qt : Qnil;
}
@@ -2202,30 +2256,32 @@ See Info node `(elisp)Pattern Matching' for detailed
explanation. */)
(Lisp_Object pattern)
{
if (EQ (pattern, QCanchor))
- return build_pure_c_string (".");
+ return Vtreesit_str_dot;
if (EQ (pattern, intern_c_string (":?")))
- return build_pure_c_string ("?");
+ return Vtreesit_str_question_mark;
if (EQ (pattern, intern_c_string (":*")))
- return build_pure_c_string ("*");
+ return Vtreesit_str_star;
if (EQ (pattern, intern_c_string (":+")))
- return build_pure_c_string ("+");
+ return Vtreesit_str_plus;
if (EQ (pattern, QCequal))
- return build_pure_c_string ("#equal");
+ return Vtreesit_str_pound_equal;
if (EQ (pattern, QCmatch))
- return build_pure_c_string ("#match");
+ return Vtreesit_str_pound_match;
if (EQ (pattern, QCpred))
- return build_pure_c_string ("#pred");
+ return Vtreesit_str_pound_pred;
Lisp_Object opening_delimeter
- = build_pure_c_string (VECTORP (pattern) ? "[" : "(");
+ = VECTORP (pattern)
+ ? Vtreesit_str_open_bracket : Vtreesit_str_open_paren;
Lisp_Object closing_delimiter
- = build_pure_c_string (VECTORP (pattern) ? "]" : ")");
+ = VECTORP (pattern)
+ ? Vtreesit_str_close_bracket : Vtreesit_str_close_paren;
if (VECTORP (pattern) || CONSP (pattern))
return concat3 (opening_delimeter,
Fmapconcat (Qtreesit_pattern_expand,
pattern,
- build_pure_c_string (" ")),
+ Vtreesit_str_space),
closing_delimiter);
- return CALLN (Fformat, build_pure_c_string ("%S"), pattern);
+ return Fprin1_to_string (pattern, Qnil, Qt);
}
DEFUN ("treesit-query-expand",
@@ -2252,8 +2308,7 @@ A PATTERN in QUERY can be
See Info node `(elisp)Pattern Matching' for detailed explanation. */)
(Lisp_Object query)
{
- return Fmapconcat (Qtreesit_pattern_expand,
- query, build_pure_c_string (" "));
+ return Fmapconcat (Qtreesit_pattern_expand, query, Vtreesit_str_space);
}
/* This struct is used for passing captures to be check against
@@ -2333,10 +2388,10 @@ treesit_predicate_capture_name_to_node (Lisp_Object
name,
if (NILP (node))
xsignal3 (Qtreesit_query_error,
- build_pure_c_string ("Cannot find captured node"),
- name, build_pure_c_string ("A predicate can only refer"
- " to captured nodes in the "
- "same pattern"));
+ build_string ("Cannot find captured node"),
+ name, build_string ("A predicate can only refer"
+ " to captured nodes in the "
+ "same pattern"));
return node;
}
@@ -2365,8 +2420,8 @@ treesit_predicate_equal (Lisp_Object args, struct
capture_range captures)
{
if (XFIXNUM (Flength (args)) != 2)
xsignal2 (Qtreesit_query_error,
- build_pure_c_string ("Predicate `equal' requires "
- "two arguments but only given"),
+ build_string ("Predicate `equal' requires "
+ "two arguments but only given"),
Flength (args));
Lisp_Object arg1 = XCAR (args);
@@ -2391,8 +2446,8 @@ treesit_predicate_match (Lisp_Object args, struct
capture_range captures)
{
if (XFIXNUM (Flength (args)) != 2)
xsignal2 (Qtreesit_query_error,
- build_pure_c_string ("Predicate `equal' requires two "
- "arguments but only given"),
+ build_string ("Predicate `equal' requires two "
+ "arguments but only given"),
Flength (args));
Lisp_Object regexp = XCAR (args);
@@ -2404,12 +2459,12 @@ treesit_predicate_match (Lisp_Object args, struct
capture_range captures)
string-match does.) */
if (!STRINGP (regexp))
xsignal1 (Qtreesit_query_error,
- build_pure_c_string ("The first argument to `match' should "
- "be a regexp string, not a capture name"));
+ build_string ("The first argument to `match' should "
+ "be a regexp string, not a capture name"));
if (!SYMBOLP (capture_name))
xsignal1 (Qtreesit_query_error,
- build_pure_c_string ("The second argument to `match' should "
- "be a capture name, not a string"));
+ build_string ("The second argument to `match' should "
+ "be a capture name, not a string"));
Lisp_Object text = treesit_predicate_capture_name_to_text (capture_name,
captures);
@@ -2428,9 +2483,9 @@ 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"),
+ build_string ("Predicate `pred' requires "
+ "at least two arguments, "
+ "but was only given"),
Flength (args));
Lisp_Object fn = Fintern (XCAR (args), Qnil);
@@ -2458,18 +2513,18 @@ treesit_eval_predicates (struct capture_range captures,
Lisp_Object predicates)
Lisp_Object predicate = XCAR (tail);
Lisp_Object fn = XCAR (predicate);
Lisp_Object args = XCDR (predicate);
- if (!NILP (Fstring_equal (fn, build_pure_c_string ("equal"))))
+ if (!NILP (Fstring_equal (fn, Vtreesit_str_equal)))
pass &= treesit_predicate_equal (args, captures);
- else if (!NILP (Fstring_equal (fn, build_pure_c_string ("match"))))
+ else if (!NILP (Fstring_equal (fn, Vtreesit_str_match)))
pass &= treesit_predicate_match (args, captures);
- else if (!NILP (Fstring_equal (fn, build_pure_c_string ("pred"))))
+ else if (!NILP (Fstring_equal (fn, Vtreesit_str_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, match, and pred"
- " predicate"));
+ build_string ("Invalid predicate"),
+ fn, build_string ("Currently Emacs only supports"
+ " equal, match, and pred"
+ " predicate"));
}
/* If all predicates passed, add captures to result list. */
return pass;
@@ -3243,9 +3298,9 @@ a regexp. */)
Lisp_Object parser = XTS_NODE (root)->parser;
Lisp_Object parent = Fcons (Qnil, Qnil);
- TSTreeCursor cursor;
- if (!treesit_cursor_helper (&cursor, XTS_NODE (root)->node, parser))
- return Qnil;
+ /* In this function we never traverse above NODE, so we don't need
+ to use treesit_cursor_helper. */
+ TSTreeCursor cursor = ts_tree_cursor_new (XTS_NODE (root)->node);
treesit_build_sparse_tree (&cursor, parent, predicate, process_fn,
the_limit, parser);
@@ -3369,6 +3424,41 @@ then in the `tree-sitter' subdirectory of
`user-emacs-directory', and
then in the system default locations for dynamic libraries, in that order.
*/);
Vtreesit_extra_load_path = Qnil;
+ staticpro (&Vtreesit_str_libtree_sitter);
+ Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-");
+ staticpro (&Vtreesit_str_tree_sitter);
+ Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-");
+ staticpro (&Vtreesit_str_dot);
+ Vtreesit_str_dot = build_pure_c_string (".");
+ staticpro (&Vtreesit_str_question_mark);
+ Vtreesit_str_question_mark = build_pure_c_string ("?");
+ staticpro (&Vtreesit_str_star);
+ Vtreesit_str_star = build_pure_c_string ("*");
+ staticpro (&Vtreesit_str_plus);
+ Vtreesit_str_plus = build_pure_c_string ("+");
+ staticpro (&Vtreesit_str_pound_equal);
+ Vtreesit_str_pound_equal = build_pure_c_string ("#equal");
+ staticpro (&Vtreesit_str_pound_match);
+ Vtreesit_str_pound_match = build_pure_c_string ("#match");
+ staticpro (&Vtreesit_str_pound_pred);
+ Vtreesit_str_pound_pred = build_pure_c_string ("#pred");
+ staticpro (&Vtreesit_str_open_bracket);
+ Vtreesit_str_open_bracket = build_pure_c_string ("[");
+ staticpro (&Vtreesit_str_close_bracket);
+ Vtreesit_str_close_bracket = build_pure_c_string ("]");
+ staticpro (&Vtreesit_str_open_paren);
+ Vtreesit_str_open_paren = build_pure_c_string ("(");
+ staticpro (&Vtreesit_str_close_paren);
+ Vtreesit_str_close_paren = build_pure_c_string (")");
+ staticpro (&Vtreesit_str_space);
+ Vtreesit_str_space = build_pure_c_string (" ");
+ staticpro (&Vtreesit_str_equal);
+ Vtreesit_str_equal = build_pure_c_string ("equal");
+ staticpro (&Vtreesit_str_match);
+ Vtreesit_str_match = build_pure_c_string ("match");
+ staticpro (&Vtreesit_str_pred);
+ Vtreesit_str_pred = build_pure_c_string ("pred");
+
defsubr (&Streesit_language_available_p);
defsubr (&Streesit_library_abi_version);
defsubr (&Streesit_language_abi_version);
diff --git a/src/treesit.h b/src/treesit.h
index 909609737d3..5382bc58817 100644
--- a/src/treesit.h
+++ b/src/treesit.h
@@ -191,6 +191,7 @@ extern bool treesit_node_uptodate_p (Lisp_Object);
extern void treesit_delete_parser (struct Lisp_TS_Parser *);
extern void treesit_delete_query (struct Lisp_TS_Query *);
extern bool treesit_named_node_p (TSNode);
+extern bool treesit_node_eq (Lisp_Object, Lisp_Object);
#endif /* HAVE_TREE_SITTER */
diff --git a/src/w32.c b/src/w32.c
index 47d79abc5b0..8d344d2e6da 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -10509,10 +10509,13 @@ init_ntproc (int dumping)
}
}
-/*
- shutdown_handler ensures that buffers' autosave files are
- up to date when the user logs off, or the system shuts down.
-*/
+/* shutdown_handler ensures that buffers' autosave files are up to
+ date when the user logs off, or the system shuts down. It also
+ shuts down Emacs when we get killed by another Emacs process, in
+ which case we get the CTRL_CLOSE_EVENT. */
+
+extern DWORD dwMainThreadId;
+
static BOOL WINAPI
shutdown_handler (DWORD type)
{
@@ -10521,15 +10524,31 @@ shutdown_handler (DWORD type)
|| type == CTRL_LOGOFF_EVENT /* User logs off. */
|| type == CTRL_SHUTDOWN_EVENT) /* User shutsdown. */
{
- /* If we are being shut down in noninteractive mode, we don't
- care about the message stack, so clear it to avoid abort in
- shut_down_emacs. This happens when an noninteractive Emacs
- is invoked as a subprocess of Emacs, and the parent wants to
- kill us, e.g. because it's about to exit. */
- if (noninteractive)
- clear_message_stack ();
- /* Shut down cleanly, making sure autosave files are up to date. */
- shut_down_emacs (0, Qnil);
+ if (GetCurrentThreadId () == dwMainThreadId)
+ {
+ /* If we are being shut down in noninteractive mode, we don't
+ care about the message stack, so clear it to avoid abort in
+ shut_down_emacs. This happens when an noninteractive Emacs
+ is invoked as a subprocess of Emacs, and the parent wants to
+ kill us, e.g. because it's about to exit. */
+ if (noninteractive)
+ clear_message_stack ();
+ /* Shut down cleanly, making sure autosave files are up to date. */
+ shut_down_emacs (0, Qnil);
+ }
+ else
+ {
+ /* This handler is run in a thread different from the main
+ thread. (This is the normal situation when we are killed
+ by Emacs, for example, which sends us the WM_CLOSE
+ message). We cannot possibly call functions like
+ shut_down_emacs or clear_message_stack in that case,
+ since the main (a.k.a. "Lisp") thread could be in the
+ middle of some Lisp program. So instead we arrange for
+ maybe_quit to kill Emacs. */
+ Vquit_flag = Qkill_emacs;
+ Vinhibit_quit = Qnil;
+ }
}
/* Allow other handlers to handle this signal. */
diff --git a/src/w32fns.c b/src/w32fns.c
index 192d3ddf27a..745f561e6b1 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -10396,8 +10396,8 @@ to be converted to forward slashes by the caller. */)
#endif /* WINDOWSNT */
/* Query a value from the Windows Registry (under HKCU and HKLM),
- where `key` is the registry key, `name` is the name, and `lpdwtype`
- is a pointer to the return value's type. `lpwdtype` can be NULL if
+ where `key' is the registry key, `name' is the name, and `lpdwtype'
+ is a pointer to the return value's type. `lpwdtype' can be NULL if
you do not care about the type.
Returns: pointer to the value, or null pointer if the key/name does
@@ -10664,7 +10664,7 @@ pops up the Windows Run dialog, <lwindow>-<Pause> pops
up the "System
Properties" dialog, etc. On Windows 10, no \"Windows\" key
combinations are normally handed to applications. To enable Emacs to
process \"Windows\" key combinations, use the function
-`w32-register-hot-key`.
+`w32-register-hot-key'.
For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_lwindow_to_system = Qt;
@@ -10683,7 +10683,7 @@ pops up the Windows Run dialog, <rwindow>-<Pause> pops
up the "System
Properties" dialog, etc. On Windows 10, no \"Windows\" key
combinations are normally handed to applications. To enable Emacs to
process \"Windows\" key combinations, use the function
-`w32-register-hot-key`.
+`w32-register-hot-key'.
For Windows 98/ME, see the doc string of `w32-phantom-key-code'. */);
Vw32_pass_rwindow_to_system = Qt;
@@ -10698,7 +10698,7 @@ acting on \"Windows\" key events when
`w32-pass-lwindow-to-system' or
`w32-pass-rwindow-to-system' is nil.
This variable is only used on Windows 98 and ME. For other Windows
-versions, see the documentation of the `w32-register-hot-key`
+versions, see the documentation of the `w32-register-hot-key'
function. */);
/* Although 255 is technically not a valid key code, it works and
means that this hack won't interfere with any real key code. */
@@ -10732,7 +10732,7 @@ The value can be hyper, super, meta, alt, control or
shift for the
respective modifier, or nil to appear as the `lwindow' key.
Any other value will cause the key to be ignored.
-Also see the documentation of the `w32-register-hot-key` function. */);
+Also see the documentation of the `w32-register-hot-key' function. */);
Vw32_lwindow_modifier = Qnil;
DEFVAR_LISP ("w32-rwindow-modifier",
@@ -10742,7 +10742,7 @@ The value can be hyper, super, meta, alt, control or
shift for the
respective modifier, or nil to appear as the `rwindow' key.
Any other value will cause the key to be ignored.
-Also see the documentation of the `w32-register-hot-key` function. */);
+Also see the documentation of the `w32-register-hot-key' function. */);
Vw32_rwindow_modifier = Qnil;
DEFVAR_LISP ("w32-apps-modifier",
@@ -11112,20 +11112,24 @@ emacs_abort (void)
abort ();
int button;
- button = MessageBox (NULL,
- "A fatal error has occurred!\n\n"
- "Would you like to attach a debugger?\n\n"
- "Select:\n"
- "YES -- to debug Emacs, or\n"
- "NO -- to abort Emacs and produce a backtrace\n"
- " (emacs_backtrace.txt in current directory)."
+
+ if (noninteractive)
+ button = IDNO;
+ else
+ button = MessageBox (NULL,
+ "A fatal error has occurred!\n\n"
+ "Would you like to attach a debugger?\n\n"
+ "Select:\n"
+ "YES -- to debug Emacs, or\n"
+ "NO -- to abort Emacs and produce a backtrace\n"
+ " (emacs_backtrace.txt in current directory)."
#if __GNUC__
- "\n\n(type \"gdb -p <emacs-PID>\" and\n"
- "\"continue\" inside GDB before clicking YES.)"
+ "\n\n(Before clicking YES, type\n"
+ "\"gdb -p <emacs-PID>\", then \"continue\" inside
GDB.)"
#endif
- , "Emacs Abort Dialog",
- MB_ICONEXCLAMATION | MB_TASKMODAL
- | MB_SETFOREGROUND | MB_YESNO);
+ , "Emacs Abort Dialog",
+ MB_ICONEXCLAMATION | MB_TASKMODAL
+ | MB_SETFOREGROUND | MB_YESNO);
switch (button)
{
case IDYES:
@@ -11271,7 +11275,7 @@ globals_of_w32fns (void)
get_proc_addr (hm_kernel32, "SetThreadDescription");
/* Support OS dark mode on Windows 10 version 1809 and higher.
- See `w32_applytheme` which uses appropriate APIs per version of Windows.
+ See `w32_applytheme' which uses appropriate APIs per version of Windows.
For future wretches who may need to understand Windows build numbers:
https://docs.microsoft.com/en-us/windows/release-health/release-information
*/
diff --git a/src/w32heap.c b/src/w32heap.c
index a1975d9a975..628fc28e3c5 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -121,9 +121,9 @@ typedef struct _RTL_HEAP_PARAMETERS {
# define DUMPED_HEAP_SIZE 10
#else
# if defined _WIN64 || defined WIDE_EMACS_INT
-# define DUMPED_HEAP_SIZE (23*1024*1024)
+# define DUMPED_HEAP_SIZE (28*1024*1024)
# else
-# define DUMPED_HEAP_SIZE (13*1024*1024)
+# define DUMPED_HEAP_SIZE (18*1024*1024)
# endif
#endif
diff --git a/src/xfaces.c b/src/xfaces.c
index 68f7cc493cc..35b79154805 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -6012,7 +6012,6 @@ realize_non_ascii_face (struct frame *f, Lisp_Object
font_object,
return face;
}
-#endif /* HAVE_WINDOW_SYSTEM */
/* Remove the attribute at INDEX from the font object if SYMBOL
appears in `font-fallback-ignored-attributes'. */
@@ -6031,6 +6030,7 @@ font_maybe_unset_attribute (Lisp_Object font_object,
ASET (font_object, index, Qnil);
}
}
+#endif /* HAVE_WINDOW_SYSTEM */
/* Realize the fully-specified face with attributes ATTRS in face
cache CACHE for ASCII characters. Do it for GUI frame CACHE->f.
diff --git a/src/xterm.c b/src/xterm.c
index 028bb7582c4..1325d923be9 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -5750,7 +5750,8 @@ xi_device_from_id (struct x_display_info *dpyinfo, int
deviceid)
static void
xi_link_touch_point (struct xi_device_t *device,
- int detail, double x, double y)
+ int detail, double x, double y,
+ struct frame *frame)
{
struct xi_touch_point_t *touchpoint;
@@ -5759,6 +5760,7 @@ xi_link_touch_point (struct xi_device_t *device,
touchpoint->x = x;
touchpoint->y = y;
touchpoint->number = detail;
+ touchpoint->frame = frame;
device->touchpoints = touchpoint;
}
@@ -5787,6 +5789,36 @@ xi_unlink_touch_point (int detail,
return false;
}
+/* Unlink all touch points associated with the frame F.
+ This is done upon unmapping or destroying F's window, because
+ touch point delivery after that point is undefined. */
+
+static void
+xi_unlink_touch_points (struct frame *f)
+{
+ struct xi_device_t *device;
+ struct xi_touch_point_t **next, *last;
+ int i;
+
+ for (i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i)
+ {
+ device = &FRAME_DISPLAY_INFO (f)->devices[i];
+
+ /* Now unlink all touch points on DEVICE matching F. */
+
+ for (next = &device->touchpoints; (last = *next);)
+ {
+ if (last->frame == f)
+ {
+ *next = last->next;
+ xfree (last);
+ }
+ else
+ next = &last->next;
+ }
+ }
+}
+
static struct xi_touch_point_t *
xi_find_touch_point (struct xi_device_t *device, int detail)
{
@@ -13535,6 +13567,10 @@ xi_disable_devices (struct x_display_info *dpyinfo,
#ifdef HAVE_XINPUT2_2
struct xi_touch_point_t *tem, *last;
#endif
+#if defined HAVE_XINPUT2_2 && !defined HAVE_EXT_TOOL_BAR
+ struct x_output *output;
+ Lisp_Object tail, frame;
+#endif
/* Don't pointlessly copy dpyinfo->devices if there are no devices
to disable. */
@@ -13577,6 +13613,34 @@ xi_disable_devices (struct x_display_info *dpyinfo,
tem = tem->next;
xfree (last);
}
+
+#ifndef HAVE_EXT_TOOL_BAR
+
+ /* Now look through each frame on DPYINFO. If it has an
+ outstanding tool bar press for this device, release
+ the tool bar. */
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (!FRAME_X_P (XFRAME (frame))
+ || (FRAME_DISPLAY_INFO (XFRAME (frame))
+ != dpyinfo))
+ continue;
+
+ output = FRAME_OUTPUT_DATA (XFRAME (frame));
+
+ if (output->tool_bar_touch_device
+ == dpyinfo->devices[i].device_id)
+ {
+ if (XFRAME (frame)->last_tool_bar_item != -1
+ && WINDOWP (XFRAME (frame)->tool_bar_window))
+ handle_tool_bar_click (XFRAME (frame), 0, 0,
+ false, 0);
+
+ output->tool_bar_touch_device = 0;
+ }
+ }
+#endif
#endif
goto out;
@@ -24209,6 +24273,73 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#endif
+#ifndef HAVE_EXT_TOOL_BAR
+ /* Is this a touch from a direct touch device that is in
+ the tool-bar? */
+ if (device->direct_p
+ && WINDOWP (f->tool_bar_window)
+ && WINDOW_TOTAL_LINES (XWINDOW (f->tool_bar_window)))
+ {
+ Lisp_Object window;
+ int x = xev->event_x;
+ int y = xev->event_y;
+
+ window = window_from_coordinates (f, x, y, 0, true, true);
+ /* Ignore button release events if the mouse
+ wasn't previously pressed on the tool bar.
+ We do this because otherwise selecting some
+ text with the mouse and then releasing it on
+ the tool bar doesn't stop selecting text,
+ since the tool bar eats the button up
+ event. */
+ tool_bar_p = EQ (window, f->tool_bar_window);
+
+ /* If this touch has started in the tool bar, do not
+ send it to Lisp. Instead, simulate a tool bar
+ click, releasing it once it goes away. */
+
+ if (tool_bar_p)
+ {
+ /* Call note_mouse_highlight on the tool bar
+ item. Otherwise, get_tool_bar_item will
+ return 1.
+
+ This is not necessary when mouse-highlight is
+ nil. */
+
+ if (!NILP (Vmouse_highlight))
+ {
+ note_mouse_highlight (f, x, y);
+
+ /* Always allow future mouse motion to
+ update the mouse highlight, no matter
+ where it is. */
+ memset (&dpyinfo->last_mouse_glyph, 0,
+ sizeof dpyinfo->last_mouse_glyph);
+ dpyinfo->last_mouse_glyph_frame = f;
+ }
+
+ handle_tool_bar_click_with_device (f, x, y, true, 0,
+ (source
+ ? source->name : Qt));
+
+ /* Flush any changes made by that to the front
+ buffer. */
+ x_flush_dirty_back_buffer_on (f);
+
+ /* Record the device and the touch ID on the
+ frame. That way, Emacs knows when to dismiss
+ the tool bar click later. */
+
+ FRAME_OUTPUT_DATA (f)->tool_bar_touch_device
+ = device->device_id;
+ FRAME_OUTPUT_DATA (f)->tool_bar_touch_id = xev->detail;
+
+ goto XI_OTHER;
+ }
+ }
+#endif
+
if (!menu_bar_p && !tool_bar_p)
{
if (f && device->direct_p)
@@ -24218,13 +24349,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_catch_errors (dpyinfo->display);
if (x_input_grab_touch_events)
- XIAllowTouchEvents (dpyinfo->display, xev->deviceid,
- xev->detail, xev->event,
XIAcceptTouch);
+ XIAllowTouchEvents (dpyinfo->display,
+ xev->deviceid,
+ xev->detail, xev->event,
+ XIAcceptTouch);
if (!x_had_errors_p (dpyinfo->display))
{
- xi_link_touch_point (device, xev->detail,
xev->event_x,
- xev->event_y);
+ xi_link_touch_point (device, xev->detail,
+ xev->event_x,
+ xev->event_y, f);
inev.ie.kind = TOUCHSCREEN_BEGIN_EVENT;
inev.ie.timestamp = xev->time;
@@ -24299,10 +24433,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
for (touchpoint = device->touchpoints;
touchpoint; touchpoint = touchpoint->next)
{
- arg = Fcons (list3i (lrint (touchpoint->x),
- lrint (touchpoint->y),
- lrint (touchpoint->number)),
- arg);
+ if (touchpoint->frame == f)
+ arg = Fcons (list3i (lrint (touchpoint->x),
+ lrint (touchpoint->y),
+ lrint (touchpoint->number)),
+ arg);
}
if (source)
@@ -24348,6 +24483,33 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
+#ifndef HAVE_EXT_TOOL_BAR
+ /* Now see if the touchpoint was previously on the tool bar.
+ If it was, release the tool bar. */
+
+ if (!f)
+ f = x_window_to_frame (dpyinfo, xev->event);
+
+ if (f && (FRAME_OUTPUT_DATA (f)->tool_bar_touch_id
+ == xev->detail))
+ {
+ if (f->last_tool_bar_item != -1)
+ handle_tool_bar_click_with_device (f, xev->event_x,
+ xev->event_y,
+ false, 0,
+ (source
+ ? source->name
+ : Qnil));
+
+ /* Cancel any outstanding mouse highlight. */
+ note_mouse_highlight (f, -1, -1);
+ x_flush_dirty_back_buffer_on (f);
+
+ /* Now clear the tool bar device. */
+ FRAME_OUTPUT_DATA (f)->tool_bar_touch_device = 0;
+ }
+#endif
+
goto XI_OTHER;
}
@@ -28453,6 +28615,11 @@ x_make_frame_invisible (struct frame *f)
block_input ();
+#ifdef HAVE_XINPUT2_2
+ /* Remove any touch points associated with F. */
+ xi_unlink_touch_points (f);
+#endif
+
/* Before unmapping the window, update the WM_SIZE_HINTS property to claim
that the current position of the window is user-specified, rather than
program-specified, so that when the window is mapped again, it will be
@@ -28658,6 +28825,11 @@ x_free_frame_resources (struct frame *f)
xi_handle_delete_frame (dpyinfo, f);
#endif
+#ifdef HAVE_XINPUT2_2
+ /* Remove any touch points associated with F. */
+ xi_unlink_touch_points (f);
+#endif
+
/* If a display connection is dead, don't try sending more
commands to the X server. */
if (dpyinfo->display)
diff --git a/src/xterm.h b/src/xterm.h
index d768ba7ff8d..28ae00ca190 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -257,10 +257,17 @@ struct xi_scroll_valuator_t
struct xi_touch_point_t
{
+ /* The next touch point in this list. */
struct xi_touch_point_t *next;
+ /* The touchpoint detail. */
int number;
+
+ /* The last known X and Y position of the touchpoint. */
double x, y;
+
+ /* The frame associated with this touch point. */
+ struct frame *frame;
};
#endif
@@ -1295,6 +1302,16 @@ struct x_output
VisibilityFullyObscured, but is set to something else in
handle_one_xevent. */
int visibility_state;
+
+#ifdef HAVE_XINPUT2_2
+ /* The touch ID of the last touch point to have touched the tool
+ bar. */
+ int tool_bar_touch_id;
+
+ /* The device that last touched the tool bar. 0 if no device
+ touched the tool bar. */
+ int tool_bar_touch_device;
+#endif
};
enum
diff --git a/test/Makefile.in b/test/Makefile.in
index fd21695f5bc..f4b85e7dfe5 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -264,8 +264,8 @@ endif
GMP_H = @GMP_H@
LIBGMP = @LIBGMP@
-LIB_CLOCK_GETTIME = @LIB_CLOCK_GETTIME@
-LIB_NANOSLEEP = @LIB_NANOSLEEP@
+CLOCK_TIME_LIB = @CLOCK_TIME_LIB@
+NANOSLEEP_LIB = @NANOSLEEP_LIB@
MODULE_CFLAGS = $(and $(GMP_H),-I.) -I../src -I$(srcdir)/../src \
$(FPIC_CFLAGS) $(PROFILING_CFLAGS) \
@@ -286,7 +286,7 @@ $(test_module): $(test_module:${SO}=.c)
../src/emacs-module.h \
$(AM_V_at)$(CC) -shared $(CPPFLAGS) $(MODULE_CFLAGS) $(LDFLAGS) \
-o $@ $< $(LIBGMP) \
$(and $(GMP_H),$(srcdir)/../lib/mini-gmp.c) \
- $(LIB_CLOCK_GETTIME) $(LIB_NANOSLEEP)
+ $(CLOCK_TIME_LIB) $(NANOSLEEP_LIB)
endif
src/emacs-tests.log: ../lib-src/seccomp-filter.c
diff --git a/test/lisp/erc/erc-scenarios-base-association.el
b/test/lisp/erc/erc-scenarios-base-association.el
index 1e280d0fdd7..a40a4cb7550 100644
--- a/test/lisp/erc/erc-scenarios-base-association.el
+++ b/test/lisp/erc/erc-scenarios-base-association.el
@@ -26,7 +26,9 @@
(declare-function erc-network-name "erc-networks")
(declare-function erc-network "erc-networks")
+(declare-function erc-track-get-active-buffer "erc-track" (arg))
(defvar erc-autojoin-channels-alist)
+(defvar erc-track-mode)
(defvar erc-network)
;; Two networks, same channel name, no confusion (no bouncer). Some
@@ -190,4 +192,51 @@
(with-current-buffer "#chan@barnet"
(erc-d-t-search-for 10 "I'll bid adieu")))))
+;; Some modules may need to perform housekeeping when a newly
+;; connected server buffer is deemed a duplicate after its persistent
+;; network context is discovered on MOTD end. One such module is
+;; `track', which needs to rid its list of modified channels of the
+;; buffer being killed. Without this, a user may encounter an
+;; "Attempt to display deleted buffer" error when they try switching
+;; to it.
+
+(ert-deftest erc-scenarios-networks-merge-server-track ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "networks/merge-server")
+ (dumb-server (erc-d-run "localhost" t 'track 'track))
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+ (should erc-track-mode)
+ (funcall expect 5 "changed mode for tester")
+ (erc-cmd-JOIN "#chan")))
+
+ (ert-info ("Join channel and quit")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 5 "The hour that fools should ask")
+ (erc-cmd-QUIT ""))
+ (with-current-buffer "FooNet"
+ (funcall expect 5 "finished")))
+
+ (ert-info ("Reconnect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester")
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))
+ (funcall expect 5 "changed mode for tester")))
+
+ (with-current-buffer "#chan"
+ (funcall expect 5 "The hour that fools should ask")
+ ;; Simulate the old `erc-track-switch-buffer'
+ (switch-to-buffer (erc-track-get-active-buffer 1))
+ (erc-d-t-wait-for 10 (eq (get-buffer "FooNet") (current-buffer)))
+ (erc-cmd-QUIT ""))))
+
;;; erc-scenarios-base-association.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el
b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el
index 74d4444ccd2..9275aba2875 100644
--- a/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el
+++ b/test/lisp/erc/erc-scenarios-base-compat-rename-bouncer.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-compat-rename-bouncer.el --- compat-rename scenarios -*-
lexical-binding: t -*-
+;;; erc-scenarios-base-compat-rename-bouncer.el --- Compat-rename scenarios
-*- lexical-binding: t -*-
;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -169,4 +169,4 @@
(erc-scenarios-common--base-compat-no-rename-bouncer dialogs
'auto after)))))
-;;; erc-scenarios-compat-rename-bouncer.el ends here
+;;; erc-scenarios-base-compat-rename-bouncer.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-local-modules.el
b/test/lisp/erc/erc-scenarios-base-local-modules.el
index d4001df45de..1318207a3bf 100644
--- a/test/lisp/erc/erc-scenarios-base-local-modules.el
+++ b/test/lisp/erc/erc-scenarios-base-local-modules.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-local-modules.el --- Local modules tests for ERC -*-
lexical-binding: t -*-
+;;; erc-scenarios-base-local-modules.el --- Local-module tests for ERC -*-
lexical-binding: t -*-
;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -19,8 +19,18 @@
;;; Commentary:
-;; These tests all use `sasl' because, as of ERC 5.5, it's the one
-;; and only local module.
+;; A local module doubles as a minor mode whose mode variable and
+;; associated local data can withstand service disruptions.
+;; Unfortunately, the current implementation is too unwieldy to be
+;; promoted publicly because it doesn't perform any of the boiler
+;; plate needed to save and restore buffer-local and "network-local"
+;; copies of user options. Ultimately, a user-friendly framework must
+;; fill this void if third-party local modules are ever to become
+;; practical.
+;;
+;; The following tests all use `sasl' because, as of ERC 5.5, it's the
+;; only connection-oriented local module. A fictitious
+;; target-oriented module is defined below for testing purposes.
;;; Code:
@@ -206,7 +216,7 @@
(erc-cmd-QUIT "")
(funcall expect 10 "finished")))
- (ert-info ("Disabling works from a target buffer.")
+ (ert-info ("Disabling works from a target buffer")
(with-current-buffer "#chan"
(should erc-sasl-mode)
(call-interactively #'erc-sasl-disable)
@@ -214,10 +224,9 @@
(should (local-variable-p 'erc-sasl-mode))
(should-not (buffer-local-value 'erc-sasl-mode (get-buffer "foonet")))
(erc-cmd-RECONNECT)
- (with-current-buffer "#chan"
- (funcall expect 10 "Some enigma, some riddle")
- (should-not erc-sasl-mode) ; regression
- (should (local-variable-p 'erc-sasl-mode))))
+ (funcall expect 10 "Some enigma, some riddle")
+ (should-not erc-sasl-mode) ; regression
+ (should (local-variable-p 'erc-sasl-mode)))
(with-current-buffer "foonet"
(should (local-variable-p 'erc-sasl-mode))
@@ -239,4 +248,82 @@
(should erc-sasl-mode)
(funcall expect 10 "User modes for tester")))))
-;;; erc-scenarios-local-modules.el ends here
+(defvar-local erc-scenarios-base-local-modules--local-var nil)
+
+(define-erc-module -phony-sblm- nil
+ "Test module for `erc-scenarios-base-local-modules--var-persistence'."
+ ((when-let ((vars (or erc--server-reconnecting erc--target-priors)))
+ (should (assq 'erc--phony-sblm--mode vars))
+ (setq erc-scenarios-base-local-modules--local-var
+ (alist-get 'erc-scenarios-base-local-modules--local-var vars)))
+ (setq erc-scenarios-base-local-modules--local-var
+ (or erc-scenarios-base-local-modules--local-var
+ (if erc--target 100 0))))
+ ((kill-local-variable 'erc-scenarios-base-local-modules--local-var))
+ 'local)
+
+;; Note: this file has grown too expensive (time-wise) and must be
+;; split up. When that happens, this test should be rewritten without
+;; any time-saving hacks, namely, server-initiated JOINs and an
+;; absence of QUITs. (That said, three connections in under 2 seconds
+;; is pretty nice.)
+
+(ert-deftest erc-scenarios-base-local-modules--var-persistence ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'options 'options 'options))
+ (port (process-contact dumb-server :service))
+ (erc-modules (cons '-phony-sblm- (remq 'autojoin erc-modules)))
+ (expect (erc-d-t-make-expecter))
+ (server-buffer-name (format "127.0.0.1:%d" port)))
+
+ (ert-info ("Initial authentication succeeds as expected")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "changeme"
+ :full-name "tester")
+ (should (string= (buffer-name) server-buffer-name)))
+
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "FooNet"))
+ (funcall expect 10 "This server is in debug mode")
+ (should erc--phony-sblm--mode)
+ (should (eql erc-scenarios-base-local-modules--local-var 0))
+ (setq erc-scenarios-base-local-modules--local-var 1)))
+
+ (ert-info ("Save module's local var in target buffer")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (should (eql erc-scenarios-base-local-modules--local-var 100))
+ (setq erc-scenarios-base-local-modules--local-var 101)
+ (funcall expect 20 "welcome")))
+
+ (with-current-buffer "FooNet" (funcall expect 20 "terminated"))
+
+ (ert-info ("Vars reused when mode was left enabled")
+ (with-current-buffer "#chan"
+ (erc-cmd-RECONNECT)
+ (funcall expect 20 "welcome")
+ (should (eql erc-scenarios-base-local-modules--local-var 101))
+ (erc--phony-sblm--mode -1))
+
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "User modes for tester")
+ (should (eql erc-scenarios-base-local-modules--local-var 1))))
+
+ (with-current-buffer "FooNet" (funcall expect 20 "terminated"))
+
+ (ert-info ("Local binding gone when mode disabled in target")
+ (with-current-buffer "#chan"
+ (erc-cmd-RECONNECT)
+ (funcall expect 20 "welcome")
+ (should-not erc--phony-sblm--mode)
+ (should-not erc-scenarios-base-local-modules--local-var))
+
+ ;; But value retained in server buffer, where mode is active.
+ (with-current-buffer "FooNet"
+ (funcall expect 10 "User modes for tester")
+ (should (eql erc-scenarios-base-local-modules--local-var 1))))))
+
+;;; erc-scenarios-base-local-modules.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-netid-samenet.el
b/test/lisp/erc/erc-scenarios-base-netid-samenet.el
index 7304dead44c..997dab93735 100644
--- a/test/lisp/erc/erc-scenarios-base-netid-samenet.el
+++ b/test/lisp/erc/erc-scenarios-base-netid-samenet.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-base-network-id-samenet.el --- netid-id samenet scenarios
-*- lexical-binding: t -*-
+;;; erc-scenarios-base-netid-samenet.el --- One-network net-ID scenarios -*-
lexical-binding: t -*-
;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -148,4 +148,4 @@
:server "foonet/chester"
:chan "#chan@foonet/chester")))
-;;; erc-scenarios-base-network-id-samenet.el ends here
+;;; erc-scenarios-base-netid-samenet.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el
b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el
index 28b0db77be6..fc8be982f65 100644
--- a/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el
+++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-soju.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-upstream-recon-soju.el --- Upstream soju -*-
lexical-binding: t -*-
+;;; erc-scenarios-base-upstream-recon-soju.el --- Bouncer recon scenario -*-
lexical-binding: t -*-
;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -19,7 +19,8 @@
;; Commentary:
-;; These concern the loss and recovery of a proxy's IRC-side connection.
+;; These concern the loss and recovery of a proxy's IRC-side
+;; connection (hence "upstream").
;;; Code:
@@ -41,4 +42,4 @@
'soju-foonet
'soju-barnet))
-;;; erc-scenarios-upstream-recon-soju.el ends here
+;;; erc-scenarios-base-upstream-recon-soju.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
index 79e1349bd95..461dac27b21 100644
--- a/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
+++ b/test/lisp/erc/erc-scenarios-base-upstream-recon-znc.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-upstream-recon-znc.el --- Upstream znc -*- lexical-binding:
t -*-
+;;; erc-scenarios-base-upstream-recon-znc.el --- Bouncer recon scenario -*-
lexical-binding: t -*-
;; Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -19,7 +19,8 @@
;; Commentary:
-;; These concern the loss and recovery of a proxy's IRC-side connection.
+;; These concern the loss and recovery of a proxy's IRC-side
+;; connection (hence "upstream").
;;; Code:
@@ -41,4 +42,4 @@
'znc-foonet
'znc-barnet))
-;;; erc-scenarios-upstream-recon-znc.el ends here
+;;; erc-scenarios-base-upstream-recon-znc.el ends here
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index b1d36d868eb..9181a47ee3b 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -248,7 +248,8 @@
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-standard
- #'erc-services-test--call-with-plstore))))
+ #'erc-services-test--call-with-plstore))
+ (kill-buffer (get-file-buffer plstore-file))))
(ert-deftest erc--auth-source-search--plstore-announced ()
(ert-with-temp-file plstore-file
@@ -264,7 +265,8 @@
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-announced
- #'erc-services-test--call-with-plstore))))
+ #'erc-services-test--call-with-plstore))
+ (kill-buffer (get-file-buffer plstore-file))))
(ert-deftest erc--auth-source-search--plstore-overrides ()
(ert-with-temp-file plstore-file
@@ -296,7 +298,8 @@
(let ((auth-sources (list plstore-file))
(auth-source-do-cache nil))
(erc-services-tests--auth-source-overrides
- #'erc-services-test--call-with-plstore))))
+ #'erc-services-test--call-with-plstore))
+ (kill-buffer (get-file-buffer plstore-file))))
;; auth-source JSON backend
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 85506c3d27e..40a2d2de657 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -1251,18 +1251,28 @@
(setq calls nil)))))
(ert-deftest erc--merge-local-modes ()
-
- (ert-info ("No existing modes")
- (let ((old '((a) (b . t)))
- (new '(erc-c-mode erc-d-mode)))
- (should (equal (erc--merge-local-modes new old)
- '((erc-c-mode erc-d-mode))))))
-
- (ert-info ("Active existing added, inactive existing removed, deduped")
- (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t)))
- (new '(erc-b-mode erc-d-mode)))
- (should (equal (erc--merge-local-modes new old)
- '((erc-d-mode erc-e-mode) . (erc-b-mode)))))))
+ (cl-letf (((get 'erc-b-mode 'erc-module) 'b)
+ ((get 'erc-c-mode 'erc-module) 'c)
+ ((get 'erc-d-mode 'erc-module) 'd)
+ ((get 'erc-e-mode 'erc-module) 'e))
+
+ (ert-info ("No existing modes")
+ (let ((old '((a) (b . t)))
+ (new '(erc-c-mode erc-d-mode)))
+ (should (equal (erc--merge-local-modes new old)
+ '((erc-c-mode erc-d-mode))))))
+
+ (ert-info ("Active existing added, inactive existing removed, deduped")
+ (let ((old '((a) (erc-b-mode) (c . t) (erc-d-mode . t) (erc-e-mode . t)))
+ (new '(erc-b-mode erc-d-mode)))
+ (should (equal (erc--merge-local-modes new old)
+ '((erc-d-mode erc-e-mode) . (erc-b-mode))))))
+
+ (ert-info ("Non-module erc-prefixed mode ignored")
+ (let ((old '((erc-b-mode) (erc-f-mode . t) (erc-d-mode . t)))
+ (new '(erc-b-mode)))
+ (should (equal (erc--merge-local-modes new old)
+ '((erc-d-mode) . (erc-b-mode))))))))
(ert-deftest define-erc-module--global ()
(let ((global-module '(define-erc-module mname malias
@@ -1300,13 +1310,15 @@ Some docstring"
(ignore c) (ignore d))
(defalias 'erc-malias-mode #'erc-mname-mode)
+ (put 'erc-malias-mode 'erc-module 'mname)
+ (put 'erc-mname-mode 'erc-module 'mname)
(put 'erc-mname-mode 'definition-name 'mname)
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
(ert-deftest define-erc-module--local ()
- (let* ((global-module '(define-erc-module mname malias
+ (let* ((global-module '(define-erc-module mname nil ; no alias
"Some docstring"
((ignore a) (ignore b))
((ignore c) (ignore d))
@@ -1353,8 +1365,7 @@ When called interactively, do so in all buffers for the
current connection."
(setq erc-mname-mode nil)
(ignore c) (ignore d))))
- (defalias 'erc-malias-mode #'erc-mname-mode)
-
+ (put 'erc-mname-mode 'erc-module 'mname)
(put 'erc-mname-mode 'definition-name 'mname)
(put 'erc-mname-enable 'definition-name 'mname)
(put 'erc-mname-disable 'definition-name 'mname))))))
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld
b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld
index e2fe1430283..a270c743d90 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-again.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
((pass 10 "PASS :barnet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version
oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Wed, 12 May 2021
07:41:08 UTC")
@@ -17,7 +17,7 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 10.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer ^
(0 ":tester!~u@xrir8fpe4d7ak.irc JOIN #chan")
@@ -36,9 +36,9 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((~join 3 "JOIN #chan"))
+((~join 10 "JOIN #chan"))
-((mode 5 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":joe!~u@svpn88yjcdj42.irc PRIVMSG #chan :mike: But, in defense, by
mercy, 'tis most just.")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld
b/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld
index bf8712305a4..a8c352daaa7 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-again.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
((pass 10 "PASS :foonet:changeme"))
-((nick 3 "NICK tester"))
-((user 3 "USER user 0 * :tester")
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version
oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Wed, 12 May 2021
07:41:09 UTC")
@@ -17,7 +17,7 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 10.2 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
;; No mode answer ^
(0 ":tester!~u@nvfhxvqm92rm6.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice @bob tester")
@@ -36,9 +36,9 @@
(0 ":irc.foonet.org NOTICE tester :[07:00:32] 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.")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((~join 3 "JOIN #chan"))
+((~join 10 "JOIN #chan"))
-((mode 8 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #chan :bob: Grows, lives, and dies,
in single blessedness.")
diff --git a/test/lisp/erc/resources/erc-d/erc-d-t.el
b/test/lisp/erc/resources/erc-d/erc-d-t.el
index 282c193b707..7b2adf4f07b 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-t.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-t.el
@@ -32,7 +32,7 @@
(dolist (buf (buffer-list))
(with-current-buffer buf
(when (or erc-d-u--process-buffer
- (derived-mode-p 'erc-mode))
+ (derived-mode-p 'erc-mode 'erc-dcc-chat-mode))
(push buf buflist))))
(dolist (buf buflist)
(when (and (boundp 'erc-server-flood-timer)
diff --git a/test/lisp/erc/resources/networks/merge-server/track.eld
b/test/lisp/erc/resources/networks/merge-server/track.eld
new file mode 100644
index 00000000000..19c37aaf40b
--- /dev/null
+++ b/test/lisp/erc/resources/networks/merge-server/track.eld
@@ -0,0 +1,44 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :unknown")
+ (0.00 ":irc.example.net NOTICE * :*** Looking up your hostname...")
+ (0.01 ":irc.example.net NOTICE tester :*** Could not resolve your hostname:
Domain not found; using your IP address (10.0.2.100) instead.")
+ (0.10 ":irc.example.net 001 tester :Welcome to the FooNet IRC Network
tester!user@10.0.2.100")
+ (0.02 ":irc.example.net 002 tester :Your host is irc.example.net, running
version InspIRCd-3")
+ (0.02 ":irc.example.net 003 tester :This server was created 05:58:57 Jan 04
2023")
+ (0.01 ":irc.example.net 004 tester irc.example.net InspIRCd-3 BIRcgikorsw
ACHIKMORTXabcefghijklmnopqrstvz :HIXabefghjkloqv")
+ (0.00 ":irc.example.net 005 tester ACCEPT=30 AWAYLEN=200 BOT=B CALLERID=g
CASEMAPPING=ascii CHANLIMIT=#:20 CHANMODES=IXbeg,k,Hfjl,ACKMORTcimnprstz
CHANNELLEN=64 CHANTYPES=# ELIST=CMNTU ESILENCE=CcdiNnPpTtx EXCEPTS=e :are
supported by this server")
+ (0.02 ":irc.example.net 005 tester EXTBAN=,ACORTUacjrwz HOSTLEN=64 INVEX=I
KEYLEN=32 KICKLEN=255 LINELEN=512 MAXLIST=I:100,X:100,b:100,e:100,g:100
MAXTARGETS=20 MODES=20 MONITOR=30 NAMELEN=128 NAMESX NETWORK=FooNet :are
supported by this server")
+ (0.01 ":irc.example.net 005 tester NICKLEN=30 PREFIX=(qaohv)~&@%+ SAFELIST
SILENCE=32 STATUSMSG=~&@%+ TOPICLEN=307 UHNAMES USERIP USERLEN=10
USERMODES=,,s,BIRcgikorw WHOX :are supported by this server")
+ (0.01 ":irc.example.net 251 tester :There are 2 users and 0 invisible on 2
servers")
+ (0.01 ":irc.example.net 253 tester 1 :unknown connections")
+ (0.01 ":irc.example.net 254 tester 1 :channels formed")
+ (0.00 ":irc.example.net 255 tester :I have 2 clients and 1 servers")
+ (0.00 ":irc.example.net 265 tester :Current local users: 2 Max: 3")
+ (0.00 ":irc.example.net 266 tester :Current global users: 2 Max: 3")
+ (0.00 ":irc.example.net 375 tester :irc.example.net message of the day")
+ (0.00 ":irc.example.net 372 tester : Have fun with the image!")
+ (0.00 ":irc.example.net 376 tester :End of message of the day."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":irc.example.net 501 tester x :is not a recognized user mode.")
+ (0.00 ":NickServ!NickServ@services.int NOTICE tester :Welcome to FooNet,
tester! Here on FooNet, we provide services to enable the registration of
nicknames and channels! For details, type \2/msg NickServ help\2 and \2/msg
ChanServ help\2.")
+ (0.02 ":tester!user@10.0.2.100 MODE tester :+i"))
+
+((join 10 "JOIN #chan")
+ (0.01 ":tester!user@10.0.2.100 JOIN :#chan"))
+
+((mode 10 "MODE #chan")
+ (0.01 ":irc.example.net 353 tester = #chan :@alice bob tester")
+ (0.01 ":irc.example.net 366 tester #chan :End of /NAMES list.")
+ (0.00 ":alice!alice@0::1 PRIVMSG #chan :tester, welcome!")
+ (0.02 ":bob!bob@0::1 PRIVMSG #chan :tester, welcome!")
+ (0.02 ":irc.example.net 324 tester #chan :+nt")
+ (0.01 ":irc.example.net 329 tester #chan :1672811954")
+ (0.07 ":alice!alice@0::1 PRIVMSG #chan :bob: This afternoon, sir ? well, she
shall be there.")
+ (0.05 ":bob!bob@0::1 PRIVMSG #chan :alice: The hour that fools should ask."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.04 "ERROR :Closing link: (user@10.0.2.100) [Quit: \2ERC\2]"))
+
+((drop 1 DROP))
diff --git a/test/lisp/eshell/em-prompt-tests.el
b/test/lisp/eshell/em-prompt-tests.el
new file mode 100644
index 00000000000..db45e2ae3a7
--- /dev/null
+++ b/test/lisp/eshell/em-prompt-tests.el
@@ -0,0 +1,120 @@
+;;; em-prompt-tests.el --- em-prompt test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for Eshell's prompt support.
+
+;;; Code:
+
+(require 'ert)
+(require 'eshell)
+(require 'em-prompt)
+
+(require 'eshell-tests-helpers
+ (expand-file-name "eshell-tests-helpers"
+ (file-name-directory (or load-file-name
+ default-directory))))
+
+;;; Tests:
+
+(ert-deftest em-prompt-test/field-properties ()
+ "Check that field properties are properly set on Eshell output/prompts."
+ (with-temp-eshell
+ (eshell-insert-command "echo hello")
+ (let ((last-prompt (field-string (1- eshell-last-input-start)))
+ (last-input (field-string (1+ eshell-last-input-start)))
+ (last-output (field-string (1+ eshell-last-input-end))))
+ (should (equal-including-properties
+ last-prompt
+ (propertize
+ (format "%s %s " (directory-file-name default-directory)
+ (if (= (file-user-uid) 0) "#" "$"))
+ 'read-only t
+ 'field 'prompt
+ 'font-lock-face 'eshell-prompt
+ 'front-sticky '(read-only field font-lock-face)
+ 'rear-nonsticky '(read-only field font-lock-face))))
+ (should (equal last-input "echo hello\n"))
+ (should (equal-including-properties
+ last-output
+ (propertize "hello\n" 'rear-nonsticky '(field)
+ 'field 'command-output))))))
+
+(ert-deftest em-prompt-test/field-properties/no-highlight ()
+ "Check that field properties are properly set on Eshell output/prompts.
+This tests the case when `eshell-highlight-prompt' is nil."
+ (let ((eshell-highlight-prompt nil))
+ (with-temp-eshell
+ (eshell-insert-command "echo hello")
+ (let ((last-prompt (field-string (1- eshell-last-input-start)))
+ (last-input (field-string (1+ eshell-last-input-start)))
+ (last-output (field-string (1+ eshell-last-input-end))))
+ (should (equal-including-properties
+ last-prompt
+ (propertize
+ (format "%s %s " (directory-file-name default-directory)
+ (if (= (file-user-uid) 0) "#" "$"))
+ 'field 'prompt
+ 'front-sticky '(field)
+ 'rear-nonsticky '(field))))
+ (should (equal last-input "echo hello\n"))
+ (should (equal-including-properties
+ last-output
+ (propertize "hello\n" 'rear-nonsticky '(field)
+ 'field 'command-output)))))))
+
+(ert-deftest em-prompt-test/next-previous-prompt ()
+ "Check that navigating forward/backward through old prompts works correctly."
+ (with-temp-eshell
+ (eshell-insert-command "echo one")
+ (eshell-insert-command "echo two")
+ (eshell-insert-command "echo three")
+ (insert "echo fou") ; A partially-entered command.
+ ;; Go back one prompt.
+ (eshell-previous-prompt 1)
+ (should (equal (eshell-get-old-input) "echo three"))
+ ;; Go back two prompts, starting from the end of this line.
+ (end-of-line)
+ (eshell-previous-prompt 2)
+ (should (equal (eshell-get-old-input) "echo one"))
+ ;; Go forward three prompts.
+ (eshell-next-prompt 3)
+ (should (equal (eshell-get-old-input) "echo fou"))))
+
+(ert-deftest em-prompt-test/forward-backward-matching-input ()
+ "Check that navigating forward/backward via regexps works correctly."
+ (with-temp-eshell
+ (eshell-insert-command "echo one")
+ (eshell-insert-command "printnl something else")
+ (eshell-insert-command "echo two")
+ (eshell-insert-command "echo three")
+ (insert "echo fou") ; A partially-entered command.
+ ;; Go back one prompt.
+ (eshell-backward-matching-input "echo" 1)
+ (should (equal (eshell-get-old-input) "echo three"))
+ ;; Go back two prompts, starting from the end of this line.
+ (end-of-line)
+ (eshell-backward-matching-input "echo" 2)
+ (should (equal (eshell-get-old-input) "echo one"))
+ ;; Go forward three prompts.
+ (eshell-forward-matching-input "echo" 3)
+ (should (equal (eshell-get-old-input) "echo fou"))))
+
+;;; em-prompt-tests.el ends here
diff --git a/test/lisp/eshell/esh-proc-tests.el
b/test/lisp/eshell/esh-proc-tests.el
index ae7b1dddd69..8e02fbb5497 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -19,6 +19,7 @@
;;; Code:
+(require 'tramp)
(require 'ert)
(require 'esh-mode)
(require 'eshell)
@@ -85,6 +86,18 @@
"\\`\\'"))
(should (equal (buffer-string) "stdout\nstderr\n"))))
+(ert-deftest esh-var-test/output/remote-redirect ()
+ "Check that redirecting stdout for a remote process works."
+ (skip-unless (and (eshell-tests-remote-accessible-p)
+ (executable-find "echo")))
+ (let ((default-directory ert-remote-temporary-file-directory))
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "*echo hello > #<%s>" bufname)
+ "\\`\\'"))
+ (should (equal (buffer-string) "hello\n")))))
+
;; Exit status
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index 3f602798dbe..12412d13640 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -82,8 +82,19 @@
(eshell-command-result-equal "echo $eshell-test-value[0 2 4]"
'("zero" "two" "four"))))
+(ert-deftest esh-var-test/interp-var-indices-subcommand ()
+ "Interpolate list variable with subcommand expansion for indices."
+ (skip-unless (executable-find "echo"))
+ (let ((eshell-test-value '("zero" "one" "two" "three" "four")))
+ (eshell-command-result-equal
+ "echo $eshell-test-value[${*echo 0}]"
+ "zero")
+ (eshell-command-result-equal
+ "echo $eshell-test-value[${*echo 0} ${*echo 2}]"
+ '("zero" "two"))))
+
(ert-deftest esh-var-test/interp-var-split-indices ()
- "Interpolate string variable with indices"
+ "Interpolate string variable with indices."
(let ((eshell-test-value "zero one two three four"))
(eshell-command-result-equal "echo $eshell-test-value[0]"
"zero")
@@ -93,7 +104,7 @@
'("zero" "two" "four"))))
(ert-deftest esh-var-test/interp-var-string-split-indices ()
- "Interpolate string variable with string splitter and indices"
+ "Interpolate string variable with string splitter and indices."
(let ((eshell-test-value "zero:one:two:three:four"))
(eshell-command-result-equal "echo $eshell-test-value[: 0]"
"zero")
@@ -106,7 +117,7 @@
'("zero" "two"))))
(ert-deftest esh-var-test/interp-var-regexp-split-indices ()
- "Interpolate string variable with regexp splitter and indices"
+ "Interpolate string variable with regexp splitter and indices."
(let ((eshell-test-value "zero:one!two:three!four"))
(eshell-command-result-equal "echo $eshell-test-value['[:!]' 0]"
"zero")
@@ -118,7 +129,7 @@
'("zero" "two"))))
(ert-deftest esh-var-test/interp-var-assoc ()
- "Interpolate alist variable with index"
+ "Interpolate alist variable with index."
(let ((eshell-test-value '(("foo" . 1) (bar . 2))))
(eshell-command-result-equal "echo $eshell-test-value[foo]"
1)
@@ -126,7 +137,7 @@
2)))
(ert-deftest esh-var-test/interp-var-length-list ()
- "Interpolate length of list variable"
+ "Interpolate length of list variable."
(let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9)))))
(eshell-command-result-equal "echo $#eshell-test-value" 3)
(eshell-command-result-equal "echo $#eshell-test-value[1]" 1)
@@ -138,19 +149,19 @@
(eshell-command-result-equal "echo $#eshell-test-value" 6)))
(ert-deftest esh-var-test/interp-var-length-alist ()
- "Interpolate length of alist variable"
+ "Interpolate length of alist variable."
(let ((eshell-test-value '(("foo" . (1 2 3)))))
(eshell-command-result-equal "echo $#eshell-test-value" 1)
(eshell-command-result-equal "echo $#eshell-test-value[foo]" 3)))
(ert-deftest esh-var-test/interp-var-splice ()
- "Splice-interpolate list variable"
+ "Splice-interpolate list variable."
(let ((eshell-test-value '(1 2 3)))
(eshell-command-result-equal "echo a $@eshell-test-value z"
'("a" 1 2 3 "z"))))
(ert-deftest esh-var-test/interp-var-splice-concat ()
- "Splice-interpolate and concat list variable"
+ "Splice-interpolate and concat list variable."
(let ((eshell-test-value '(1 2 3)))
(eshell-command-result-equal "echo it is a$@'eshell-test-value'z"
'("it" "is" "a1" 2 "3z"))
@@ -164,49 +175,49 @@
'("it" "is" 1 2 (31 2 3)))))
(ert-deftest esh-var-test/interp-lisp ()
- "Interpolate Lisp form evaluation"
+ "Interpolate Lisp form evaluation."
(eshell-command-result-equal "+ $(+ 1 2) 3" 6))
(ert-deftest esh-var-test/interp-lisp-indices ()
- "Interpolate Lisp form evaluation with index"
+ "Interpolate Lisp form evaluation with index."
(eshell-command-result-equal "+ $(list 1 2)[1] 3" 5))
(ert-deftest esh-var-test/interp-cmd ()
- "Interpolate command result"
+ "Interpolate command result."
(eshell-command-result-equal "+ ${+ 1 2} 3" 6))
(ert-deftest esh-var-test/interp-cmd-indices ()
- "Interpolate command result with index"
+ "Interpolate command result with index."
(eshell-command-result-equal "+ ${listify 1 2}[1] 3" 5))
(ert-deftest esh-var-test/interp-cmd-external ()
- "Interpolate command result from external command"
+ "Interpolate command result from external command."
(skip-unless (executable-find "echo"))
(with-temp-eshell
(eshell-match-command-output "echo ${*echo hi}"
"hi\n")))
(ert-deftest esh-var-test/interp-cmd-external-indices ()
- "Interpolate command result from external command with index"
+ "Interpolate command result from external command with index."
(skip-unless (executable-find "echo"))
(with-temp-eshell
(eshell-match-command-output "echo ${*echo \"hi\nbye\"}[1]"
"bye\n")))
(ert-deftest esh-var-test/interp-temp-cmd ()
- "Interpolate command result redirected to temp file"
+ "Interpolate command result redirected to temp file."
(eshell-command-result-equal "cat $<echo hi>" "hi"))
(ert-deftest esh-var-test/interp-concat-lisp ()
- "Interpolate and concat Lisp form"
+ "Interpolate and concat Lisp form."
(eshell-command-result-equal "+ $(+ 1 2)3 3" 36))
(ert-deftest esh-var-test/interp-concat-lisp2 ()
- "Interpolate and concat two Lisp forms"
+ "Interpolate and concat two Lisp forms."
(eshell-command-result-equal "+ $(+ 1 2)$(+ 1 2) 3" 36))
(ert-deftest esh-var-test/interp-concat-cmd ()
- "Interpolate and concat command with literal"
+ "Interpolate and concat command with literal."
(eshell-command-result-equal "+ ${+ 1 2}3 3" 36)
(eshell-command-result-equal "echo ${*echo \"foo\nbar\"}-baz"
'("foo" "bar-baz"))
@@ -219,11 +230,11 @@
'("hi" "23")))
(ert-deftest esh-var-test/interp-concat-cmd2 ()
- "Interpolate and concat two commands"
+ "Interpolate and concat two commands."
(eshell-command-result-equal "+ ${+ 1 2}${+ 1 2} 3" 36))
(ert-deftest esh-var-test/interp-concat-cmd-external ()
- "Interpolate command result from external command with concatenation"
+ "Interpolate command result from external command with concatenation."
(skip-unless (executable-find "echo"))
(with-temp-eshell
(eshell-match-command-output "echo ${echo hi}-${*echo there}"
@@ -233,7 +244,7 @@
;; Quoted variable interpolation
(ert-deftest esh-var-test/quoted-interp-var ()
- "Interpolate variable inside double-quotes"
+ "Interpolate variable inside double-quotes."
(eshell-command-result-equal "echo \"$user-login-name\""
user-login-name))
@@ -245,7 +256,7 @@
(concat "hi, " user-login-name)))
(ert-deftest esh-var-test/quoted-interp-list-var ()
- "Interpolate list variable inside double-quotes"
+ "Interpolate list variable inside double-quotes."
(let ((eshell-test-value '(1 2 3)))
(eshell-command-result-equal "echo \"$eshell-test-value\""
"(1 2 3)")))
@@ -257,7 +268,7 @@
"a(1 2 3)z")))
(ert-deftest esh-var-test/quoted-interp-var-indices ()
- "Interpolate string variable with indices inside double-quotes"
+ "Interpolate string variable with indices inside double-quotes."
(let ((eshell-test-value '("zero" "one" "two" "three" "four")))
(eshell-command-result-equal "echo \"$eshell-test-value[0]\""
"zero")
@@ -271,8 +282,21 @@
(eshell-command-result-equal "echo \"$eshell-test-value[1 2 4]\""
"(\"one\" \"two\" \"four\")")))
+(ert-deftest esh-var-test/quote-interp-var-indices-subcommand ()
+ "Interpolate list variable with subcommand expansion for indices inside
double-quotes."
+ (skip-unless (executable-find "echo"))
+ (let ((eshell-test-value '("zero" "one" "two" "three" "four")))
+ (eshell-command-result-equal
+ "echo \"$eshell-test-value[${*echo 0}]\""
+ "zero")
+ ;; FIXME: These tests would use the 0th index like the other tests
+ ;; here, but see above.
+ (eshell-command-result-equal
+ "echo \"$eshell-test-value[${*echo 1} ${*echo 2}]\""
+ "(\"one\" \"two\")")))
+
(ert-deftest esh-var-test/quoted-interp-var-split-indices ()
- "Interpolate string variable with indices inside double-quotes"
+ "Interpolate string variable with indices inside double-quotes."
(let ((eshell-test-value "zero one two three four"))
(eshell-command-result-equal "echo \"$eshell-test-value[0]\""
"zero")
@@ -280,8 +304,7 @@
"(\"zero\" \"two\")")))
(ert-deftest esh-var-test/quoted-interp-var-string-split-indices ()
- "Interpolate string variable with string splitter and indices
-inside double-quotes"
+ "Interpolate string variable with string splitter and indices inside
double-quotes."
(let ((eshell-test-value "zero:one:two:three:four"))
(eshell-command-result-equal "echo \"$eshell-test-value[: 0]\""
"zero")
@@ -294,7 +317,7 @@ inside double-quotes"
"(\"zero\" \"two\")")))
(ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices ()
- "Interpolate string variable with regexp splitter and indices"
+ "Interpolate string variable with regexp splitter and indices."
(let ((eshell-test-value "zero:one!two:three!four"))
(eshell-command-result-equal "echo \"$eshell-test-value['[:!]' 0]\""
"zero")
@@ -307,7 +330,7 @@ inside double-quotes"
"(\"zero\" \"two\")")))
(ert-deftest esh-var-test/quoted-interp-var-assoc ()
- "Interpolate alist variable with index inside double-quotes"
+ "Interpolate alist variable with index inside double-quotes."
(let ((eshell-test-value '(("foo" . 1) (bar . 2))))
(eshell-command-result-equal "echo \"$eshell-test-value[foo]\""
"1")
@@ -315,7 +338,7 @@ inside double-quotes"
"2")))
(ert-deftest esh-var-test/quoted-interp-var-length-list ()
- "Interpolate length of list variable inside double-quotes"
+ "Interpolate length of list variable inside double-quotes."
(let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9)))))
(eshell-command-result-equal "echo \"$#eshell-test-value\""
"3")
@@ -325,13 +348,13 @@ inside double-quotes"
"4")))
(ert-deftest esh-var-test/quoted-interp-var-length-string ()
- "Interpolate length of string variable inside double-quotes"
+ "Interpolate length of string variable inside double-quotes."
(let ((eshell-test-value "foobar"))
(eshell-command-result-equal "echo \"$#eshell-test-value\""
"6")))
(ert-deftest esh-var-test/quoted-interp-var-length-alist ()
- "Interpolate length of alist variable inside double-quotes"
+ "Interpolate length of alist variable inside double-quotes."
(let ((eshell-test-value '(("foo" . (1 2 3)))))
(eshell-command-result-equal "echo \"$#eshell-test-value\""
"1")
@@ -339,7 +362,7 @@ inside double-quotes"
"3")))
(ert-deftest esh-var-test/quoted-interp-var-splice ()
- "Splice-interpolate list variable inside double-quotes"
+ "Splice-interpolate list variable inside double-quotes."
(let ((eshell-test-value '(1 2 3)))
(eshell-command-result-equal "echo a \"$@eshell-test-value\" z"
'("a" "1 2 3" "z"))))
@@ -351,27 +374,27 @@ inside double-quotes"
"a1 2 3z")))
(ert-deftest esh-var-test/quoted-interp-lisp ()
- "Interpolate Lisp form evaluation inside double-quotes"
+ "Interpolate Lisp form evaluation inside double-quotes."
(eshell-command-result-equal "echo \"hi $(concat \\\"the\\\" \\\"re\\\")\""
"hi there"))
(ert-deftest esh-var-test/quoted-interp-lisp-indices ()
- "Interpolate Lisp form evaluation with index"
+ "Interpolate Lisp form evaluation with index."
(eshell-command-result-equal "concat \"$(list 1 2)[1]\" cool"
"2cool"))
(ert-deftest esh-var-test/quoted-interp-cmd ()
- "Interpolate command result inside double-quotes"
+ "Interpolate command result inside double-quotes."
(eshell-command-result-equal "echo \"hi ${echo \\\"there\\\"}\""
"hi there"))
(ert-deftest esh-var-test/quoted-interp-cmd-indices ()
- "Interpolate command result with index inside double-quotes"
+ "Interpolate command result with index inside double-quotes."
(eshell-command-result-equal "concat \"${listify 1 2}[1]\" cool"
"2cool"))
(ert-deftest esh-var-test/quoted-interp-temp-cmd ()
- "Interpolate command result redirected to temp file inside double-quotes"
+ "Interpolate command result redirected to temp file inside double-quotes."
(let ((temporary-file-directory
(file-name-as-directory (make-temp-file "esh-vars-tests" t))))
(unwind-protect
@@ -379,7 +402,7 @@ inside double-quotes"
(delete-directory temporary-file-directory t))))
(ert-deftest esh-var-test/quoted-interp-concat-cmd ()
- "Interpolate and concat command with literal"
+ "Interpolate and concat command with literal."
(eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"} baz\""
"foo\nbar baz"))
@@ -387,13 +410,13 @@ inside double-quotes"
;; Interpolating commands
(ert-deftest esh-var-test/command-interp ()
- "Interpolate a variable as a command name"
+ "Interpolate a variable as a command name."
(let ((eshell-test-value "printnl"))
(eshell-command-result-equal "$eshell-test-value hello there"
"hello\nthere\n")))
(ert-deftest esh-var-test/command-interp-splice ()
- "Interpolate a splice variable as a command name with arguments"
+ "Interpolate a splice variable as a command name with arguments."
(let ((eshell-test-value '("printnl" "hello" "there")))
(eshell-command-result-equal "$@eshell-test-value"
"hello\nthere\n")))
@@ -402,13 +425,13 @@ inside double-quotes"
;; Interpolated variable conversion
(ert-deftest esh-var-test/interp-convert-var-number ()
- "Interpolate numeric variable"
+ "Interpolate numeric variable."
(let ((eshell-test-value 123))
(eshell-command-result-equal "type-of $eshell-test-value"
'integer)))
(ert-deftest esh-var-test/interp-convert-var-split-indices ()
- "Interpolate and convert string variable with indices"
+ "Interpolate and convert string variable with indices."
;; Check that numeric forms are converted to numbers.
(let ((eshell-test-value "000 010 020 030 040"))
(eshell-command-result-equal "echo $eshell-test-value[0]"
@@ -423,7 +446,7 @@ inside double-quotes"
"baz\n")))
(ert-deftest esh-var-test/interp-convert-quoted-var-number ()
- "Interpolate numeric quoted numeric variable"
+ "Interpolate numeric quoted numeric variable."
(let ((eshell-test-value 123))
(eshell-command-result-equal "type-of $'eshell-test-value'"
'integer)
@@ -431,7 +454,7 @@ inside double-quotes"
'integer)))
(ert-deftest esh-var-test/interp-convert-quoted-var-split-indices ()
- "Interpolate and convert quoted string variable with indices"
+ "Interpolate and convert quoted string variable with indices."
(let ((eshell-test-value "000 010 020 030 040"))
(eshell-command-result-equal "echo $'eshell-test-value'[0]"
0)
@@ -439,11 +462,11 @@ inside double-quotes"
'(0 20))))
(ert-deftest esh-var-test/interp-convert-cmd-string-newline ()
- "Interpolate trailing-newline command result"
+ "Interpolate trailing-newline command result."
(eshell-command-result-equal "echo ${echo \"foo\n\"}" "foo"))
(ert-deftest esh-var-test/interp-convert-cmd-multiline ()
- "Interpolate multi-line command result"
+ "Interpolate multi-line command result."
(eshell-command-result-equal "echo ${echo \"foo\nbar\"}"
'("foo" "bar"))
;; Numeric output should be converted to numbers...
@@ -454,24 +477,24 @@ inside double-quotes"
'("01" "02" "hi")))
(ert-deftest esh-var-test/interp-convert-cmd-number ()
- "Interpolate numeric command result"
+ "Interpolate numeric command result."
(eshell-command-result-equal "echo ${echo \"1\"}" 1))
(ert-deftest esh-var-test/interp-convert-cmd-split-indices ()
- "Interpolate command result with indices"
+ "Interpolate command result with indices."
(eshell-command-result-equal "echo ${echo \"000 010 020\"}[0]"
0)
(eshell-command-result-equal "echo ${echo \"000 010 020\"}[0 2]"
'(0 20)))
(ert-deftest esh-var-test/quoted-interp-convert-var-number ()
- "Interpolate numeric variable inside double-quotes"
+ "Interpolate numeric variable inside double-quotes."
(let ((eshell-test-value 123))
(eshell-command-result-equal "type-of \"$eshell-test-value\""
'string)))
(ert-deftest esh-var-test/quoted-interp-convert-var-split-indices ()
- "Interpolate string variable with indices inside double-quotes"
+ "Interpolate string variable with indices inside double-quotes."
(let ((eshell-test-value "000 010 020 030 040"))
(eshell-command-result-equal "echo \"$eshell-test-value[0]\""
"000")
@@ -479,7 +502,7 @@ inside double-quotes"
"(\"000\" \"020\")")))
(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number ()
- "Interpolate numeric quoted variable inside double-quotes"
+ "Interpolate numeric quoted variable inside double-quotes."
(let ((eshell-test-value 123))
(eshell-command-result-equal "type-of \"$'eshell-test-value'\""
'string)
@@ -487,7 +510,7 @@ inside double-quotes"
'string)))
(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices ()
- "Interpolate quoted string variable with indices inside double-quotes"
+ "Interpolate quoted string variable with indices inside double-quotes."
(let ((eshell-test-value "000 010 020 030 040"))
(eshell-command-result-equal "echo \"$eshell-test-value[0]\""
"000")
@@ -495,23 +518,23 @@ inside double-quotes"
"(\"000\" \"020\")")))
(ert-deftest esh-var-test/quoted-interp-convert-cmd-string-newline ()
- "Interpolate trailing-newline command result inside double-quotes"
+ "Interpolate trailing-newline command result inside double-quotes."
(eshell-command-result-equal "echo \"${echo \\\"foo\n\\\"}\""
"foo")
(eshell-command-result-equal "echo \"${echo \\\"foo\n\n\\\"}\""
"foo"))
(ert-deftest esh-var-test/quoted-interp-convert-cmd-multiline ()
- "Interpolate multi-line command result inside double-quotes"
+ "Interpolate multi-line command result inside double-quotes."
(eshell-command-result-equal "echo \"${echo \\\"foo\nbar\\\"}\""
"foo\nbar"))
(ert-deftest esh-var-test/quoted-interp-convert-cmd-number ()
- "Interpolate numeric command result inside double-quotes"
+ "Interpolate numeric command result inside double-quotes."
(eshell-command-result-equal "echo \"${echo \\\"1\\\"}\"" "1"))
(ert-deftest esh-var-test/quoted-interp-convert-cmd-split-indices ()
- "Interpolate command result with indices inside double-quotes"
+ "Interpolate command result with indices inside double-quotes."
(eshell-command-result-equal "echo \"${echo \\\"000 010 020\\\"}[0]\""
"000"))
@@ -670,19 +693,19 @@ it, since the setter is nil."
(window-body-height nil 'remap)))
(ert-deftest esh-var-test/columns-var ()
- "$COLUMNS should equal (window-body-width nil 'remap)"
+ "$COLUMNS should equal (window-body-width nil 'remap)."
(eshell-command-result-equal "echo $COLUMNS"
(window-body-width nil 'remap)))
(ert-deftest esh-var-test/inside-emacs-var ()
- "Test presence of \"INSIDE_EMACS\" in subprocesses"
+ "Test presence of \"INSIDE_EMACS\" in subprocesses."
(with-temp-eshell
(eshell-match-command-output "env"
(format "INSIDE_EMACS=%s,eshell"
emacs-version))))
(ert-deftest esh-var-test/inside-emacs-var-split-indices ()
- "Test using \"INSIDE_EMACS\" with split indices"
+ "Test using \"INSIDE_EMACS\" with split indices."
(with-temp-eshell
(eshell-match-command-output "echo $INSIDE_EMACS[, 1]"
"eshell")))
@@ -746,8 +769,12 @@ it, since the setter is nil."
(format "cd %s" ert-remote-temporary-file-directory))
(eshell-match-command-output "echo $PATH" (regexp-quote remote-path)))))
+(ert-deftest esh-var-test/uid-var ()
+ "Test that $UID is equivalent to (user-uid) for local directories."
+ (eshell-command-result-equal "echo $UID" (user-uid)))
+
(ert-deftest esh-var-test/last-status-var-lisp-command ()
- "Test using the \"last exit status\" ($?) variable with a Lisp command"
+ "Test using the \"last exit status\" ($?) variable with a Lisp command."
(with-temp-eshell
(eshell-match-command-output "zerop 0; echo $?"
"t\n0\n")
@@ -757,7 +784,7 @@ it, since the setter is nil."
"1\n" nil t)))
(ert-deftest esh-var-test/last-status-var-lisp-form ()
- "Test using the \"last exit status\" ($?) variable with a Lisp form"
+ "Test using the \"last exit status\" ($?) variable with a Lisp form."
(let ((eshell-lisp-form-nil-is-failure t))
(with-temp-eshell
(eshell-match-command-output "(zerop 0); echo $?"
@@ -780,7 +807,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"1\n" nil t))))
(ert-deftest esh-var-test/last-status-var-ext-cmd ()
- "Test using the \"last exit status\" ($?) variable with an external command"
+ "Test using the \"last exit status\" ($?) variable with an external command."
(skip-unless (executable-find "["))
(with-temp-eshell
(eshell-match-command-output "[ foo = foo ]; echo $?"
@@ -789,19 +816,19 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"1\n")))
(ert-deftest esh-var-test/last-result-var ()
- "Test using the \"last result\" ($$) variable"
+ "Test using the \"last result\" ($$) variable."
(with-temp-eshell
(eshell-match-command-output "+ 1 2; + $$ 2"
"3\n5\n")))
(ert-deftest esh-var-test/last-result-var-twice ()
- "Test using the \"last result\" ($$) variable twice"
+ "Test using the \"last result\" ($$) variable twice."
(with-temp-eshell
(eshell-match-command-output "+ 1 2; + $$ $$"
"3\n6\n")))
(ert-deftest esh-var-test/last-result-var-ext-cmd ()
- "Test using the \"last result\" ($$) variable with an external command"
+ "Test using the \"last result\" ($$) variable with an external command."
(skip-unless (executable-find "["))
(with-temp-eshell
;; MS-DOS/MS-Windows have an external command 'format', which we
@@ -813,7 +840,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"nil\n"))))
(ert-deftest esh-var-test/last-result-var-split-indices ()
- "Test using the \"last result\" ($$) variable with split indices"
+ "Test using the \"last result\" ($$) variable with split indices."
(with-temp-eshell
(eshell-match-command-output
"string-join (list \"01\" \"02\") :; + $$[: 1] 3"
@@ -823,13 +850,13 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"01:02\n02\n")))
(ert-deftest esh-var-test/last-arg-var ()
- "Test using the \"last arg\" ($_) variable"
+ "Test using the \"last arg\" ($_) variable."
(with-temp-eshell
(eshell-match-command-output "+ 1 2; + $_ 4"
"3\n6\n")))
(ert-deftest esh-var-test/last-arg-var-indices ()
- "Test using the \"last arg\" ($_) variable with indices"
+ "Test using the \"last arg\" ($_) variable with indices."
(with-temp-eshell
(eshell-match-command-output "+ 1 2; + $_[0] 4"
"3\n5\n")
@@ -837,7 +864,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"3\n6\n")))
(ert-deftest esh-var-test/last-arg-var-split-indices ()
- "Test using the \"last arg\" ($_) variable with split indices"
+ "Test using the \"last arg\" ($_) variable with split indices."
(with-temp-eshell
(eshell-match-command-output "concat 01:02 03:04; + $_[0][: 1] 5"
"01:0203:04\n7\n")
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index be968e1558f..776cfb9b92f 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -117,14 +117,14 @@
(with-temp-eshell
(eshell-insert-command "echo $(+ 1 (- 4 3)) \"alpha beta\" file" 'ignore)
(let ((here (point)) begin valid)
- (eshell-bol)
+ (beginning-of-line)
(setq begin (point))
(eshell-forward-argument 4)
(setq valid (= here (point)))
(eshell-backward-argument 4)
(prog1
(and valid (= begin (point)))
- (eshell-bol)
+ (beginning-of-line)
(delete-region (point) (point-max))))))
(ert-deftest eshell-test/queue-input ()
@@ -148,12 +148,17 @@ insert the queued one at the next prompt, and finally run
it."
(should (eshell-match-output
(concat "^" (regexp-quote "*** output flushed ***\n") "$")))))
-(ert-deftest eshell-test/run-old-command ()
- "Re-run an old command"
+(ert-deftest eshell-test/get-old-input ()
+ "Test that we can get the input of a previous command."
(with-temp-eshell
(eshell-insert-command "echo alpha")
(goto-char eshell-last-input-start)
- (string= (eshell-get-old-input) "echo alpha")))
+ (should (string= (eshell-get-old-input) "echo alpha"))
+ ;; Make sure that `eshell-get-old-input' works even if the point is
+ ;; inside the prompt.
+ (let ((inhibit-field-text-motion t))
+ (beginning-of-line))
+ (should (string= (eshell-get-old-input) "echo alpha"))))
(provide 'eshell-tests)
diff --git a/test/lisp/international/mule-tests.el
b/test/lisp/international/mule-tests.el
index 4f70b275848..6e23d8c5421 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -70,6 +70,72 @@
;; The chinese-hz encoding is not ASCII compatible.
(should-not (coding-system-get 'chinese-hz :ascii-compatible-p)))
+;;; Testing `sgml-html-meta-auto-coding-function'.
+
+(defconst sgml-html-meta-pre "<!doctype html><html><head>"
+ "The beginning of a minimal HTML document.")
+
+(defconst sgml-html-meta-post "</head></html>"
+ "The end of a minimal HTML document.")
+
+(defun sgml-html-meta-run (coding-system)
+ "Run `sgml-html-meta-auto-coding-function' on a minimal HTML.
+When CODING-SYSTEM is not nil, insert it, wrapped in a '<meta>'
+element. When CODING-SYSTEM contains HTML meta characters or
+white space, insert it as-is, without additional formatting. Use
+the variables `sgml-html-meta-pre' and `sgml-html-meta-post' to
+provide HTML fragments. Some tests override those variables."
+ (with-temp-buffer
+ (insert sgml-html-meta-pre
+ (cond ((not coding-system)
+ "")
+ ((string-match "[<>'\"\n ]" coding-system)
+ coding-system)
+ (t
+ (format "<meta charset='%s'>" coding-system)))
+ sgml-html-meta-post)
+ (goto-char (point-min))
+ (sgml-html-meta-auto-coding-function (- (point-max) (point-min)))))
+
+(ert-deftest sgml-html-meta-utf-8 ()
+ "Baseline: UTF-8."
+ (should (eq 'utf-8 (sgml-html-meta-run "utf-8"))))
+
+(ert-deftest sgml-html-meta-windows-hebrew ()
+ "A non-Unicode charset."
+ (should (eq 'windows-1255 (sgml-html-meta-run "windows-1255"))))
+
+(ert-deftest sgml-html-meta-none ()
+ (should (eq nil (sgml-html-meta-run nil))))
+
+(ert-deftest sgml-html-meta-unknown-coding ()
+ (should (eq nil (sgml-html-meta-run "XXX"))))
+
+(ert-deftest sgml-html-meta-no-pre ()
+ "Without the prefix, so not HTML."
+ (let ((sgml-html-meta-pre ""))
+ (should (eq nil (sgml-html-meta-run "utf-8")))))
+
+(ert-deftest sgml-html-meta-no-post-less-than-10lines ()
+ "No '</head>', detect charset in the first 10 lines."
+ (let ((sgml-html-meta-post ""))
+ (should (eq 'utf-8 (sgml-html-meta-run
+ (concat "\n\n\n\n\n\n\n\n\n"
+ "<meta charset='utf-8'>"))))))
+
+(ert-deftest sgml-html-meta-no-post-10lines ()
+ "No '</head>', do not detect charset after the first 10 lines."
+ (let ((sgml-html-meta-post ""))
+ (should (eq nil (sgml-html-meta-run
+ (concat "\n\n\n\n\n\n\n\n\n\n"
+ "<meta charset='utf-8'>"))))))
+
+(ert-deftest sgml-html-meta-utf-8-with-bom ()
+ "Requesting 'UTF-8' does not override `utf-8-with-signature'.
+Check fix for Bug#20623."
+ (let ((buffer-file-coding-system 'utf-8-with-signature))
+ (should (eq 'utf-8-with-signature (sgml-html-meta-run "utf-8")))))
+
;; Stop "Local Variables" above causing confusion when visiting this file.
diff --git a/test/lisp/net/tramp-archive-tests.el
b/test/lisp/net/tramp-archive-tests.el
index 85766f95cda..94ef40a1116 100644
--- a/test/lisp/net/tramp-archive-tests.el
+++ b/test/lisp/net/tramp-archive-tests.el
@@ -685,6 +685,7 @@ This tests also `access-file', `file-readable-p' and
`file-regular-p'."
;; Symlink.
(should (file-exists-p tmp-name2))
(should (file-symlink-p tmp-name2))
+ (should (file-regular-p tmp-name2))
(setq attr (file-attributes tmp-name2))
(should (string-equal (car attr) (file-name-nondirectory tmp-name1)))
@@ -775,12 +776,14 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(unwind-protect
(progn
(should (file-exists-p tmp-name1))
+ (should (file-regular-p tmp-name1))
(should (string-equal tmp-name1 (file-truename tmp-name1)))
;; `make-symbolic-link' is not implemented.
(should-error
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-error)
(should (file-symlink-p tmp-name2))
+ (should (file-regular-p tmp-name2))
(should
(string-equal
;; This is "/foo.txt".
@@ -872,13 +875,24 @@ This tests also `file-executable-p', `file-writable-p'
and `set-file-modes'."
(let ((fsi (file-system-info tramp-archive-test-archive)))
(skip-unless fsi)
(should (and (consp fsi)
- (= (length fsi) 3)
+ (tramp-compat-length= fsi 3)
(numberp (nth 0 fsi))
;; FREE and AVAIL are always 0.
(zerop (nth 1 fsi))
(zerop (nth 2 fsi))))))
-(ert-deftest tramp-archive-test47-auto-load ()
+;; `file-user-uid' was introduced in Emacs 30.1.
+(ert-deftest tramp-archive-test44-file-user-uid ()
+ "Check that `file-user-uid' returns proper values."
+ (skip-unless tramp-archive-enabled)
+ (skip-unless (fboundp 'file-user-uid))
+
+ (let ((default-directory tramp-archive-test-archive))
+ ;; `file-user-uid' exists since Emacs 30.1. We don't want to see
+ ;; compiler warnings for older Emacsen.
+ (should (integerp (with-no-warnings (file-user-uid))))))
+
+(ert-deftest tramp-archive-test48-auto-load ()
"Check that `tramp-archive' autoloads properly."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
@@ -923,7 +937,7 @@ This tests also `file-executable-p', `file-writable-p' and
`set-file-modes'."
(format "(setq tramp-archive-enabled %s)" enabled))
(shell-quote-argument (format code file)))))))))))
-(ert-deftest tramp-archive-test47-delay-load ()
+(ert-deftest tramp-archive-test48-delay-load ()
"Check that `tramp-archive' is loaded lazily, only when needed."
:tags '(:expensive-test)
(skip-unless tramp-archive-enabled)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 90f6fcd6b15..59e160c9d71 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -33,7 +33,7 @@
;; remote host, set this environment variable to "/dev/null" or
;; whatever is appropriate on your system.
-;; For slow remote connections, `tramp-test44-asynchronous-requests'
+;; For slow remote connections, `tramp-test45-asynchronous-requests'
;; might be too heavy. Setting $REMOTE_PARALLEL_PROCESSES to a proper
;; value less than 10 could help.
@@ -80,6 +80,9 @@
(defvar remote-file-name-inhibit-locks)
(defvar dired-copy-dereference)
+;; Declared in Emacs 30.
+(defvar remote-file-name-inhibit-delete-by-moving-to-trash)
+
;; `ert-resource-file' was introduced in Emacs 28.1.
(unless (macrop 'ert-resource-file)
(eval-and-compile
@@ -162,6 +165,9 @@ A resource file is in the resource directory as per
;; Suppress nasty messages.
(fset #'shell-command-sentinel #'ignore)
;; We do not want to be interrupted.
+ (fset #'tramp-action-yesno
+ (lambda (_proc vec)
+ (tramp-send-string vec (concat "yes" tramp-local-end-of-line)) t))
(eval-after-load 'tramp-gvfs
'(fset 'tramp-gvfs-handler-askquestion
(lambda (_message _choices) '(t nil 0)))))
@@ -2345,7 +2351,24 @@ This checks also `file-name-as-directory',
`file-name-directory',
(expand-file-name
(file-name-nondirectory tmp-name) trash-directory))))
(delete-directory trash-directory 'recursive)
- (should-not (file-exists-p trash-directory)))))))
+ (should-not (file-exists-p trash-directory))))
+
+ ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash'
+ ;; prevents trashing remote files.
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t)
+ (remote-file-name-inhibit-delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ (should-not (file-exists-p tmp-name))
+ (write-region "foo" nil tmp-name)
+ (should (file-exists-p tmp-name))
+ (delete-file tmp-name 'trash)
+ (should-not (file-exists-p tmp-name))
+ (should-not
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory tmp-name) trash-directory)))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory))))))
(ert-deftest tramp-test08-file-local-copy ()
"Check `file-local-copy'."
@@ -2953,7 +2976,23 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
"%s/%s/%s/bla" trash-directory (file-name-nondirectory tmp-name1)
(file-name-nondirectory tmp-name2))))
(delete-directory trash-directory 'recursive)
- (should-not (file-exists-p trash-directory)))))))
+ (should-not (file-exists-p trash-directory))))
+
+ ;; Setting `remote-file-name-inhibit-delete-by-moving-to-trash'
+ ;; prevents trashing remote files.
+ (let ((trash-directory (tramp--test-make-temp-name 'local quoted))
+ (delete-by-moving-to-trash t)
+ (remote-file-name-inhibit-delete-by-moving-to-trash t))
+ (make-directory trash-directory)
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (delete-directory tmp-name1 nil 'trash)
+ (should-not (file-exists-p tmp-name1))
+ (should-not
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory tmp-name1)
trash-directory)))
+ (delete-directory trash-directory 'recursive)
+ (should-not (file-exists-p trash-directory))))))
(ert-deftest tramp-test15-copy-directory ()
"Check `copy-directory'."
@@ -3477,6 +3516,9 @@ This tests also `access-file', `file-readable-p',
(access-file tmp-name1 "error")
:type 'file-missing)
+ (should-not (file-exists-p tmp-name1))
+ (should-not (file-readable-p tmp-name1))
+ (should-not (file-regular-p tmp-name1))
;; `file-ownership-preserved-p' should return t for
;; non-existing files.
(when test-file-ownership-preserved-p
@@ -3561,7 +3603,7 @@ This tests also `access-file', `file-readable-p',
(should (file-exists-p tmp-name1))
(should (file-readable-p tmp-name1))
(should-not (file-regular-p tmp-name1))
- (should-not (access-file tmp-name1 ""))
+ (should-not (access-file tmp-name1 "error"))
(when test-file-ownership-preserved-p
(should (file-ownership-preserved-p tmp-name1 'group)))
(setq attr (file-attributes tmp-name1))
@@ -3900,7 +3942,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
+ (should (file-regular-p tmp-name1))
(make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-exists-p tmp-name2))
+ (should (file-regular-p tmp-name2))
(should
(string-equal
(funcall
@@ -3951,6 +3996,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(string-equal tmp-name1 (file-symlink-p tmp-name3))))
;; Check directory as newname.
(make-directory tmp-name4)
+ (should (file-directory-p tmp-name4))
+ (should-not (file-regular-p tmp-name4))
(when (tramp--test-expensive-test-p)
(should-error
(make-symbolic-link tmp-name1 tmp-name4)
@@ -3964,6 +4011,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(file-symlink-p tmp-name5)))
;; Check, that files in symlinked directories still work.
(make-symbolic-link tmp-name4 tmp-name6)
+ (should (file-symlink-p tmp-name6))
+ (should-not (file-regular-p tmp-name6))
(write-region "foo" nil (expand-file-name "foo" tmp-name6))
(delete-file (expand-file-name "foo" tmp-name6))
(should-not (file-exists-p (expand-file-name "foo" tmp-name4)))
@@ -4025,9 +4074,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
+ (should (file-regular-p tmp-name1))
(should (string-equal tmp-name1 (file-truename tmp-name1)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name2))
+ (should (file-regular-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
@@ -4037,6 +4088,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(let ((default-directory ert-remote-temporary-file-directory))
(make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
(should (file-symlink-p tmp-name2))
+ (should (file-regular-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
@@ -4051,6 +4103,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(funcall (if quoted #'file-name-unquote #'identity) penguin)
tmp-name2)
(should (file-symlink-p tmp-name2))
+ (should-not (file-regular-p tmp-name2))
(should
(string-equal
(file-truename tmp-name2)
@@ -4060,6 +4113,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(unless (tramp--test-windows-nt-p)
(make-symbolic-link tmp-name1 tmp-name3)
(should (file-symlink-p tmp-name3))
+ (should-not (file-regular-p tmp-name3))
(should-not (string-equal tmp-name3 (file-truename tmp-name3)))
;; `file-truename' returns a quoted file name for `tmp-name3'.
;; We must unquote it.
@@ -4088,6 +4142,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(make-symbolic-link
tmp-name3
(setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
+ (should-not (file-regular-p tmp-name2))
+ (should-not (file-regular-p tmp-name3))
(should
(string-equal
(file-truename tmp-name2)
@@ -4118,6 +4174,12 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(tramp--test-ignore-make-symbolic-link-error
(make-symbolic-link tmp-name2 tmp-name1)
(should (file-symlink-p tmp-name1))
+ (should-not (file-regular-p tmp-name1))
+ (should-not (file-regular-p tmp-name2))
+ (should
+ (string-equal
+ (file-truename tmp-name1)
+ (file-truename tmp-name2)))
(if (tramp--test-smb-p)
;; The symlink command of "smbclient" detects the
;; cycle already.
@@ -4125,9 +4187,15 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(make-symbolic-link tmp-name1 tmp-name2)
:type 'file-error)
(make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
+ (should-not (file-regular-p tmp-name1))
+ (should-not (file-regular-p tmp-name2))
(should-error
(file-truename tmp-name1)
+ :type 'file-error)
+ (should-error
+ (file-truename tmp-name2)
:type 'file-error))))
;; Cleanup.
@@ -4480,17 +4548,17 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(and (string-match-p tramp-ipv6-regexp host)
tramp-postfix-ipv6-format)))
;; Complete method name.
- (unless (or (zerop (length method))
- (zerop (length tramp-method-regexp)))
+ (unless (or (tramp-string-empty-or-nil-p method)
+ (string-empty-p tramp-method-regexp))
(should
(member
(concat prefix-format method tramp-postfix-method-format)
(file-name-all-completions
(concat prefix-format (substring method 0 1)) "/"))))
;; Complete host name.
- (unless (or (zerop (length method))
- (zerop (length tramp-method-regexp))
- (zerop (length host))
+ (unless (or (tramp-string-empty-or-nil-p method)
+ (string-empty-p tramp-method-regexp)
+ (tramp-string-empty-or-nil-p host)
(tramp--test-gvfs-p method))
(should
(member
@@ -4816,8 +4884,8 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc)))
- ;; Disabled process filter. "sshfs" does not cooperate.
- (unless (tramp--test-sshfs-p)
+ ;; Disabled process filter. It doesn't work reliable.
+ (unless t
(unwind-protect
(with-temp-buffer
(setq command '("cat")
@@ -4864,13 +4932,10 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
- (if (and (memq process-connection-type '(nil pipe))
- (not (tramp--test-macos-p)))
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
- (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
+ ;; On macOS, there is always newline conversion.
+ ;; "telnet" converts \r to <CR><NUL> if `crlf'
+ ;; flag is FALSE. See telnet(1) man page.
+ (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n") "0A\n")
(buffer-string))))
;; Cleanup.
@@ -5010,8 +5075,8 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
;; Cleanup.
(ignore-errors (delete-process proc)))
- ;; Disabled process filter. "sshfs" does not cooperate.
- (unless (tramp--test-sshfs-p)
+ ;; Disabled process filter. It doesn't work reliable.
+ (unless t
(unwind-protect
(with-temp-buffer
(setq command '("cat")
@@ -5154,14 +5219,10 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(while (accept-process-output proc 0 nil t))))
(should
(string-match-p
- (if (and (memq (or connection-type process-connection-type)
- '(nil pipe))
- (not (tramp--test-macos-p)))
- ;; On macOS, there is always newline conversion.
- ;; "telnet" converts \r to <CR><NUL> if `crlf'
- ;; flag is FALSE. See telnet(1) man page.
- (rx "66\n6F\n6F\n0D" (? "\n00") "\n0A\n")
- (rx "66\n6F\n6F\n0A" (? "\n00") "\n0A\n"))
+ ;; On macOS, there is always newline conversion.
+ ;; "telnet" converts \r to <CR><NUL> if `crlf'
+ ;; flag is FALSE. See telnet(1) man page.
+ (rx "66\n" "6F\n" "6F\n" (| "0D\n" "0A\n") (? "00\n")
"0A\n")
(buffer-string))))
;; Cleanup.
@@ -5334,7 +5395,7 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(when-let ((default-directory ert-remote-temporary-file-directory)
(mi (memory-info)))
(should (consp mi))
- (should (= (length mi) 4))
+ (should (tramp-compat-length= mi 4))
(dotimes (i (length mi))
(should (natnump (nth i mi))))))
@@ -5433,7 +5494,7 @@ INPUT, if non-nil, is a string sent to the process."
(format "%s\n" (file-name-nondirectory tmp-name)))
(should
(string-match-p
- ;; Some shells echo, for example the "adb" or "docker" methods.
+ ;; Some shells echo, for example the "adb" or container methods.
(rx
bos (** 1 2 (literal (file-name-nondirectory tmp-name)) "\n")
eos)
@@ -5879,7 +5940,8 @@ INPUT, if non-nil, is a string sent to the process."
;; We make a super long `tramp-remote-path'.
(make-directory tmp-name)
(should (file-directory-p tmp-name))
- (while (< (length (mapconcat #'identity orig-exec-path ":")) 5000)
+ (while (tramp-compat-length<
+ (mapconcat #'identity orig-exec-path ":") 5000)
(let ((dir (make-temp-file (file-name-as-directory tmp-name)
'dir)))
(should (file-directory-p dir))
(setq tramp-remote-path
@@ -5895,9 +5957,10 @@ INPUT, if non-nil, is a string sent to the process."
;; Ignore trailing newline.
(setq path (substring (shell-command-to-string "echo $PATH") nil -1))
;; The shell doesn't handle such long strings.
- (when (<= (length path)
- (tramp-get-connection-property
- tramp-test-vec "pipe-buf" 4096))
+ (unless (tramp-compat-length>
+ path
+ (tramp-get-connection-property
+ tramp-test-vec "pipe-buf" 4096))
;; The last element of `exec-path' is `exec-directory'.
(should
(string-equal
@@ -6259,7 +6322,7 @@ INPUT, if non-nil, is a string sent to the process."
(skip-unless (and (fboundp 'file-locked-p) (fboundp 'make-lock-file-name)))
;; `lock-file', `unlock-file', `file-locked-p' and
- ;; `make-lock-file-name' exists since Emacs 28.1. We don't want to
+ ;; `make-lock-file-name' exist since Emacs 28.1. We don't want to
;; see compiler warnings for older Emacsen.
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -6531,11 +6594,12 @@ This is used in tests which we don't want to tag
"Check, whether the remote directory is encrypted."
(tramp-crypt-file-name-p ert-remote-temporary-file-directory))
-(defun tramp--test-docker-p ()
- "Check, whether the docker method is used.
+(defun tramp--test-container-p ()
+ "Check, whether a container method is used.
This does not support some special file names."
- (string-equal
- "docker" (file-remote-p ert-remote-temporary-file-directory 'method)))
+ (string-match-p
+ (rx bol (| "docker" "podman") eol)
+ (file-remote-p ert-remote-temporary-file-directory 'method)))
(defun tramp--test-expensive-test-p ()
"Whether expensive tests are run.
@@ -6909,7 +6973,7 @@ This requires restrictions of file name syntax."
(let ((files
(list
(cond ((or (tramp--test-ange-ftp-p)
- (tramp--test-docker-p)
+ (tramp--test-container-p)
(tramp--test-gvfs-p)
(tramp--test-rclone-p)
(tramp--test-sudoedit-p)
@@ -6967,7 +7031,7 @@ This requires restrictions of file name syntax."
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; SLOW ~ 620s
- (skip-unless (not (tramp--test-docker-p)))
+ (skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-rsync-p)))
(skip-unless (not (tramp--test-windows-nt-and-out-of-band-p)))
(skip-unless (not (tramp--test-ksh-p)))
@@ -7004,6 +7068,9 @@ This requires restrictions of file name syntax."
;; Use all available language specific snippets.
(lambda (x)
(and
+ ;; The "Oriya" and "Odia" languages use some problematic
+ ;; composition characters.
+ (not (member (car x) '("Oriya" "Odia")))
(stringp (setq x (eval (get-language-info (car x) 'sample-text)
t)))
;; Filter out strings which use unencodable characters.
(not (and (or (tramp--test-gvfs-p) (tramp--test-smb-p))
@@ -7033,15 +7100,44 @@ This requires restrictions of file name syntax."
(when-let ((fsi (file-system-info ert-remote-temporary-file-directory)))
(should (consp fsi))
- (should (= (length fsi) 3))
+ (should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
(should (natnump (or (nth i fsi) 0))))))
-;; `tramp-test44-asynchronous-requests' could be blocked. So we set a
+;; `file-user-uid' was introduced in Emacs 30.1.
+(ert-deftest tramp-test44-file-user-uid ()
+ "Check that `file-user-uid' and `tramp-get-remote-*' return proper values."
+ (skip-unless (tramp--test-enabled))
+
+ (let ((default-directory ert-remote-temporary-file-directory))
+ ;; `file-user-uid' exists since Emacs 30.1. We don't want to see
+ ;; compiler warnings for older Emacsen.
+ (when (fboundp 'file-user-uid)
+ (should (integerp (with-no-warnings (file-user-uid)))))
+
+ (with-parsed-tramp-file-name default-directory nil
+ (should (or (integerp (tramp-get-remote-uid v 'integer))
+ (null (tramp-get-remote-uid v 'integer))))
+ (should (or (stringp (tramp-get-remote-uid v 'string))
+ (null (tramp-get-remote-uid v 'string))))
+
+ (should (or (integerp (tramp-get-remote-gid v 'integer))
+ (null (tramp-get-remote-gid v 'integer))))
+ (should (or (stringp (tramp-get-remote-gid v 'string))
+ (null (tramp-get-remote-gid v 'string))))
+
+ (when-let ((groups (tramp-get-remote-groups v 'integer)))
+ (should (consp groups))
+ (dolist (group groups) (should (integerp group))))
+ (when-let ((groups (tramp-get-remote-groups v 'string)))
+ (should (consp groups))
+ (dolist (group groups) (should (stringp group)))))))
+
+;; `tramp-test45-asynchronous-requests' could be blocked. So we set a
;; timeout of 300 seconds, and we send a SIGUSR1 signal after 300
;; seconds. Similar check is performed in the timer function.
(defconst tramp--test-asynchronous-requests-timeout 300
- "Timeout for `tramp-test44-asynchronous-requests'.")
+ "Timeout for `tramp-test45-asynchronous-requests'.")
(defmacro tramp--test-with-proper-process-name-and-buffer (proc &rest body)
"Set \"process-name\" and \"process-buffer\" connection properties.
@@ -7077,7 +7173,7 @@ This is needed in timer functions as well as process
filters and sentinels."
(tramp-flush-connection-property v "process-buffer")))))
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test44-asynchronous-requests ()
+(ert-deftest tramp-test45-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@@ -7087,7 +7183,7 @@ process sentinels. They shall not disturb each other."
'(:unstable)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-supports-processes-p))
- (skip-unless (not (tramp--test-docker-p)))
+ (skip-unless (not (tramp--test-container-p)))
(skip-unless (not (tramp--test-telnet-p)))
(skip-unless (not (tramp--test-sshfs-p)))
(skip-unless (not (tramp--test-windows-nt-p)))
@@ -7244,7 +7340,7 @@ process sentinels. They shall not disturb each other."
(unless (process-live-p proc)
(setq buffers (delq buf buffers))))))
- ;; Checks. All process output shall exists in the
+ ;; Checks. All process output shall exist in the
;; respective buffers. All created files shall be
;; deleted.
(tramp--test-message "Check %s" (current-time-string))
@@ -7270,10 +7366,10 @@ process sentinels. They shall not disturb each other."
(ignore-errors (cancel-timer timer))
(ignore-errors (delete-directory tmp-name 'recursive))))))
-;; (tramp--test-deftest-direct-async-process tramp-test44-asynchronous-requests
+;; (tramp--test-deftest-direct-async-process tramp-test45-asynchronous-requests
;; 'unstable)
-(ert-deftest tramp-test45-dired-compress-file ()
+(ert-deftest tramp-test46-dired-compress-file ()
"Check that Tramp (un)compresses normal files."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -7294,7 +7390,7 @@ process sentinels. They shall not disturb each other."
(should (string= tmp-name (dired-get-filename)))
(delete-file tmp-name)))
-(ert-deftest tramp-test45-dired-compress-dir ()
+(ert-deftest tramp-test46-dired-compress-dir ()
"Check that Tramp (un)compresses directories."
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
@@ -7316,7 +7412,7 @@ process sentinels. They shall not disturb each other."
(delete-directory tmp-name)
(delete-file (concat tmp-name ".tar.gz"))))
-(ert-deftest tramp-test46-read-password ()
+(ert-deftest tramp-test47-read-password ()
"Check Tramp password handling."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -7376,7 +7472,7 @@ process sentinels. They shall not disturb each other."
(should (file-exists-p ert-remote-temporary-file-directory)))))))))
;; This test is inspired by Bug#29163.
-(ert-deftest tramp-test47-auto-load ()
+(ert-deftest tramp-test48-auto-load ()
"Check that Tramp autoloads properly."
;; If we use another syntax but `default', Tramp is already loaded
;; due to the `tramp-change-syntax' call.
@@ -7401,7 +7497,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test47-delay-load ()
+(ert-deftest tramp-test48-delay-load ()
"Check that Tramp is loaded lazily, only when needed."
;; Tramp is neither loaded at Emacs startup, nor when completing a
;; non-Tramp file name like "/foo". Completing a Tramp-alike file
@@ -7431,7 +7527,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument (format code tm)))))))))
-(ert-deftest tramp-test47-recursive-load ()
+(ert-deftest tramp-test48-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
@@ -7455,7 +7551,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code))))))))
-(ert-deftest tramp-test47-remote-load-path ()
+(ert-deftest tramp-test48-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
@@ -7480,7 +7576,7 @@ process sentinels. They shall not disturb each other."
(mapconcat #'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test48-unload ()
+(ert-deftest tramp-test49-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
:tags '(:expensive-test)
@@ -7518,6 +7614,8 @@ Since it unloads Tramp, it shall be the last test to run."
;; `tramp-register-archive-file-name-handler' is autoloaded
;; in Emacs < 29.1.
(not (eq 'tramp-register-archive-file-name-handler x))
+ ;; `tramp-compat-rx' is autoloaded in Emacs 29.1.
+ (not (eq 'tramp-compat-rx x))
(not (string-match-p
(rx bol "tramp" (? "-archive") (** 1 2 "-") "test")
(symbol-name x)))
@@ -7577,19 +7675,21 @@ If INTERACTIVE is non-nil, the tests are run
interactively."
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
-;; * tramp-get-remote-gid
-;; * tramp-get-remote-groups
-;; * tramp-get-remote-uid
+;; * memory-info
+;; * tramp-get-home-directory
;; * tramp-set-file-uid-gid
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Revisit expensive tests, once problems in `tramp-error' are solved.
;; * Fix `tramp-test06-directory-file-name' for "ftp".
+;; * Check, why a process filter t doesn't work in
+;; `tramp-test29-start-file-process' and
+;; `tramp-test30-make-process'.
;; * Implement `tramp-test31-interrupt-process' and
;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct
;; async processes. Check, why they don't run stable.
;; * Check, why direct async processes do not work for
-;; `tramp-test44-asynchronous-requests'.
+;; `tramp-test45-asynchronous-requests'.
(provide 'tramp-tests)
diff --git a/test/lisp/proced-tests.el b/test/lisp/proced-tests.el
index 3c1f5493e74..1f475665298 100644
--- a/test/lisp/proced-tests.el
+++ b/test/lisp/proced-tests.el
@@ -101,5 +101,22 @@
(should (string= pid (word-at-point)))
(forward-line)))))
+(ert-deftest proced-update-preserves-pid-at-point-test ()
+ (proced--within-buffer
+ 'medium
+ 'user
+ (goto-char (point-min))
+ (search-forward (number-to-string (emacs-pid)))
+ (proced--move-to-column "PID")
+ (save-window-excursion
+ (let ((pid (proced-pid-at-point))
+ (new-window (split-window))
+ (old-window (get-buffer-window)))
+ (select-window new-window)
+ (with-current-buffer "*Proced*"
+ (proced-update t t))
+ (select-window old-window)
+ (should (= pid (proced-pid-at-point)))))))
+
(provide 'proced-tests)
;;; proced-tests.el ends here
diff --git a/test/lisp/progmodes/c-ts-mode-resources/filling.erts
b/test/lisp/progmodes/c-ts-mode-resources/filling.erts
new file mode 100644
index 00000000000..e51e3658c83
--- /dev/null
+++ b/test/lisp/progmodes/c-ts-mode-resources/filling.erts
@@ -0,0 +1,198 @@
+Code:
+ (lambda ()
+ (c-ts-mode)
+ (setq-local indent-tabs-mode nil)
+ (fill-paragraph))
+
+Point-Char: |
+
+Name: Type 1
+
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=-=
+
+Name: Type 2
+
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=-=
+
+Name: Type 3
+
+=-=
+/*================================================================
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ ================================================================*/
+=-=
+/*================================================================
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ ================================================================*/
+=-=-=
+
+Name: Type 4
+
+=-=
+/*================================================================
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy
+ * ================================================================*/
+=-=
+/*================================================================
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy
+ * ================================================================*/
+=-=-=
+
+Name: Type 5
+
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ * woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=-=
+
+Name: Type 6
+
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=-=
+
+Name: Type 6
+
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ */
+=-=-=
+
+Name: Type 7
+
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=-=
+
+Name: Type 8
+
+=-=
+// ================================================================
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// ================================================================
+=-=
+// ================================================================
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// ================================================================
+=-=-=
+
+Name: Type 9
+
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomyyy */
+=-=
+/* woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ woooomyyy */
+=-=-=
+
+Name: Not Over Fill 1
+
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+
+// |woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=-=
+
+Name: Not Over Fill 2
+
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+//| woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=-=
+
+Name: Not Over Fill 3
+
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; //| woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=
+// woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ // woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ // woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+ // woooomy woooomy
+return; // woooomy woooomy woooomy woooomy woooomy woooomy woooomy woooomy
+=-=-=
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
new file mode 100644
index 00000000000..07698077ffc
--- /dev/null
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent-bsd.erts
@@ -0,0 +1,93 @@
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq c-ts-mode-indent-offset 2)
+ (setq c-ts-mode-indent-style 'bsd)
+ (c-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Basic
+
+=-=
+int
+main (void)
+{
+ return 0;
+}
+=-=-=
+
+Name: Hanging Braces
+
+=-=
+int
+main (void)
+{
+ if (true)
+ {
+ |
+ }
+}
+=-=-=
+
+Name: Labels
+
+=-=
+int
+main (void)
+{
+ label:
+ return 0;
+ if (true)
+ {
+ label:
+ return 0;
+ }
+ else
+ {
+ if (true)
+ {
+ label:
+ return 0;
+ }
+ }
+}
+=-=-=
+
+Name: If-Else
+
+=-=
+int main()
+{
+ if (true)
+ {
+ return 0;
+ }
+ else
+ {
+ return 1;
+ }
+}
+=-=-=
+
+Name: Empty Line
+=-=
+int main()
+{
+ |
+}
+=-=-=
+
+Name: Consecutive blocks (bug#60873)
+
+=-=
+int
+main (int argc,
+ char *argv[])
+{
+ {
+ int i = 0;
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
new file mode 100644
index 00000000000..67654404a77
--- /dev/null
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
@@ -0,0 +1,242 @@
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq c-ts-mode-indent-offset 2)
+ (setq c-ts-mode-indent-style 'gnu)
+ (c-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Basic
+
+=-=
+int
+main (void)
+{
+ return 0;
+}
+=-=-=
+
+Name: Hanging Braces (GNU Style)
+
+=-=
+int
+main (void)
+{
+ if (true)
+ {
+ }
+}
+=-=-=
+
+Name: Labels (GNU Style)
+
+=-=
+int
+main (void)
+{
+ label:
+ return 0;
+ if (true)
+ {
+ label:
+ return 0;
+ }
+ else
+ {
+ if (true)
+ {
+ label:
+ return 0;
+ }
+ }
+}
+=-=-=
+
+Name: For Loop with Multi-line Condition (GNU Style)
+
+=-=
+int main()
+{
+ for (int i = 0;
+ i < b;
+ i++)
+ {
+ return 0;
+ }
+}
+=-=-=
+
+Name: If-Else (GNU Style)
+
+=-=
+int main()
+{
+ if (true)
+ {
+ return 0;
+ }
+ else
+ {
+ return 1;
+ }
+}
+=-=-=
+
+Name: Empty Line
+=-=
+int main()
+{
+ |
+}
+=-=-=
+
+Name: Concecutive blocks (GNU Style) (bug#60873)
+
+=-=
+int
+main (int argc,
+ char *argv[])
+{
+ {
+ int i = 0;
+ }
+}
+=-=-=
+
+Name: Bracket-less Block-Statement (GNU Style) (bug#61026)
+
+=-=
+int main() {
+ while (true)
+ if (true)
+ {
+ puts ("Hello");
+ }
+ for (int i=0; i<5; i++)
+ if (true)
+ {
+ puts ("Hello");
+ }
+ do
+ if (true)
+ {
+ puts ("Hello");
+ }
+ while (true);
+ if (true)
+ if (true)
+ {
+ puts ("Hello");
+ }
+}
+=-=-=
+
+Name: Bracket-less Block-Statement (Linux Style) (bug#61026)
+
+=-=-=
+int main() {
+ while (true)
+ if (true) {
+ puts ("Hello");
+ }
+ for (int i=0; i<5; i++)
+ if (true) {
+ puts ("Hello");
+ }
+ do
+ if (true) {
+ puts ("Hello");
+ }
+ while (true);
+ if (true)
+ if (true) {
+ puts ("Hello");
+ }
+}
+=-=-=
+
+Name: Multiline Parameter List (bug#60398)
+
+=-=
+int f2(int x,
+ int y) {
+ return x + y;
+};
+=-=-=
+
+Name: Multiline Block Comments 1 (bug#60270)
+
+=-=
+/**
+ * @some_func:
+ * @arg1:
+ */
+=-=-=
+
+Name: Multiline Block Comments 2 (bug#60270)
+
+=-=
+/*
+ some comment
+ */
+=-=-=
+
+Name: Multiline Block Comments 3 (bug#60270)
+
+=-=
+/* some comment
+ */
+=-=-=
+
+Name: Multiline Block Comments 4 (bug#60270)
+
+=-=
+/*
+ * Some comment
+ */
+=-=-=
+
+Name: Multiline Block Comments 5 (bug#60270)
+
+=-=
+/*
+line one
+line 2
+ */
+=-=
+/*
+ line one
+ line 2
+ */
+=-=-=
+
+
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq c-ts-mode-indent-offset 8)
+ (setq c-ts-mode-indent-style 'linux)
+ (c-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Name: Labels (Linux Style)
+
+=-=-=
+int main (void)
+{
+label:
+ return 0;
+ if (true) {
+label:
+ return 0;
+ }
+ else {
+ if (true) {
+label:
+ return 0;
+ }
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/c-ts-mode-tests.el
b/test/lisp/progmodes/c-ts-mode-tests.el
new file mode 100644
index 00000000000..ddf64b40736
--- /dev/null
+++ b/test/lisp/progmodes/c-ts-mode-tests.el
@@ -0,0 +1,39 @@
+;;; c-ts-mode-tests.el --- Tests for Tree-sitter-based C mode -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'treesit)
+
+(ert-deftest c-ts-mode-test-indentation ()
+ (skip-unless (treesit-ready-p 'c))
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(ert-deftest c-ts-mode-test-indentation-bsd ()
+ (skip-unless (treesit-ready-p 'c))
+ (ert-test-erts-file (ert-resource-file "indent-bsd.erts")))
+
+(ert-deftest c-ts-mode-test-filling ()
+ (skip-unless (treesit-ready-p 'c))
+ (ert-test-erts-file (ert-resource-file "filling.erts")))
+
+(provide 'c-ts-mode-tests)
+;;; c-ts-mode-tests.el ends here
diff --git a/test/lisp/progmodes/java-ts-mode-resources/indent.erts
b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
new file mode 100644
index 00000000000..e59d5fed8e8
--- /dev/null
+++ b/test/lisp/progmodes/java-ts-mode-resources/indent.erts
@@ -0,0 +1,44 @@
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq java-ts-mode-indent-offset 2)
+ (java-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Basic
+
+=-=
+public class Basic {
+ public void basic() {
+ return;
+ }
+}
+=-=-=
+
+Name: Empty Line
+
+=-=
+public class EmptyLine {
+ public void emptyLine() {
+ |
+ }
+}
+=-=-=
+
+Name: Statements
+
+=-=
+if (x) {
+ for (var foo : foos) {
+ |
+ }
+} else if (y) {
+ for (int i = 0; x < foos.size(); i++) {
+ return;
+ }
+} else {
+ return;
+}
+=-=-=
diff --git a/test/lisp/progmodes/java-ts-mode-resources/movement.erts
b/test/lisp/progmodes/java-ts-mode-resources/movement.erts
new file mode 100644
index 00000000000..23639b1f5ff
--- /dev/null
+++ b/test/lisp/progmodes/java-ts-mode-resources/movement.erts
@@ -0,0 +1,154 @@
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (forward-sentence 1))
+
+Point-Char: |
+
+Name: forward-sentence moves over if
+
+=-=
+public class Basic {
+ public void basic() {
+ |if (x) {
+
+ }
+ log.info("some text: {}", text);
+ return;
+ }
+}
+=-=
+public class Basic {
+ public void basic() {
+ if (x) {
+
+ }|
+ log.info("some text: {}", text);
+ return;
+ }
+}
+=-=-=
+
+Name: forward-sentence moves over method invocation
+
+=-=
+public class Basic {
+ public void basic() {
+ |log.info("some text: {}", text);
+ }
+}
+=-=
+public class Basic {
+ public void basic() {
+ log.info("some text: {}", text);|
+ }
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (forward-sentence 2))
+
+Name: forward-sentence moves over multiple statements
+
+=-=
+public class Basic {
+ public void basic() {
+ |return;
+ return;
+ }
+}
+=-=
+public class Basic {
+ public void basic() {
+ return;
+ return;|
+ }
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (backward-sentence 1))
+
+Name: backward-sentence moves over one statement
+
+=-=
+public class Basic {
+ public void basic() {
+ return;|
+ }
+}
+=-=
+public class Basic {
+ public void basic() {
+ |return;
+ }
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (beginning-of-defun))
+
+Name: beginning-of-defun moves to defun start
+
+=-=
+public class Basic {
+ public void basic() {
+ return;|
+ }
+}
+=-=
+public class Basic {
+| public void basic() {
+ return;
+ }
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (beginning-of-defun)
+ (beginning-of-defun))
+
+Name: beginning-of-defun moves to class
+
+=-=
+public class Basic {
+ public void basic() {
+ return;|
+ }
+}
+=-=
+|public class Basic {
+ public void basic() {
+ return;
+ }
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (java-ts-mode)
+ (end-of-defun))
+
+Name: end-of-defun moves to defun end
+
+=-=
+public class Basic {
+ public void basic() {
+ return;|
+ }
+}
+=-=
+public class Basic {
+ public void basic() {
+ return;
+ }
+|}
+=-=-=
diff --git a/test/lisp/progmodes/java-ts-mode-tests.el
b/test/lisp/progmodes/java-ts-mode-tests.el
new file mode 100644
index 00000000000..4fd8fc3019f
--- /dev/null
+++ b/test/lisp/progmodes/java-ts-mode-tests.el
@@ -0,0 +1,35 @@
+;;; java-ts-mode-tests.el --- Tests for Tree-sitter-based Java mode -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'treesit)
+
+(ert-deftest java-ts-mode-test-indentation ()
+ (skip-unless (treesit-ready-p 'java))
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(ert-deftest java-ts-mode-test-movement ()
+ (skip-unless (treesit-ready-p 'java))
+ (ert-test-erts-file (ert-resource-file "movement.erts")))
+
+(provide 'java-ts-mode-tests)
+;;; java-ts-mode-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index eac558db10f..df71990278e 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -4520,6 +4520,16 @@ def foo():
(python-tests-look-at "\"\"\""))
"# -*- coding: utf-8 -*-\n\nif True:\n a = 1\n b =
2\n\n"))))
+(ert-deftest python-shell-buffer-substring-18 ()
+ "Check substring from the part of the first line."
+ (python-tests-with-temp-buffer
+ "s = 'test'
+"
+ (should (string= (python-shell-buffer-substring
+ (python-tests-look-at "'test'")
+ (pos-eol))
+ "'test'"))))
+
;;; Shell completion
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
index 1a8285ee919..624a6caafe5 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-method-call-indent.rb
@@ -1,3 +1,8 @@
+foo = subject
+ .update(
+ 1
+ )
+
foo2 =
subject.
update(
@@ -10,6 +15,10 @@ foo3 =
2
)
+my_array.select { |str| str.size > 5 }
+ .map { |str| str.downcase }
+
# Local Variables:
# ruby-method-call-indent: nil
+# ruby-align-chained-calls: nil
# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb
new file mode 100644
index 00000000000..4be532a5e9d
--- /dev/null
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby-ts.rb
@@ -0,0 +1,94 @@
+variable = foo(
+ [
+ qwe
+ ], [
+ rty
+ ], {
+ a: 3
+ }
+)
+
+tee = [
+ qwe
+]
+
+qux = [1,
+ 2]
+
+att = {a: 1,
+ b: 2}
+
+a = 1 ? 2 :(
+ 2 + 3
+)
+
+unless bismark
+ sink += 12
+else
+ dog = 99
+end
+
+foo1 =
+ subject.update(
+ 1
+ )
+
+foo2 =
+ subject.
+ update(
+ # Might make sense to indent this to 'subject' instead; but this
+ # style seems more popular.
+ 2
+ )
+
+foo > bar &&
+ tee < qux
+
+1 .. 2 &&
+ 3
+
+a = foo(j, k) -
+ bar_tee
+
+qux = foo.fee ?
+ bar :
+ tee
+
+with_paren = (a + b *
+ c * d +
+ 12)
+
+without_paren = a + b *
+ c * d +
+ 12
+
+{'a' => {
+ 'b' => 'c',
+ 'd' => %w(e f)
+ }
+}
+
+[1, 2, {
+ 'b' => 'c',
+ 'd' => %w(e f)
+ }
+]
+
+foo(a, {
+ a: b,
+ c: d
+ })
+
+foo(foo, bar:
+ tee)
+
+foo(foo, :bar =>
+ tee)
+
+# Local Variables:
+# mode: ruby-ts
+# ruby-after-operator-indent: t
+# ruby-block-indent: t
+# ruby-method-call-indent: t
+# ruby-method-params-indent: t
+# End:
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index bfae948b259..3f0dfdf68ba 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -513,7 +513,7 @@ foo bar, {
case translation
in ['th', orig_text, 'en', trans_text]
puts "English translation: #{orig_text} => #{trans_text}"
-in {'th' => orig_text, 'ja' => trans_text}
+in {th: orig_text, ja: trans_text} => whole
puts "Japanese translation: #{orig_text} => #{trans_text}"
end
diff --git a/test/lisp/progmodes/ruby-ts-mode-tests.el
b/test/lisp/progmodes/ruby-ts-mode-tests.el
index b2c990f8e56..18e3e60a04a 100644
--- a/test/lisp/progmodes/ruby-ts-mode-tests.el
+++ b/test/lisp/progmodes/ruby-ts-mode-tests.el
@@ -110,6 +110,18 @@ The whitespace before and including \"|\" on each line is
removed."
| 42
| end")))
+
+(ert-deftest ruby-ts-indent-call-no-args ()
+ (skip-unless (treesit-ready-p 'ruby t))
+ (ruby-ts-with-temp-buffer
+ "variable = foo(
+
+)"
+ (goto-char (point-min))
+ (forward-line 1)
+ (funcall indent-line-function)
+ (should (= (current-indentation) ruby-indent-level))))
+
(ert-deftest ruby-ts-add-log-current-method-examples ()
(skip-unless (treesit-ready-p 'ruby t))
(let ((pairs '(("foo" . "#foo")
@@ -250,7 +262,12 @@ The whitespace before and including \"|\" on each line is
removed."
(should (equal (buffer-string) orig))))
(kill-buffer buf)))))
+(ruby-ts-deftest-indent "ruby-ts.rb")
+(ruby-ts-deftest-indent "ruby-after-operator-indent.rb")
+(ruby-ts-deftest-indent "ruby-block-indent.rb")
+(ruby-ts-deftest-indent "ruby-method-call-indent.rb")
(ruby-ts-deftest-indent "ruby-method-params-indent.rb")
+(ruby-ts-deftest-indent "ruby-parenless-call-arguments-indent.rb")
(provide 'ruby-ts-mode-tests)
diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
new file mode 100644
index 00000000000..146ee76574e
--- /dev/null
+++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
@@ -0,0 +1,73 @@
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq typescript-ts-mode-indent-offset 2)
+ (typescript-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Basic indentation
+
+=-=
+const foo = () => {
+ console.log("bar");
+ if (x) {
+ return y;
+ } else if (y) {
+ return u;
+ }
+ return baz.x()
+ ? true
+ : false;
+}
+=-=-=
+
+Code:
+ (lambda ()
+ (setq indent-tabs-mode nil)
+ (setq tsx-ts-mode-indent-offset 2)
+ (tsx-ts-mode)
+ (indent-region (point-min) (point-max)))
+
+Name: JSX indentation
+
+=-=
+const foo = (props) => {
+ return (
+ <div>
+ <div>
+ <div>
+ <div>
+ {
+ props.foo
+ ? Hello, foo!
+ : Hello, World!;
+ }
+ </div>
+ </div>
+ </div>
+ </div>
+ );
+}
+=-=-=
+
+Name: JSX indentation with attributes
+
+=-=
+const foo = (props) => {
+ return (
+ <div
+ className={foo}
+ onClick={() => {
+ alert('???');
+ return () => {
+ return 5+5;
+ };
+ }}
+ >
+ <p>Some text</p>
+ </div>
+ );
+}
+=-=-=
diff --git a/test/lisp/progmodes/typescript-ts-mode-tests.el
b/test/lisp/progmodes/typescript-ts-mode-tests.el
new file mode 100644
index 00000000000..126f5e3298f
--- /dev/null
+++ b/test/lisp/progmodes/typescript-ts-mode-tests.el
@@ -0,0 +1,31 @@
+;;; typescript-ts-mode-tests.el --- Tests for Tree-sitter-based TypeScript
mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'treesit)
+
+(ert-deftest typescript-ts-mode-test-indentation ()
+ (skip-unless (treesit-ready-p 'typescript))
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(provide 'typescript-ts-mode-tests)
+;;; typescript-ts-mode-tests.el ends here
diff --git a/test/manual/indent/octave.m b/test/manual/indent/octave.m
index 76cad09ad1e..08b7fa58d59 100644
--- a/test/manual/indent/octave.m
+++ b/test/manual/indent/octave.m
@@ -1517,7 +1517,7 @@ function copy_files (desc, packdir, global_install)
if (exist (fullfile (desc.dir, getarch ()), "dir") &&
! strcmp (fullfile (desc.dir, getarch ()), octfiledir))
if (! exist (octfiledir, "dir"))
- ## Can be required to create upto three levels of dirs.
+ ## Can be required to create up to three levels of dirs.
octm1 = fileparts (octfiledir);
if (! exist (octm1, "dir"))
octm2 = fileparts (octm1);
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index e5de8f3464a..9d4bbf3e040 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -8315,29 +8315,35 @@ dicta sunt, explicabo. "))
(remove-hook 'buffer-list-update-hook bluh))))
(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
- "Indirect buffers do not call `get-buffer-create'."
- (dolist (inhibit '(nil t))
- (let ((base (get-buffer-create "foo" inhibit)))
+ "Test `make-indirect-buffer' argument INHIBIT-BUFFER-HOOKS."
+ (let* ( base run-bluh run-kbh run-kbqf
+ (bluh (lambda () (setq run-bluh t)))
+ (kbh (lambda () (setq run-kbh t)))
+ (kbqf (lambda () (setq run-kbqf t))))
+ (dolist (inhibit-base '(nil t))
(unwind-protect
- (dotimes (_i 11)
- (let* (flag*
- (flag (lambda () (prog1 t (setq flag* t))))
- (indirect (make-indirect-buffer base "foo[indirect]" nil
- inhibit)))
- (unwind-protect
- (progn
- (with-current-buffer indirect
- (add-hook 'kill-buffer-query-functions flag nil t))
- (kill-buffer indirect)
- (if inhibit
- (should-not flag*)
- (should flag*)))
- (let (kill-buffer-query-functions)
+ (let (indirect)
+ (setq base (generate-new-buffer " base" inhibit-base))
+ (dolist (inhibit-indirect '(nil t))
+ (dotimes (_ 11)
+ (unwind-protect
+ (let ((name (generate-new-buffer-name " indirect")))
+ (setq run-bluh nil run-kbh nil run-kbqf nil)
+ (add-hook 'buffer-list-update-hook bluh)
+ (with-current-buffer
+ (setq indirect (make-indirect-buffer
+ base name nil inhibit-indirect))
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (should (xor inhibit-indirect run-bluh))
+ (should (xor inhibit-indirect run-kbh))
+ (should (xor inhibit-indirect run-kbqf)))
+ (remove-hook 'buffer-list-update-hook bluh)
(when (buffer-live-p indirect)
(kill-buffer indirect))))))
- (let (kill-buffer-query-functions)
- (when (buffer-live-p base)
- (kill-buffer base)))))))
+ (when (buffer-live-p base)
+ (kill-buffer base))))))
(ert-deftest zero-length-overlays-and-not ()
(with-temp-buffer
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 6bd8d1ae6c4..b27907027ba 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -148,21 +148,21 @@
(defun coding-tests (content-type write-coding read-coding detected-coding
&optional translator)
- (prefer-coding-system 'utf-8-auto)
- (let ((filename (coding-tests-filename content-type write-coding)))
- (with-temp-buffer
- (let ((coding-system-for-read read-coding)
- (contents (coding-tests-file-contents content-type))
- (disable-ascii-optimization nil))
- (if translator
- (setq contents (funcall translator contents)))
- (insert-file-contents filename)
- (if (and (coding-system-equal buffer-file-coding-system detected-coding)
- (string= (buffer-string) contents))
- nil
- (list buffer-file-coding-system
- (string-to-list (buffer-string))
- (string-to-list contents)))))))
+ (with-coding-priority '(utf-8-auto)
+ (let ((filename (coding-tests-filename content-type write-coding)))
+ (with-temp-buffer
+ (let ((coding-system-for-read read-coding)
+ (contents (coding-tests-file-contents content-type))
+ (disable-ascii-optimization nil))
+ (if translator
+ (setq contents (funcall translator contents)))
+ (insert-file-contents filename)
+ (if (and (coding-system-equal buffer-file-coding-system
detected-coding)
+ (string= (buffer-string) contents))
+ nil
+ (list buffer-file-coding-system
+ (string-to-list (buffer-string))
+ (string-to-list contents))))))))
(ert-deftest ert-test-coding-ascii ()
(unwind-protect
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index b7715a280a6..aa710519825 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -226,6 +226,7 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(defun keymap-tests--command-1 () (interactive) nil)
(defun keymap-tests--command-2 () (interactive) nil)
+(defun keymap-tests--command-3 () (interactive) nil)
(put 'keymap-tests--command-1 :advertised-binding [?y])
(ert-deftest keymap-where-is-internal ()
@@ -430,6 +431,38 @@ g .. h foo
(make-non-key-event 'keymap-tests-event)
(should (equal (where-is-internal 'keymap-tests-command) '([3 103]))))
+(ert-deftest keymap-set-consistency ()
+ (let ((k (make-sparse-keymap)))
+ ;; `keymap-set' returns the binding, `keymap-set-after' doesn't,
+ ;; so we need to check for nil. <sigh>
+ (should (keymap-set k "a" "a"))
+ (should (equal (keymap-lookup k "a") (key-parse "a")))
+ (should-not (keymap-set-after k "b" "b"))
+ (should (equal (keymap-lookup k "b") (key-parse "b")))
+ (should-not (keymap-set-after k "d" "d" t))
+ (should (equal (keymap-lookup k "d") (key-parse "d")))
+ (should-not (keymap-set-after k "e" "e" nil))
+ (should (equal (keymap-lookup k "e") (key-parse "e")))
+ ;; This doesn't fail, but it does not add the 'f' binding after 'a'
+ (should-not (keymap-set-after k "f" "f" "a"))
+ (should (equal (keymap-lookup k "f") (key-parse "f")))))
+
+(ert-deftest keymap-set-after-menus ()
+ (let ((map (make-sparse-keymap)))
+ (keymap-set map "<cmd1>"
+ '(menu-item "Run Command 1" keymap-tests--command-1
+ :help "Command 1 Help"))
+ (keymap-set-after map "<cmd2>"
+ '(menu-item "Run Command 2" keymap-tests--command-2
+ :help "Command 2 Help"))
+ (keymap-set-after map "<cmd3>"
+ '(menu-item "Run Command 3" keymap-tests--command-3
+ :help "Command 3 Help")
+ 'cmd1)
+ (should (equal (caadr map) 'cmd1))
+ (should (equal (caaddr map) 'cmd3))
+ (should (equal (caar (last map)) 'cmd2))))
+
(ert-deftest keymap-test-duplicate-definitions ()
"Check that defvar-keymap rejects duplicate key definitions."
(should-error
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 84151d3b5db..fd45a9101fa 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -439,6 +439,78 @@ Demonstrates bug 16818."
(should (string= (buffer-string) "aaaFirst line\nSecond line\nbbb"))))
+(ert-deftest undo-test-combine-change-calls-1 ()
+ "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 1: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' non-nil when `combine-change-calls' is
+called."
+ (ert-with-temp-file tempfile
+ (with-current-buffer (find-file tempfile)
+ (insert "A")
+ (undo-boundary)
+ (insert "B")
+ (undo-boundary)
+ (insert "C")
+ (undo-boundary)
+ (insert " ")
+ (undo-boundary)
+ (insert "D")
+ (undo-boundary)
+ (insert "E")
+ (undo-boundary)
+ (insert "F")
+ (should (= (length buffer-undo-list) 14))
+ (goto-char (point-min))
+ (combine-change-calls (point-min) (point-max)
+ (re-search-forward "ABC ")
+ (replace-match "Z "))
+ (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-2 ()
+ "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 2: a file-visiting buffer with `buffer-undo-list' non-nil
+and `buffer-modified-p' nil when `combine-change-calls' is
+called."
+ (ert-with-temp-file tempfile
+ (with-current-buffer (find-file tempfile)
+ (insert "A")
+ (undo-boundary)
+ (insert "B")
+ (undo-boundary)
+ (insert "C")
+ (undo-boundary)
+ (insert " ")
+ (undo-boundary)
+ (insert "D")
+ (undo-boundary)
+ (insert "E")
+ (undo-boundary)
+ (insert "F")
+ (should (= (length buffer-undo-list) 14))
+ (save-buffer)
+ (goto-char (point-min))
+ (combine-change-calls (point-min) (point-max)
+ (re-search-forward "ABC ")
+ (replace-match "Z "))
+ (should (= (length buffer-undo-list) 15)))))
+
+(ert-deftest undo-test-combine-change-calls-3 ()
+ "Test how `combine-change-calls' updates `buffer-undo-list'.
+Case 3: a file-visiting buffer with `buffer-undo-list' nil and
+`buffer-modified-p' nil when `combine-change-calls' is called."
+ (ert-with-temp-file tempfile
+ (with-current-buffer (find-file tempfile)
+ (insert "ABC DEF")
+ (save-buffer)
+ (kill-buffer))
+ (with-current-buffer (find-file tempfile)
+ (should (= (length buffer-undo-list) 0))
+ (goto-char (point-min))
+ (combine-change-calls (point-min) (point-max)
+ (re-search-forward "ABC ")
+ (replace-match "Z "))
+ (should (= (length buffer-undo-list) 1)))))
+
(defun undo-test-all (&optional interactive)
"Run all tests for \\[undo]."
(interactive "p")