[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/pkg a8eb9731a11: Merge remote-tracking branch 'origin/master' in
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/pkg a8eb9731a11: Merge remote-tracking branch 'origin/master' into scratch/pkg |
|
Date: |
Sun, 3 Dec 2023 00:41:59 -0500 (EST) |
branch: scratch/pkg
commit a8eb9731a11dd06363c41c707b924add7bb98006
Merge: 29493889ecd fb4b0b30a24
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into scratch/pkg
---
admin/authors.el | 1 +
configure.ac | 3 +
doc/emacs/custom.texi | 4 +-
doc/emacs/files.texi | 4 +
doc/emacs/fixit.texi | 15 +-
doc/emacs/regs.texi | 5 +-
doc/emacs/text.texi | 12 +-
doc/lispintro/emacs-lisp-intro.texi | 31 +-
doc/lispref/modes.texi | 15 +-
doc/lispref/processes.texi | 3 +
doc/misc/dbus.texi | 3 +
doc/misc/epa.texi | 3 +
doc/misc/gnus.texi | 2 +-
doc/misc/tramp.texi | 2 +-
etc/NEWS | 29 ++
etc/PROBLEMS | 10 +
exec/config.guess | 28 +-
exec/config.sub | 49 +++-
java/org/gnu/emacs/EmacsOpenActivity.java | 3 +-
java/org/gnu/emacs/EmacsSafThread.java | 3 -
java/org/gnu/emacs/EmacsService.java | 2 +-
lisp/calc/calc-units.el | 95 +++---
lisp/completion-preview.el | 248 ++++++++++------
lisp/dired-aux.el | 114 ++++++--
lisp/dired.el | 176 ++++++++---
lisp/emacs-lisp/byte-opt.el | 4 -
lisp/emacs-lisp/bytecomp.el | 270 ++++++++++-------
lisp/emacs-lisp/cconv.el | 14 +-
lisp/emacs-lisp/cl-generic.el | 1 +
lisp/emacs-lisp/eieio-core.el | 5 +-
lisp/emacs-lisp/eieio.el | 5 +-
lisp/emacs-lisp/loaddefs-gen.el | 1 +
lisp/emacs-lisp/multisession.el | 2 -
lisp/emacs-lisp/shorthands.el | 23 +-
lisp/epg.el | 7 +-
lisp/erc/erc-fill.el | 96 ++++--
lisp/erc/erc.el | 4 +-
lisp/faces.el | 9 +-
lisp/gnus/gnus-group.el | 68 +++--
lisp/indent.el | 24 +-
lisp/info.el | 29 +-
lisp/jsonrpc.el | 6 +-
lisp/mail/sendmail.el | 1 -
lisp/man.el | 4 +-
lisp/net/dbus.el | 23 +-
lisp/net/eww.el | 4 +
lisp/net/shr.el | 165 +++++++++--
lisp/net/tramp.el | 27 +-
lisp/nxml/nxml-mode.el | 1 -
lisp/progmodes/c-ts-mode.el | 17 ++
lisp/progmodes/eglot.el | 5 +
lisp/progmodes/elixir-ts-mode.el | 323 ++++++++++++---------
lisp/progmodes/erts-mode.el | 3 +-
lisp/progmodes/lua-ts-mode.el | 152 +++++-----
lisp/progmodes/project.el | 14 +-
lisp/progmodes/ruby-ts-mode.el | 12 +-
lisp/progmodes/rust-ts-mode.el | 13 +-
lisp/progmodes/typescript-ts-mode.el | 5 +-
lisp/register.el | 298 ++++++++++++++++---
lisp/simple.el | 12 +-
lisp/sqlite.el | 4 +
lisp/textmodes/ispell.el | 23 +-
lisp/textmodes/text-mode.el | 19 +-
lisp/vc/vc.el | 12 +-
lisp/wdired.el | 7 +
lisp/window.el | 14 +-
src/pdumper.c | 75 ++---
src/print.c | 269 +++++++++--------
src/process.c | 2 +
src/regex-emacs.c | 26 +-
src/xdisp.c | 6 +-
src/xfaces.c | 15 +-
test/lisp/completion-preview-tests.el | 184 ++++++++++++
test/lisp/emacs-lisp/eieio-tests/eieio-tests.el | 21 ++
test/lisp/erc/erc-scenarios-auth-source.el | 2 +-
test/lisp/erc/erc-scenarios-base-buffer-display.el | 2 +-
test/lisp/erc/erc-scenarios-base-renick.el | 2 +-
test/lisp/erc/erc-scenarios-display-message.el | 3 +-
test/lisp/erc/erc-scenarios-misc.el | 2 +-
test/lisp/erc/erc-tests.el | 53 +++-
.../resources/base/reuse-buffers/server/barnet.eld | 6 +-
.../resources/base/reuse-buffers/server/foonet.eld | 6 +-
test/lisp/erc/resources/erc-scenarios-common.el | 23 +-
test/lisp/net/dbus-tests.el | 3 +
test/lisp/net/tramp-tests.el | 104 ++++---
.../lisp/progmodes/c-ts-mode-resources/indent.erts | 20 ++
.../typescript-ts-mode-resources/indent.erts | 17 ++
test/lisp/register-tests.el | 43 ---
88 files changed, 2338 insertions(+), 1132 deletions(-)
diff --git a/admin/authors.el b/admin/authors.el
index 2108f481a0c..7fb616ac0b7 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -176,6 +176,7 @@ files.")
("Miha Rihtaršič" "Miha Rihtarsic")
("Mikio Nakajima" "Nakajima Mikio")
("Nelson Jose dos Santos Ferreira" "Nelson Ferreira")
+ ("Noah Peart" "noah\\.v\\.peart@gmail\\.com")
("Noorul Islam" "Noorul Islam K M")
;;; ("Tetsurou Okazaki" "OKAZAKI Tetsurou") ; FIXME?
("Óscar Fuentes" "Oscar Fuentes")
diff --git a/configure.ac b/configure.ac
index debc6d1078f..759dcd14d50 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5158,6 +5158,9 @@ if test "${with_native_compilation}" = "default"; then
# Check if libgccjit really works.
AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken])
fi
+ if test "$with_unexec" = yes; then
+ with_native_compilation=no
+ fi
fi
if test "${with_native_compilation}" != "no"; then
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index e2d35863bd0..3be332e087f 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2007,8 +2007,8 @@ the one for @kbd{C-c C-x x} in Texinfo mode:
(keymap-set texinfo-mode-map "C-c p"
'backward-paragraph)
(keymap-set texinfo-mode-map "C-c n"
- 'forward-paragraph)))
- (keymap-set texinfo-mode-map "C-c C-x x" nil)
+ 'forward-paragraph)
+ (keymap-set texinfo-mode-map "C-c C-x x" nil)))
@end example
@node Modifier Keys
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 7efb4516d15..917e937d32d 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -547,6 +547,10 @@ buffer name with the buffer's default directory
(@pxref{File Names}).
to that major mode, in most cases. The command
@code{set-visited-file-name} also does this. @xref{Choosing Modes}.
+ If you wish to save the current buffer to a different file without
+visiting that file, use @code{mark-whole-buffer} (@kbd{C-x h}), then
+@w{@kbd{M-x write-region}} (@pxref{Misc File Ops}).
+
If Emacs is about to save a file and sees that the date of the latest
version on disk does not match what Emacs last read or wrote, Emacs
notifies you of this fact, because it probably indicates a problem caused
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 78503d31a38..e31df4865fc 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -295,8 +295,8 @@ Kill the spell-checker subprocess.
@item M-@key{TAB}
@itemx @key{ESC} @key{TAB}
@itemx C-M-i
-Complete the word before point based on the spelling dictionary
-(@code{ispell-complete-word}).
+Complete the word before point based on the spelling dictionary and
+other completion sources (@code{completion-at-point}).
@item M-x flyspell-mode
Enable Flyspell mode, which highlights all misspelled words.
@item M-x flyspell-prog-mode
@@ -398,14 +398,11 @@ Quit interactive spell-checking and kill the
spell-checker subprocess.
Show the list of options.
@end table
-@findex ispell-complete-word
- In Text mode and related modes, @kbd{M-@key{TAB}}
-(@code{ispell-complete-word}) performs in-buffer completion based on
-spelling correction. Insert the beginning of a word, and then type
-@kbd{M-@key{TAB}}; this shows a list of completions. (If your
+ Use the command @kbd{M-@key{TAB}} (@code{completion-at-point}) to
+complete the word at point. Insert the beginning of a word, and then
+type @kbd{M-@key{TAB}} to select from a list of completions. (If your
window manager intercepts @kbd{M-@key{TAB}}, type @w{@kbd{@key{ESC}
-@key{TAB}}} or @kbd{C-M-i}.) Each completion is listed with a digit or
-character; type that digit or character to choose it.
+@key{TAB}}} or @kbd{C-M-i}.)
@cindex @code{ispell} program
@findex ispell-kill-ispell
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index e52f68dd18e..5e5b7ae2b16 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -16,9 +16,8 @@ jump back to that position once or many times.
we will denote by @var{r}; @var{r} can be a letter (such as @samp{a})
or a number (such as @samp{1}); case matters, so register @samp{a} is
not the same as register @samp{A}. You can also set a register in
-non-alphanumeric characters, for instance @samp{*} or @samp{C-d}.
-Note, it's not possible to set a register in @samp{C-g} or @samp{ESC},
-because these keys are reserved for quitting (@pxref{Quitting}).
+non-alphanumeric characters, for instance @samp{C-d} by using for
+example @key{C-q} @samp{C-d}.
@findex view-register
A register can store a position, a piece of text, a rectangle, a
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 6f57bae8fef..b6a9dd6de53 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -943,12 +943,12 @@ situations where you shouldn't change the major mode---in
mail
composition, for instance.
@kindex M-TAB @r{(Text mode)}
- Text mode binds @kbd{M-@key{TAB}} to @code{ispell-complete-word}.
-This command performs completion of the partial word in the buffer
-before point, using the spelling dictionary as the space of possible
-words. @xref{Spelling}. If your window manager defines
-@kbd{M-@key{TAB}} to switch windows, you can type @kbd{@key{ESC}
-@key{TAB}} or @kbd{C-M-i} instead.
+ The command @kbd{M-@key{TAB}} (@code{completion-at-point}) performs
+completion of the partial word in the buffer before point, using the
+spelling dictionary as the space of possible words by default.
+@xref{Spelling}. If your window manager defines @kbd{M-@key{TAB}} to
+switch windows, you can type @kbd{@key{ESC} @key{TAB}} or @kbd{C-M-i}
+instead.
@vindex text-mode-hook
Entering Text mode runs the mode hook @code{text-mode-hook}
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index e4a0f585f69..d6627a2a1ca 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -5445,7 +5445,11 @@ That expression starts with @code{get-buffer-create
buffer}. The
function tells the computer to use the buffer with the name specified
as the one to which you are copying, or if such a buffer does not
exist, to create it. Then, the @code{with-current-buffer} function
-evaluates its body with that buffer temporarily current.
+evaluates its body with that buffer temporarily current, after which
+it will switch back to the buffer we are at now@footnote{It is like
+calling @w{@code{(save-excursion (set-buffer @dots{}) @dots{})}} in
+one go, though it is defined slightly differently which interested
+reader can find out using @code{describe-function}.}.
(This demonstrates another way to shift the computer's attention but
not the user's. The @code{append-to-buffer} function showed how to do
@@ -5982,12 +5986,12 @@ In outline, the whole function looks like this:
(and @var{are-both-transient-mark-mode-and-mark-active-true})
(push-mark))
(let (@var{determine-size-and-set-it})
- (goto-char
- (@var{if-there-is-an-argument}
- @var{figure-out-where-to-go}
- @var{else-go-to}
- (point-min))))
- @var{do-nicety}
+ (goto-char
+ (@var{if-there-is-an-argument}
+ @var{figure-out-where-to-go}
+ @var{else-go-to}
+ (point-min))))
+ @var{do-nicety}
@end group
@end smallexample
@@ -6040,12 +6044,13 @@ like this:
@group
(if (> (buffer-size) 10000)
;; @r{Avoid overflow for large buffer sizes!}
- (* (prefix-numeric-value arg)
- (/ size 10))
+ (* (prefix-numeric-value arg)
+ (/ size 10))
(/
(+ 10
- (*
- size (prefix-numeric-value arg))) 10)))
+ (* size
+ (prefix-numeric-value arg)))
+ 10))
@end group
@end smallexample
@@ -6182,7 +6187,7 @@ The code looks like this:
@c Keep this on one line.
@smallexample
-(/ (+ 10 (* size (prefix-numeric-value arg))) 10))
+(/ (+ 10 (* size (prefix-numeric-value arg))) 10)
@end smallexample
@need 1200
@@ -6199,7 +6204,7 @@ enclosing expression:
(*
size
(prefix-numeric-value arg)))
- 10))
+ 10)
@end group
@end smallexample
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 13090a13d71..70a4899b623 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -986,9 +986,9 @@ allows users to customize a single mode hook
@deffn Command text-mode
Text mode is a major mode for editing human languages. It defines the
@samp{"} and @samp{\} characters as having punctuation syntax
-(@pxref{Syntax Class Table}), and binds @kbd{M-@key{TAB}} to
-@code{ispell-complete-word} (@pxref{Spelling,,, emacs, The GNU Emacs
-Manual}).
+(@pxref{Syntax Class Table}), and arranges for
+@code{completion-at-point} to complete words based on the spelling
+dictionary (@pxref{Completion in Buffers}).
An example of a major mode derived from Text mode is HTML mode.
@xref{HTML Mode,,SGML and HTML Modes, emacs, The GNU Emacs Manual}.
@@ -1382,15 +1382,6 @@ the conventions listed above:
st)
"Syntax table used while in `text-mode'.")
@end group
-
-;; @r{Create the keymap for this mode.}
-@group
-(defvar-keymap text-mode-map
- :doc "Keymap for `text-mode'.
-Many other modes, such as `mail-mode' and `outline-mode', inherit all
-the commands defined in this map."
- "C-M-i" #'ispell-complete-word)
-@end group
@end smallexample
Here is how the actual mode command is defined now:
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 3e7872208a2..887b41d0005 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1516,6 +1516,9 @@ If @var{process} is a process object which contains the
property
@code{remote-pid}, or @var{process} is a number and @var{remote} is a
remote file name, @var{process} is interpreted as process on the
respective remote host, which will be the process to signal.
+
+If @var{process} is a string, it is interpreted as process object with
+the respective process name, or as a number.
@end deffn
Sometimes, it is necessary to send a signal to a non-local
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 2bd6b9556c8..9dff54ff94a 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -1418,6 +1418,9 @@ The name @var{service} does not exist on the bus.
@item :not-owner
We are not an owner of the name @var{service}.
@end table
+
+When @var{service} is not a known name but a unique name, the function
+returns nil.
@end defun
When a name has been chosen, Emacs can offer its own methods, which
diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi
index 917fd588593..1aeaef8990f 100644
--- a/doc/misc/epa.texi
+++ b/doc/misc/epa.texi
@@ -640,6 +640,9 @@ Customize variable @code{epg-pinentry-mode} to
@code{loopback} in
Emacs.
@end enumerate
+Note that loopback Pinentry does not work with @command{gpgsm},
+therefore EasyPG will ignore this setting for it.
+
There are other options available to use Emacs as Pinentry, you might
come across a Pinentry called @command{pinentry-emacs} or
@command{gpg-agent} option @code{allow-emacs-pinentry}. However,
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 582038d973f..586e4b94ba1 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -21596,7 +21596,7 @@ Search Groups}).
Search queries can be specified one of two ways: either using the
syntax of the engine responsible for the group you're searching, or
using Gnus' generalized search syntax. Set the option
-@code{gnus-search-use-parsed-queries} to a non-@code{nil} value to used the
+@code{gnus-search-use-parsed-queries} to a non-@code{nil} value to use the
generalized syntax. The advantage of this syntax is that, if you have
multiple backends indexed by different engines, you don't need to
remember which one you're searching---it's also possible to issue the
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 801e4b931e2..c21426a32f7 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -5240,7 +5240,7 @@ Yes. @command{OpenSSH} has added support for
@acronym{FIDO} hardware
devices via special key types @option{*-sk}. @value{tramp} supports
the additional handshaking messages for them. This requires at least
@command{OpenSSH} 8.2, and a @acronym{FIDO} @acronym{U2F} compatible
-security key, like yubikey, solokey, or nitrokey.
+security key, like yubikey, solokey, nitrokey, or titankey.
@item
diff --git a/etc/NEWS b/etc/NEWS
index 259af667c03..da00ea9dbda 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -496,6 +496,21 @@ It also controls how to move point when encountering a
boundary
(e.g., if every line is visible, invoking 'dired-next-line' at
the last line will move to the first line). The default is nil.
+*** New user option 'dired-filename-display-length'.
+It is an integer representing the maximum display length of filenames.
+The middle part of filename whose length exceeds the restriction is
+hidden and an ellipsis is displayed instead. A value of 'window'
+means using the right edge of window as the display restriction. The
+default is nil.
+
+*** New user option 'shell-command-guess-functions'.
+It defines how to populate a list of commands available
+for 'M-!', 'M-&', '!', '&' and the context menu "Open With"
+based on marked files in Dired. Possible backends are
+'dired-guess-default', MIME types, XDG configuration
+and a universal command such as "open" or "start"
+that delegates to the OS.
+
** Ediff
---
@@ -1125,6 +1140,20 @@ showcases all their customization options.
* Incompatible Lisp Changes in Emacs 30.1
+---
+** 'register-preview-delay' is no longer used.
+Register preview is no more delayed. If you want to disable it use
+'register-use-preview' instead with a boolean value.
+
++++
+** 'M-TAB' now invokes 'completion-at-point' also in Text mode.
+Text mode no longer binds 'M-TAB' to 'ispell-complete-word', and
+instead this mode arranges for 'completion-at-point', globally bound
+to 'M-TAB', to perform word completion as well. If you want 'M-TAB'
+to invoke 'ispell-complete-word', as it did in previous Emacs
+versions, customize the new option
+'text-mode-meta-tab-ispell-complete-word' to non-nil.
+
** 'pp' and 'pp-to-string' now always include a terminating newline.
In the past they included a terminating newline in most cases but not all.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 72a6639c978..fdce1bc81ba 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -534,6 +534,16 @@ is to downgrade to a version of GnuPG older than 2.4.1
(or, in the
future, upgrade to a newer version which solves the problem, when such
a fixed version becomes available).
+*** EasyPG loopback pinentry does not work with gpgsm.
+
+This happens with the 'gpgsm' command from all versions of GnuPG.
+EasyPG relies on the machine-parseable interface that is provided by
+'gpg2' with option '--status-fd', but gpgsm does not support this.
+
+As a workaround, input the passphrase with a GUI-capable pinentry
+program like 'pinentry-gnome' or 'pinentry-qt5'. Alternatively, you
+can use the 'pinentry' package from Emacs 25.
+
*** Emacs running on WSL receives stray characters as input.
For example, you could see Emacs inserting 'z' characters even though
diff --git a/exec/config.guess b/exec/config.guess
index c7f17e8fb97..e7a6fe3e6d1 100755
--- a/exec/config.guess
+++ b/exec/config.guess
@@ -1,10 +1,10 @@
#!/usr/bin/sh
# Attempt to guess a canonical system name.
-# Copyright 1992-2022 Free Software Foundation, Inc.
+# Copyright 1992-2023 Free Software Foundation, Inc.
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-05-25'
+timestamp='2023-06-23'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -47,7 +47,7 @@ me=`echo "$0" | sed -e 's,.*/,,'`
usage="\
Usage: $0 [OPTION]
-Output the configuration name of the system \`$me' is run on.
+Output the configuration name of the system '$me' is run on.
Options:
-h, --help print this help, then exit
@@ -60,13 +60,13 @@ version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
-Copyright 1992-2022 Free Software Foundation, Inc.
+Copyright 1992-2023 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
-Try \`$me --help' for more information."
+Try '$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
@@ -102,8 +102,8 @@ GUESS=
# temporary files to be created and, as you can see below, it is a
# headache to deal with in a portable fashion.
-# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
-# use `HOST_CC' if defined, but it is deprecated.
+# Historically, 'CC_FOR_BUILD' used to be named 'HOST_CC'. We still
+# use 'HOST_CC' if defined, but it is deprecated.
# Portable tmp directory creation inspired by the Autoconf team.
@@ -459,7 +459,7 @@ case
$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION in
UNAME_RELEASE=`uname -v`
;;
esac
- # Japanese Language versions have a version number like `4.1.3-JL'.
+ # Japanese Language versions have a version number like '4.1.3-JL'.
SUN_REL=`echo "$UNAME_RELEASE" | sed -e 's/-/_/'`
GUESS=sparc-sun-sunos$SUN_REL
;;
@@ -966,6 +966,12 @@ EOF
GNU_REL=`echo "$UNAME_RELEASE" | sed -e 's/[-(].*//'`
GUESS=$UNAME_MACHINE-unknown-$GNU_SYS$GNU_REL-$LIBC
;;
+ x86_64:[Mm]anagarm:*:*|i?86:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-pc-managarm-mlibc"
+ ;;
+ *:[Mm]anagarm:*:*)
+ GUESS="$UNAME_MACHINE-unknown-managarm-mlibc"
+ ;;
*:Minix:*:*)
GUESS=$UNAME_MACHINE-unknown-minix
;;
@@ -1036,7 +1042,7 @@ EOF
k1om:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
- loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*)
+ loongarch32:Linux:*:* | loongarch64:Linux:*:*)
GUESS=$UNAME_MACHINE-unknown-linux-$LIBC
;;
m32r*:Linux:*:*)
@@ -1191,7 +1197,7 @@ EOF
GUESS=$UNAME_MACHINE-pc-sysv4.2uw$UNAME_VERSION
;;
i*86:OS/2:*:*)
- # If we were able to find `uname', then EMX Unix compatibility
+ # If we were able to find 'uname', then EMX Unix compatibility
# is probably installed.
GUESS=$UNAME_MACHINE-pc-os2-emx
;;
@@ -1332,7 +1338,7 @@ EOF
GUESS=ns32k-sni-sysv
fi
;;
- PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
+ PENTIUM:*:4.0*:*) # Unisys 'ClearPath HMP IX 4000' SVR4/MP effort
# says <Richard.M.Bartel@ccMail.Census.GOV>
GUESS=i586-unisys-sysv4
;;
diff --git a/exec/config.sub b/exec/config.sub
index b41da55df45..a6d99a0f15f 100755
--- a/exec/config.sub
+++ b/exec/config.sub
@@ -1,10 +1,10 @@
#!/usr/bin/sh
# Configuration validation subroutine script.
-# Copyright 1992-2022 Free Software Foundation, Inc.
+# Copyright 1992-2023 Free Software Foundation, Inc.
# shellcheck disable=SC2006,SC2268 # see below for rationale
-timestamp='2022-01-03'
+timestamp='2023-06-23'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -76,13 +76,13 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
-Copyright 1992-2022 Free Software Foundation, Inc.
+Copyright 1992-2023 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
-Try \`$me --help' for more information."
+Try '$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
@@ -130,7 +130,7 @@ IFS=$saved_IFS
# Separate into logical components for further validation
case $1 in
*-*-*-*-*)
- echo Invalid configuration \`"$1"\': more than four components
>&2
+ echo "Invalid configuration '$1': more than four components" >&2
exit 1
;;
*-*-*-*)
@@ -145,7 +145,7 @@ case $1 in
nto-qnx* | linux-* | uclinux-uclibc* \
| uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* |
netbsd*-gnu* \
| netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \
- | storm-chaos* | os2-emx* | rtmk-nova*)
+ | storm-chaos* | os2-emx* | rtmk-nova* | managarm-*)
basic_machine=$field1
basic_os=$maybe_os
;;
@@ -943,7 +943,7 @@ $basic_machine
EOF
IFS=$saved_IFS
;;
- # We use `pc' rather than `unknown'
+ # We use 'pc' rather than 'unknown'
# because (1) that's what they normally are, and
# (2) the word "unknown" tends to confuse beginning users.
i*86 | x86_64)
@@ -1075,7 +1075,7 @@ case $cpu-$vendor in
pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
cpu=i586
;;
- pentiumpro-* | p6-* | 6x86-* | athlon-* | athalon_*-*)
+ pentiumpro-* | p6-* | 6x86-* | athlon-* | athlon_*-*)
cpu=i686
;;
pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
@@ -1207,7 +1207,7 @@ case $cpu-$vendor in
| k1om \
| le32 | le64 \
| lm32 \
- | loongarch32 | loongarch64 | loongarchx32 \
+ | loongarch32 | loongarch64 \
| m32c | m32r | m32rle \
| m5200 | m68000 | m680[012346]0 | m68360 | m683?2 |
m68k \
| m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \
@@ -1285,7 +1285,7 @@ case $cpu-$vendor in
;;
*)
- echo Invalid configuration \`"$1"\': machine
\`"$cpu-$vendor"\' not recognized 1>&2
+ echo "Invalid configuration '$1': machine
'$cpu-$vendor' not recognized" 1>&2
exit 1
;;
esac
@@ -1341,6 +1341,10 @@ EOF
kernel=linux
os=`echo "$basic_os" | sed -e 's|linux|gnu|'`
;;
+ managarm*)
+ kernel=managarm
+ os=`echo "$basic_os" | sed -e 's|managarm|mlibc|'`
+ ;;
*)
kernel=
os=$basic_os
@@ -1754,7 +1758,7 @@ case $os in
| onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
| midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
| nsk* | powerunix* | genode* | zvmoe* | qnx* | emx* | zephyr* \
- | fiwix* )
+ | fiwix* | mlibc* )
;;
# This one is extra strict with allowed versions
sco3.2v2 | sco3.2v[4-9]* | sco5v6*)
@@ -1762,8 +1766,11 @@ case $os in
;;
none)
;;
+ kernel* )
+ # Restricted further below
+ ;;
*)
- echo Invalid configuration \`"$1"\': OS \`"$os"\' not
recognized 1>&2
+ echo "Invalid configuration '$1': OS '$os' not recognized" 1>&2
exit 1
;;
esac
@@ -1772,14 +1779,24 @@ esac
# (given a valid OS), if there is a kernel.
case $kernel-$os in
linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* \
- | linux-musl* | linux-relibc* | linux-uclibc* )
+ | linux-musl* | linux-relibc* | linux-uclibc* | linux-mlibc*
)
;;
uclinux-uclibc* )
;;
- -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* )
+ managarm-mlibc* | managarm-kernel* )
+ ;;
+ -dietlibc* | -newlib* | -musl* | -relibc* | -uclibc* | -mlibc* )
# These are just libc implementations, not actual OSes, and thus
# require a kernel.
- echo "Invalid configuration \`$1': libc \`$os' needs explicit
kernel." 1>&2
+ echo "Invalid configuration '$1': libc '$os' needs explicit
kernel." 1>&2
+ exit 1
+ ;;
+ -kernel* )
+ echo "Invalid configuration '$1': '$os' needs explicit kernel."
1>&2
+ exit 1
+ ;;
+ *-kernel* )
+ echo "Invalid configuration '$1': '$kernel' does not support
'$os'." 1>&2
exit 1
;;
kfreebsd*-gnu* | kopensolaris*-gnu*)
@@ -1796,7 +1813,7 @@ case $kernel-$os in
# Blank kernel with real OS is always fine.
;;
*-*)
- echo "Invalid configuration \`$1': Kernel \`$kernel' not known
to work with OS \`$os'." 1>&2
+ echo "Invalid configuration '$1': Kernel '$kernel' not known to
work with OS '$os'." 1>&2
exit 1
;;
esac
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java
b/java/org/gnu/emacs/EmacsOpenActivity.java
index 5cca6cfcdff..32a79d1a797 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -533,8 +533,7 @@ public final class EmacsOpenActivity extends Activity
else
uri = intent.getParcelableExtra (Intent.EXTRA_STREAM);
- if (uri != null
- && (scheme = uri.getScheme ()) != null
+ if ((scheme = uri.getScheme ()) != null
&& scheme.equals ("content"))
{
tem1 = EmacsService.buildContentName (uri);
diff --git a/java/org/gnu/emacs/EmacsSafThread.java
b/java/org/gnu/emacs/EmacsSafThread.java
index 1b62662b4fc..7917e2d4880 100644
--- a/java/org/gnu/emacs/EmacsSafThread.java
+++ b/java/org/gnu/emacs/EmacsSafThread.java
@@ -1430,9 +1430,6 @@ public final class EmacsSafThread extends HandlerThread
/* If so, don't check for FLAG_SUPPORTS_WRITE.
Check for FLAG_DIR_SUPPORTS_CREATE instead. */
- if (!writable)
- return 0;
-
index = cursor.getColumnIndex (Document.COLUMN_FLAGS);
if (index < 0)
return -3;
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 3cc37dd992d..33832505333 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -1413,7 +1413,7 @@ public final class EmacsService extends Service
of OperationCanceledException, SecurityException,
FileNotFoundException, or UnsupportedOperationException. */
- private int
+ public int
documentIdFromName (String tree_uri, String name, String[] id_return)
{
/* Start the thread used to run SAF requests if it isn't already
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index f20e5801a01..05a603c3f56 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -43,11 +43,12 @@
;;; Measures, by François Cardarelli)
;;; All conversions are exact unless otherwise noted.
-;; CODATA values updated February 2016, using 2014 adjustment
-;; https://arxiv.org/pdf/1507.07956.pdf
-
;; Updated November 2018 for the redefinition of the SI
-;; https://www.bipm.org/utils/en/pdf/CGPM/Draft-Resolution-A-EN.pdf
+;; https://www.bipm.org/en/committees/cg/cgpm/26-2018/resolution-1
+
+;; CODATA values last updated November 2023, using 2018 adjustment:
+;; E. Tiesinga, P. J. Mohr, D. B. Newell, and B. N. Taylor,
+;; Rev. Mod. Phys. 93, 025010 (2021)
(defvar math-standard-units
'( ;; Length
@@ -122,7 +123,6 @@
( mph "mi/hr" "*Miles per hour" )
( kph "km/hr" "Kilometers per hour" )
( knot "nmi/hr" "Knot" )
- ( c "299792458 m/s" "Speed of light" ) ;; SI definition
;; Acceleration
( ga "980665*10^(-5) m/s^2" "*\"g\" acceleration" nil
@@ -143,8 +143,8 @@
"31.10347680 g") ;; ESUWM, 1/12 exact value for lbt
( ct "(2/10) g" "Carat" nil
"0.2 g") ;; ESUWM
- ( u "1.660539040*10^(-27) kg" "Unified atomic mass" nil
- "1.660539040 10^-27 kg (*)");;(approx) CODATA
+ ( u "1.66053906660*10^(-27) kg" "Unified atomic mass" nil
+ "1.66053906660 10^-27 kg (*)") ;; (approx) CODATA
;; Force
( N "m kg/s^2" "*Newton" )
@@ -210,9 +210,6 @@
( A nil "*Ampere" )
( C "A s" "Coulomb" )
( Fdy "ech Nav" "Faraday" )
- ( e "ech" "Elementary charge" )
- ( ech "1.602176634*10^(-19) C" "Elementary charge" nil
- "1.602176634 10^-19 C") ;; SI definition
( V "W/A" "Volt" )
( ohm "V/A" "Ohm" )
( Ω "ohm" "Ohm" )
@@ -259,53 +256,61 @@
;; Solid angle
( sr nil "*Steradian" )
+ ;; Constants defining the International System of Units (SI)
+ ( c "299792458 m/s" "*Speed of light" )
+ ( h "6.62607015*10^(-34) J s" "Planck constant" nil
+ "6.62607015 10^-34 J s")
+ ( ech "1.602176634*10^(-19) C" "Elementary charge" nil
+ "1.602176634 10^-19 C")
+ ( e "ech" "Elementary charge" nil
+ "1.602176634 10^-19 C")
+ ( k "1.380649*10^(-23) J/K" "Boltzmann constant" nil
+ "1.380649 10^-23 J/K")
+ ( Nav "6.02214076*10^(23) / mol" "Avogadro constant" nil
+ "6.02214076 10^23 / mol")
+
;; Other physical quantities
;; Unless otherwise mentioned, the values are from CODATA,
;; and are approximate.
- ( h "6.62607015*10^(-34) J s" "*Planck's constant" nil
- "6.62607015 10^-34 J s") ;; SI definition
- ( hbar "h / (2 pi)" "Planck's constant" ) ;; Exact
+ ( hbar "h / (2 pi)" "*Reduced Planck constant" )
;; After the 2018 SI redefinition, eps0 and mu0 are measured quantities,
;; and mu0 no longer has the previous exact value of 4 pi 10^(-7) H/m.
( eps0 "ech^2 / (2 alpha h c)" "Permittivity of vacuum" )
( ε0 "eps0" "Permittivity of vacuum" )
( mu0 "1 / (eps0 c^2)" "Permeability of vacuum")
( μ0 "mu0" "Permeability of vacuum")
- ( G "6.67408*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil
- "6.67408 10^-11 m^3/(kg s^2) (*)")
- ( Nav "6.02214076*10^(23) / mol" "Avogadro's constant" nil
- "6.02214076 10^23 / mol") ;; SI definition
- ( me "9.10938356*10^(-31) kg" "Electron rest mass" nil
- "9.10938356 10^-31 kg (*)")
- ( mp "1.672621898*10^(-27) kg" "Proton rest mass" nil
- "1.672621898 10^-27 kg (*)")
- ( mn "1.674927471*10^(-27) kg" "Neutron rest mass" nil
- "1.674927471 10^-27 kg (*)")
- ( mmu "1.883531594*10^(-28) kg" "Muon rest mass" nil
- "1.883531594 10^-28 kg (*)")
+ ( G "6.67430*10^(-11) m^3/(kg s^2)" "Gravitational constant" nil
+ "6.67430 10^-11 m^3/(kg s^2) (*)")
+ ( me "9.1093837015*10^(-31) kg" "Electron rest mass" nil
+ "9.1093837015 10^-31 kg (*)")
+ ( mp "1.67262192369*10^(-27) kg" "Proton rest mass" nil
+ "1.67262192369 10^-27 kg (*)")
+ ( mn "1.67492749804*10^(-27) kg" "Neutron rest mass" nil
+ "1.67492749804 10^-27 kg (*)")
+ ( mmu "1.883531627*10^(-28) kg" "Muon rest mass" nil
+ "1.883531627 10^-28 kg (*)")
( mμ "mmu" "Muon rest mass" nil
- "1.883531594 10^-28 kg (*)")
- ( Ryd "10973731.568508 /m" "Rydberg's constant" nil
- "10973731.568508 /m (*)")
- ( k "1.380649*10^(-23) J/K" "Boltzmann's constant" nil
- "1.380649 10^-23 J/K") ;; SI definition
+ "1.883531627 10^-28 kg (*)")
+ ( Ryd "10973731.568160 /m" "Rydberg constant" nil
+ "10973731.568160 /m (*)")
( sigma "2 pi^5 k^4 / (15 h^3 c^2)" "Stefan-Boltzmann constant")
( σ "sigma" "Stefan-Boltzmann constant")
- ( alpha "7.2973525664*10^(-3)" "Fine structure constant" nil
- "7.2973525664 10^-3 (*)")
- ( α "alpha" "Fine structure constant" nil
- "7.2973525664 10^-3 (*)")
- ( muB "927.4009994*10^(-26) J/T" "Bohr magneton" nil
- "927.4009994 10^-26 J/T (*)")
- ( muN "5.050783699*10^(-27) J/T" "Nuclear magneton" nil
- "5.050783699 10^-27 J/T (*)")
- ( mue "-928.4764620*10^(-26) J/T" "Electron magnetic moment" nil
- "-928.4764620 10^-26 J/T (*)")
- ( mup "1.4106067873*10^(-26) J/T" "Proton magnetic moment" nil
- "1.4106067873 10^-26 J/T (*)")
- ( R0 "Nav k" "Molar gas constant") ;; Exact
- ( V0 "22.710947*10^(-3) m^3/mol" "Standard volume of ideal gas" nil
- "22.710947 10^-3 m^3/mol (*)")
+ ( alpha "7.2973525693*10^(-3)" "Fine structure constant" nil
+ "7.2973525693 10^-3 (*)")
+ ( α "alpha" "Fine structure constant" nil
+ "7.2973525693 10^-3 (*)")
+ ( muB "9.2740100783*10^(-24) J/T" "Bohr magneton" nil
+ "9.2740100783 10^-24 J/T (*)")
+ ( muN "5.0507837461*10^(-27) J/T" "Nuclear magneton" nil
+ "5.0507837461 10^-27 J/T (*)")
+ ( mue "-9.2847647043*10^(-24) J/T" "Electron magnetic moment" nil
+ "-9.2847647043 10^-24 J/T (*)")
+ ( mup "1.41060679736*10^(-26) J/T" "Proton magnetic moment" nil
+ "1.41060679736 10^-26 J/T (*)")
+ ( R0 "Nav k" "Molar gas constant" )
+ ( V0 "R0 273.15 K / 10^5 Pa" "Standard volume of ideal gas" )
+ ;; IUPAC 1982 standard temperature and pressure
+
;; Logarithmic units
( Np nil "*Neper")
( dB "(ln(10)/20) Np" "decibel"))
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6048d5be272..1d5f1253702 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -22,10 +22,11 @@
;;; Commentary:
;; This library provides the Completion Preview mode. This minor mode
-;; displays the top completion candidate for the symbol at point in an
+;; displays a completion suggestion for the symbol at point in an
;; overlay after point. Check out the customization group
;; `completion-preview' for user options that you may want to tweak.
;;
+;; To enable Completion Preview mode, use `completion-preview-mode'.
;; To accept the completion suggestion, press TAB. If you want to
;; ignore a completion suggestion, just go on editing or moving around
;; the buffer. Completion Preview mode continues to update the
@@ -48,15 +49,6 @@
;; that should appear around point for Emacs to suggest a completion.
;; By default, this option is set to 3, so Emacs suggests a completion
;; if you type "foo", but typing just "fo" doesn't show the preview.
-;;
-;; The user option `completion-preview-insert-on-completion' controls
-;; what happens when you invoke `completion-at-point' while the
-;; completion preview is visible. By default this option is nil,
-;; which tells `completion-at-point' to ignore the completion preview
-;; and show the list of completion candidates as usual. If you set
-;; `completion-preview-insert-on-completion' to non-nil, then
-;; `completion-at-point' inserts the preview directly without looking
-;; for more candidates.
;;; Code:
@@ -91,9 +83,20 @@ first candidate, and you can cycle between the candidates
with
:type 'natnum
:version "30.1")
-(defcustom completion-preview-insert-on-completion nil
- "Whether \\[completion-at-point] inserts the previewed suggestion."
- :type 'boolean
+(defcustom completion-preview-message-format
+ "Completion suggestion %i out of %n"
+ "Message to show after cycling the completion preview suggestion.
+
+If the value is a string, `completion-preview-next-candidate' and
+`completion-preview-prev-candidate' display this string in the
+echo area, after substituting \"%i\" with the 1-based index of
+the completion suggestion that the preview is showing, and \"%n\"
+with the total number of available completion suggestions for the
+text around point.
+
+If this option is nil, these commands do not display any message."
+ :type '(choice (string :tag "Message format")
+ (const :tag "No message" nil))
:version "30.1")
(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha
@@ -113,6 +116,11 @@ first candidate, and you can cycle between the candidates
with
"Face for exact completion preview overlay."
:version "30.1")
+(defface completion-preview-highlight
+ '((t :inherit highlight))
+ "Face for highlighting the completion preview when the mouse is over it."
+ :version "30.1")
+
(defvar-keymap completion-preview-active-mode-map
:doc "Keymap for Completion Preview Active mode."
"C-i" #'completion-preview-insert
@@ -120,11 +128,26 @@ first candidate, and you can cycle between the candidates
with
;; "M-p" #'completion-preview-prev-candidate
)
+(defvar-keymap completion-preview--mouse-map
+ :doc "Keymap for mouse clicks on the completion preview."
+ "<down-mouse-1>" #'completion-preview-insert
+ "C-<down-mouse-1>" #'completion-at-point
+ "<down-mouse-2>" #'completion-at-point
+ (format "<%s>" mouse-wheel-up-event)
#'completion-preview-prev-candidate
+ (format "<%s>" mouse-wheel-up-alternate-event)
#'completion-preview-prev-candidate
+ (format "<%s>" mouse-wheel-down-event)
#'completion-preview-next-candidate
+ (format "<%s>" mouse-wheel-down-alternate-event)
#'completion-preview-next-candidate)
+
(defvar-local completion-preview--overlay nil)
(defvar completion-preview--internal-commands
- '(completion-preview-next-candidate completion-preview-prev-candidate)
- "List of commands that manipulate the completion preview.")
+ '(completion-preview-next-candidate
+ completion-preview-prev-candidate
+ ;; Don't dismiss or update the preview when the user scrolls.
+ mwheel-scroll)
+ "List of commands that manipulate the completion preview.
+
+Completion Preview mode avoids updating the preview after these commands.")
(defsubst completion-preview--internal-command-p ()
"Return non-nil if `this-command' manipulates the completion preview."
@@ -149,77 +172,96 @@ first candidate, and you can cycle between the candidates
with
(setq completion-preview--overlay nil)))
(defun completion-preview--make-overlay (pos string)
- "Make a new completion preview overlay at POS showing STRING."
+ "Make preview overlay showing STRING at POS, or move existing preview there."
(if completion-preview--overlay
(move-overlay completion-preview--overlay pos pos)
(setq completion-preview--overlay (make-overlay pos pos))
(overlay-put completion-preview--overlay 'window (selected-window)))
(let ((previous (overlay-get completion-preview--overlay 'after-string)))
- (unless (and previous (string= previous string))
+ (unless (and previous (string= previous string)
+ (eq (get-text-property 0 'face previous)
+ (get-text-property 0 'face string)))
(add-text-properties 0 1 '(cursor 1) string)
(overlay-put completion-preview--overlay 'after-string string))
completion-preview--overlay))
-(defun completion-preview--get (prop)
+(defsubst completion-preview--get (prop)
"Return property PROP of the completion preview overlay."
(overlay-get completion-preview--overlay prop))
(define-minor-mode completion-preview-active-mode
"Mode for when the completion preview is shown."
:interactive nil
- (if completion-preview-active-mode
- (add-hook 'completion-at-point-functions #'completion-preview--insert -1
t)
- (remove-hook 'completion-at-point-functions #'completion-preview--insert t)
- (completion-preview-hide)))
-
-(defun completion-preview--exit-function (func)
- "Return an exit function that hides the completion preview and calls FUNC."
- (lambda (&rest args)
- (completion-preview-active-mode -1)
- (when (functionp func) (apply func args))))
+ (unless completion-preview-active-mode (completion-preview-hide)))
+
+(defun completion-preview--try-table (table beg end props)
+ "Check TABLE for a completion matching the text between BEG and END.
+
+PROPS is a property list with additional information about TABLE.
+See `completion-at-point-functions' for more details.
+
+If TABLE contains a matching completion, return a list
+\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to
+show in the completion preview, ALL is the list of all matching
+completion candidates, BASE is a common prefix that TABLE elided
+from the start of each candidate, and EXIT-FN is either a
+function to call after inserting PREVIEW or nil. If TABLE does
+not contain matching completions, or if there are multiple
+matching completions and `completion-preview-exact-match-only' is
+non-nil, return nil instead."
+ (let* ((pred (plist-get props :predicate))
+ (exit-fn (plist-get props :exit-function))
+ (string (buffer-substring beg end))
+ (md (completion-metadata string table pred))
+ (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
+ (completion-metadata-get md 'display-sort-function)
+ completion-preview-sort-function))
+ (all (let ((completion-lazy-hilit t))
+ (completion-all-completions string table pred
+ (- (point) beg) md)))
+ (last (last all))
+ (base (or (cdr last) 0))
+ (prefix (substring string base)))
+ (when last
+ (setcdr last nil)
+ (when-let ((sorted (funcall sort-fn
+ (delete prefix (all-completions prefix
all)))))
+ (unless (and (cdr sorted) completion-preview-exact-match-only)
+ (list (propertize (substring (car sorted) (length prefix))
+ 'face (if (cdr sorted)
+ 'completion-preview
+ 'completion-preview-exact)
+ 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map)
+ (+ beg base) end sorted
+ (substring string 0 base) exit-fn))))))
+
+(defun completion-preview--capf-wrapper (capf)
+ "Translate return value of CAPF to properties for completion preview
overlay."
+ (let ((res (ignore-errors (funcall capf))))
+ (and (consp res)
+ (not (functionp res))
+ (seq-let (beg end table &rest plist) res
+ (or (completion-preview--try-table table beg end plist)
+ (unless (eq 'no (plist-get plist :exclusive))
+ ;; Return non-nil to exclude other capfs.
+ '(nil)))))))
(defun completion-preview--update ()
"Update completion preview."
- (seq-let (beg end table &rest plist)
- (let ((completion-preview-insert-on-completion nil))
- (run-hook-with-args-until-success 'completion-at-point-functions))
- (when (and beg end table)
- (let* ((pred (plist-get plist :predicate))
- (exit-fn (completion-preview--exit-function
- (plist-get plist :exit-function)))
- (string (buffer-substring beg end))
- (md (completion-metadata string table pred))
- (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
- (completion-metadata-get md 'display-sort-function)
- completion-preview-sort-function))
- (all (let ((completion-lazy-hilit t))
- (completion-all-completions string table pred
- (- (point) beg) md)))
- (last (last all))
- (base (or (cdr last) 0))
- (bbeg (+ beg base))
- (prefix (substring string base)))
- (when last
- (setcdr last nil)
- (let* ((filtered (remove prefix (all-completions prefix all)))
- (sorted (funcall sort-fn filtered))
- (multi (cadr sorted)) ; multiple candidates
- (cand (car sorted)))
- (when (and cand
- (not (and multi
- completion-preview-exact-match-only)))
- (let* ((face (if multi
- 'completion-preview
- 'completion-preview-exact))
- (after (propertize (substring cand (length prefix))
- 'face face))
- (ov (completion-preview--make-overlay end after)))
- (overlay-put ov 'completion-preview-beg bbeg)
- (overlay-put ov 'completion-preview-end end)
- (overlay-put ov 'completion-preview-index 0)
- (overlay-put ov 'completion-preview-cands sorted)
- (overlay-put ov 'completion-preview-exit-fn exit-fn)
- (completion-preview-active-mode)))))))))
+ (seq-let (preview beg end all base exit-fn)
+ (run-hook-wrapped
+ 'completion-at-point-functions
+ #'completion-preview--capf-wrapper)
+ (when preview
+ (let ((ov (completion-preview--make-overlay end preview)))
+ (overlay-put ov 'completion-preview-beg beg)
+ (overlay-put ov 'completion-preview-end end)
+ (overlay-put ov 'completion-preview-index 0)
+ (overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-base base)
+ (overlay-put ov 'completion-preview-exit-fn exit-fn)
+ (completion-preview-active-mode)))))
(defun completion-preview--show ()
"Show a new completion preview.
@@ -251,7 +293,9 @@ point, otherwise hide it."
;; The previous preview is still applicable, update it.
(overlay-put (completion-preview--make-overlay
cur (propertize (substring cand (- cur beg))
- 'face face))
+ 'face face
+ 'mouse-face
'completion-preview-highlight
+ 'keymap completion-preview--mouse-map))
'completion-preview-end cur)
;; The previous preview is no longer applicable, hide it.
(completion-preview-active-mode -1))))
@@ -271,35 +315,30 @@ point, otherwise hide it."
(completion-preview--show))
(completion-preview-active-mode -1)))
-(defun completion-preview--insert ()
- "Completion at point function for inserting the current preview.
-
-When `completion-preview-insert-on-completion' is nil, this
-function returns nil. Completion Preview mode adds this function
-to `completion-at-point-functions' when the preview is shown,
-such that `completion-at-point' inserts the preview candidate if
-and only if `completion-preview-insert-on-completion' is non-nil."
- (when (and completion-preview-active-mode
- completion-preview-insert-on-completion)
- (list (completion-preview--get 'completion-preview-beg)
- (completion-preview--get 'completion-preview-end)
- (list (nth (completion-preview--get 'completion-preview-index)
- (completion-preview--get 'completion-preview-cands)))
- :exit-function (completion-preview--get
'completion-preview-exit-fn))))
-
(defun completion-preview-insert ()
- "Insert the completion candidate that the preview shows."
+ "Insert the completion candidate that the preview is showing."
(interactive)
- (let ((completion-preview-insert-on-completion t))
- (completion-at-point)))
+ (if completion-preview-active-mode
+ (let* ((pre (completion-preview--get 'completion-preview-base))
+ (end (completion-preview--get 'completion-preview-end))
+ (ind (completion-preview--get 'completion-preview-index))
+ (all (completion-preview--get 'completion-preview-cands))
+ (efn (completion-preview--get 'completion-preview-exit-fn))
+ (aft (completion-preview--get 'after-string))
+ (str (concat pre (nth ind all))))
+ (completion-preview-active-mode -1)
+ (goto-char end)
+ (insert (substring-no-properties aft))
+ (when (functionp efn) (funcall efn str 'finished)))
+ (user-error "No current completion preview")))
(defun completion-preview-prev-candidate ()
- "Cycle the candidate that the preview shows to the previous suggestion."
+ "Cycle the candidate that the preview is showing to the previous suggestion."
(interactive)
(completion-preview-next-candidate -1))
(defun completion-preview-next-candidate (direction)
- "Cycle the candidate that the preview shows in direction DIRECTION.
+ "Cycle the candidate that the preview is showing in direction DIRECTION.
DIRECTION should be either 1 which means cycle forward, or -1
which means cycle backward. Interactively, DIRECTION is the
@@ -319,14 +358,37 @@ prefix argument and defaults to 1."
(let ((aft (propertize (substring str (- pos beg))
'face (if (< 1 len)
'completion-preview
- 'completion-preview-exact))))
+ 'completion-preview-exact)
+ 'mouse-face 'completion-preview-highlight
+ 'keymap completion-preview--mouse-map)))
(add-text-properties 0 1 '(cursor 1) aft)
(overlay-put completion-preview--overlay 'completion-preview-index new)
- (overlay-put completion-preview--overlay 'after-string aft)))))
+ (overlay-put completion-preview--overlay 'after-string aft))
+ (when completion-preview-message-format
+ (message (format-spec completion-preview-message-format
+ `((?i . ,(1+ new)) (?n . ,len))))))))
+
+(defun completion-preview--active-p (_symbol buffer)
+ "Check if the completion preview is currently shown in BUFFER."
+ (buffer-local-value 'completion-preview-active-mode buffer))
+
+(dolist (cmd '(completion-preview-insert
+ completion-preview-prev-candidate
+ completion-preview-next-candidate))
+ (put cmd 'completion-predicate #'completion-preview--active-p))
;;;###autoload
(define-minor-mode completion-preview-mode
- "Show in-buffer completion preview as you type."
+ "Show in-buffer completion suggestions in a preview as you type.
+
+This mode automatically shows and updates the completion preview
+according to the text around point.
+\\<completion-preview-active-mode-map>\
+When the preview is visible, \\[completion-preview-insert]
+accepts the completion suggestion,
+\\[completion-preview-next-candidate] cycles forward to the next
+completion suggestion, and \\[completion-preview-prev-candidate]
+cycles backward."
:lighter " CP"
(if completion-preview-mode
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 02194e6ff45..1a17ed749e8 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -763,22 +763,6 @@ with a prefix argument."
;;; Shell commands
-(declare-function mailcap-file-default-commands "mailcap" (files))
-
-(defvar dired-aux-files)
-
-(defun dired-minibuffer-default-add-shell-commands ()
- "Return a list of all commands associated with current Dired files.
-This function is used to add all related commands retrieved by `mailcap'
-to the end of the list of defaults just after the default value."
- (interactive)
- (let ((commands (and (boundp 'dired-aux-files)
- (require 'mailcap nil t)
- (mailcap-file-default-commands dired-aux-files))))
- (if (listp minibuffer-default)
- (append minibuffer-default commands)
- (cons minibuffer-default commands))))
-
;; This is an extra function so that you can redefine it, e.g., to use gmhist.
(defun dired-read-shell-command (prompt arg files)
"Read a Dired shell command.
@@ -789,14 +773,9 @@ file names. The result is used as the prompt.
Use `dired-guess-shell-command' to offer a smarter default choice
of shell command."
- (minibuffer-with-setup-hook
- (lambda ()
- (setq-local dired-aux-files files)
- (setq-local minibuffer-default-add-function
- #'dired-minibuffer-default-add-shell-commands))
- (setq prompt (format prompt (dired-mark-prompt arg files)))
- (dired-mark-pop-up nil 'shell files
- 'dired-guess-shell-command prompt files)))
+ (setq prompt (format prompt (dired-mark-prompt arg files)))
+ (dired-mark-pop-up nil 'shell files
+ 'dired-guess-shell-command prompt files))
;;;###autoload
(defcustom dired-confirm-shell-command t
@@ -1316,7 +1295,7 @@ See `dired-guess-shell-alist-user'."
;;;###autoload
(defun dired-guess-shell-command (prompt files)
"Ask user with PROMPT for a shell command, guessing a default from FILES."
- (let ((default (dired-guess-default files))
+ (let ((default (shell-command-guess files))
default-list val)
(if (null default)
;; Nothing to guess
@@ -1340,6 +1319,88 @@ See `dired-guess-shell-alist-user'."
;; If we got a return, then return default.
(if (equal val "") default val))))
+(defcustom shell-command-guess-functions
+ '(shell-command-guess-dired)
+ "List of functions that guess shell commands for files.
+Each function receives a list of commands and a list of file names
+and should return the same list of commands with changes
+such as added new commands."
+ :type '(repeat
+ (choice (function-item shell-command-guess-dired)
+ (function-item shell-command-guess-mailcap)
+ (function-item shell-command-guess-xdg)
+ (function-item shell-command-guess-open)
+ (function :tag "Custom function")))
+ :group 'dired
+ :version "30.1")
+
+(defun shell-command-guess (files)
+ "Return a list of shell commands, appropriate for FILES.
+The list is populated by calling functions from
+`shell-command-guess-functions'. Each function receives the list
+of commands and the list of file names and returns the same list
+after adding own commands to the composite list."
+ (let ((commands nil))
+ (run-hook-wrapped 'shell-command-guess-functions
+ (lambda (fun)
+ (setq commands (funcall fun commands files))
+ nil))
+ commands))
+
+(defun shell-command-guess-dired (commands files)
+ "Populate COMMANDS using `dired-guess-default'."
+ (append (ensure-list (dired-guess-default files)) commands))
+
+(declare-function mailcap-file-default-commands "mailcap" (files))
+
+(defun shell-command-guess-mailcap (commands files)
+ "Populate COMMANDS by MIME types of FILES."
+ (require 'mailcap)
+ (append (mailcap-file-default-commands files) commands))
+
+(declare-function xdg-mime-apps "xdg" (mime))
+(declare-function xdg-desktop-read-file "xdg" (filename &optional group))
+
+(defun shell-command-guess-xdg (commands files)
+ "Populate COMMANDS by XDG configuration for FILES."
+ (require 'xdg)
+ (let* ((xdg-mime (when (executable-find "xdg-mime")
+ (string-trim-right
+ (shell-command-to-string
+ (concat "xdg-mime query filetype " (car files))))))
+ (xdg-mime-apps (unless (string-empty-p xdg-mime)
+ (xdg-mime-apps xdg-mime)))
+ (xdg-commands
+ (mapcar (lambda (desktop)
+ (setq desktop (xdg-desktop-read-file desktop))
+ (propertize
+ (replace-regexp-in-string
+ " .*" "" (gethash "Exec" desktop))
+ 'name (gethash "Name" desktop)))
+ xdg-mime-apps)))
+ (append xdg-commands commands)))
+
+(defcustom shell-command-guess-open
+ (cond
+ ((executable-find "xdg-open")
+ "xdg-open")
+ ((memq system-type '(gnu/linux darwin))
+ "open")
+ ((memq system-type '(windows-nt ms-dos))
+ "start")
+ ((eq system-type 'cygwin)
+ "cygstart")
+ ((executable-find "run-mailcap")
+ "run-mailcap"))
+ "A shell command to open a file externally."
+ :type 'string
+ :group 'dired
+ :version "30.1")
+
+(defun shell-command-guess-open (commands _files)
+ "Populate COMMANDS by the `open' command."
+ (append (ensure-list shell-command-guess-open) commands))
+
;;; Commands that delete or redisplay part of the dired buffer
@@ -3856,9 +3917,6 @@ case, the VERBOSE argument is ignored."
(setq model (vc-checkout-model backend only-files-list))))
(list backend files only-files-list state model)))
-(define-obsolete-function-alias 'minibuffer-default-add-dired-shell-commands
- #'dired-minibuffer-default-add-shell-commands "29.1")
-
(provide 'dired-aux)
diff --git a/lisp/dired.el b/lisp/dired.el
index a3d7c636d29..97645c731c8 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -350,6 +350,7 @@ with the buffer narrowed to the listing."
(defcustom dired-make-directory-clickable t
"When non-nil, make the directory at the start of the dired buffer
clickable."
:version "29.1"
+ :group 'dired
:type 'boolean)
(defcustom dired-initial-position-hook nil
@@ -429,6 +430,7 @@ is anywhere on its Dired line, except the beginning of the
line."
(defcustom dired-kill-when-opening-new-dired-buffer nil
"If non-nil, kill the current buffer when selecting a new directory."
:type 'boolean
+ :group 'dired
:version "28.1")
(defcustom dired-guess-shell-case-fold-search t
@@ -516,6 +518,22 @@ Possible non-nil values:
(defcustom dired-hide-details-preserved-columns nil
"List of columns which are not hidden in `dired-hide-details-mode'."
:type '(repeat integer)
+ :group 'dired
+ :version "30.1")
+
+(defcustom dired-filename-display-length nil
+ "If non-nil, restrict the display length of filenames.
+If the value is the symbol `window', the right edge of current
+window is used as the restriction. Otherwise, it should be an
+integer representing the maximum filename length.
+
+The middle part of filename whose length exceeds the restriction
+is hidden by using the `invisible' property and an ellipsis is
+displayed instead."
+ :type '(choice (const :tag "No restriction" nil)
+ (const :tag "Window" window)
+ (integer :tag "Integer"))
+ :group 'dired
:version "30.1")
@@ -1901,51 +1919,72 @@ other marked file as well. Otherwise, unmark all
files."
(defvar dired-click-to-select-map)
(defun dired-insert-set-properties (beg end)
- "Add various text properties to the lines in the region, from BEG to END."
+ "Add various text properties to the lines in the region, from BEG to END.
+Overlays could be added when some user options are enabled, e.g.,
+`dired-filename-display-length'."
+ (remove-overlays beg end 'invisible 'dired-filename-hide)
(save-excursion
(goto-char beg)
- (while (< (point) end)
- (ignore-errors
- (if (not (dired-move-to-filename))
- (unless (or (looking-at-p "^$")
- (looking-at-p dired-subdir-regexp))
- (put-text-property (line-beginning-position)
- (1+ (line-end-position))
- 'invisible 'dired-hide-details-information))
- (save-excursion
- (let ((end (1- (point)))
- (opoint (goto-char (1+ (pos-bol))))
- (i 0))
- (put-text-property opoint end 'invisible
'dired-hide-details-detail)
- (while (re-search-forward "[^ ]+" end t)
- (when (member (cl-incf i) dired-hide-details-preserved-columns)
- (put-text-property opoint (point) 'invisible nil))
- (setq opoint (point)))))
- (let ((beg (point)) (end (save-excursion
- (dired-move-to-end-of-filename)
- (1- (point)))))
- (if dired-click-to-select-mode
- (put-text-property beg end 'keymap
- dired-click-to-select-map)
- (when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
- (put-text-property beg end 'keymap
- dired-mouse-drag-files-map)))
- (add-text-properties
- beg (1+ end)
- `(mouse-face
- highlight
- dired-filename t
- help-echo ,(if dired-click-to-select-mode
- "mouse-2: mark or unmark this file"
- (if (and dired-mouse-drag-files
- (fboundp 'x-begin-drag))
- "down-mouse-1: drag this file to another
program
+ (let ((ell-len (dired--get-ellipsis-length)) maxlen filename-col)
+ (while (< (point) end)
+ (ignore-errors
+ (if (not (dired-move-to-filename))
+ (unless (or (looking-at-p "^$")
+ (looking-at-p dired-subdir-regexp))
+ (put-text-property (line-beginning-position)
+ (1+ (line-end-position))
+ 'invisible 'dired-hide-details-information))
+ (save-excursion
+ (let ((end (1- (point)))
+ (opoint (goto-char (1+ (pos-bol))))
+ (i 0))
+ (put-text-property opoint end 'invisible
'dired-hide-details-detail)
+ (while (re-search-forward "[^ ]+" end t)
+ (when (member (cl-incf i)
dired-hide-details-preserved-columns)
+ (put-text-property opoint (point) 'invisible nil))
+ (setq opoint (point)))))
+ (let ((beg (point)) (end (save-excursion
+ (dired-move-to-end-of-filename)
+ (1- (point)))))
+ (if dired-click-to-select-mode
+ (put-text-property beg end 'keymap
+ dired-click-to-select-map)
+ (when (and dired-mouse-drag-files (fboundp 'x-begin-drag))
+ (put-text-property beg end 'keymap
+ dired-mouse-drag-files-map)))
+ (when dired-filename-display-length
+ (let ((len (string-width (buffer-substring beg (1+ end))))
+ ell-beg)
+ (or maxlen (setq maxlen
(dired--get-filename-display-length)))
+ (when (and (integerp maxlen) (> len maxlen (+ ell-len 2)))
+ (or filename-col (setq filename-col (current-column)))
+ (move-to-column (+ filename-col (/ maxlen 2)))
+ (setq ell-beg (point))
+ (move-to-column (+ filename-col (/ maxlen 2)
+ (- len maxlen) ell-len))
+ ;; Here we use overlays because isearch by default
+ ;; doesn't support finding matches in hidden text
+ ;; made invisible via text properties.
+ (let ((ov (make-overlay ell-beg (point))))
+ (overlay-put ov 'invisible 'dired-filename-hide)
+ (overlay-put ov 'isearch-open-invisible #'delete-overlay)
+ (overlay-put ov 'evaporate t)))))
+ (add-text-properties
+ beg (1+ end)
+ `(mouse-face
+ highlight
+ dired-filename t
+ help-echo ,(if dired-click-to-select-mode
+ "mouse-2: mark or unmark this file"
+ (if (and dired-mouse-drag-files
+ (fboundp 'x-begin-drag))
+ "down-mouse-1: drag this file to another
program
mouse-2: visit this file in other window"
- "mouse-2: visit this file in other window"))))
- (when (< (+ end 5) (line-end-position))
- (put-text-property (+ end 5) (line-end-position)
- 'invisible 'dired-hide-details-link)))))
- (forward-line 1))))
+ "mouse-2: visit this file in other window"))))
+ (when (< (+ end 5) (line-end-position))
+ (put-text-property (+ end 5) (line-end-position)
+ 'invisible 'dired-hide-details-link)))))
+ (forward-line 1)))))
(defun dired--make-directory-clickable ()
(save-excursion
@@ -1977,6 +2016,28 @@ mouse-2: visit this file in other window"
"RET" click))))
(setq segment-start (point)))))))
+(defun dired--get-ellipsis-length ()
+ "Return length of ellipsis."
+ (let* ((dt (or (window-display-table)
+ buffer-display-table
+ standard-display-table))
+ (glyphs (and dt (display-table-slot dt 'selective-display)))
+ (vlen (length glyphs))
+ (char-glyphs (make-vector vlen nil)))
+ (dotimes (i vlen)
+ (aset char-glyphs i (glyph-char (aref glyphs i))))
+ (string-width (if glyphs (concat char-glyphs) "..."))))
+
+(defun dired--get-filename-display-length ()
+ "Return maximum display length of filename.
+When `dired-filename-display-length' is not an integer, the
+function actually returns the number of columns available for
+displaying the file names, and should be called with point at the
+first character of the file name."
+ (if (integerp dired-filename-display-length)
+ dired-filename-display-length
+ (- (window-max-chars-per-line) 1 (current-column))))
+
;;; Reverting a dired buffer
@@ -2534,13 +2595,28 @@ Do so according to the former subdir alist
OLD-SUBDIR-ALIST."
"Populate MENU with Dired mode commands at CLICK."
(when (mouse-posn-property (event-start click) 'dired-filename)
(define-key menu [dired-separator] menu-bar-separator)
- (let ((easy-menu (make-sparse-keymap "Immediate")))
+ (let* ((filename (save-excursion
+ (mouse-set-point click)
+ (dired-get-filename nil t)))
+ (commands (shell-command-guess (list filename)))
+ (easy-menu (make-sparse-keymap "Immediate")))
(easy-menu-define nil easy-menu nil
- '("Immediate"
+ `("Immediate"
["Find This File" dired-mouse-find-file
:help "Edit file at mouse click"]
["Find in Other Window" dired-mouse-find-file-other-window
- :help "Edit file at mouse click in other window"]))
+ :help "Edit file at mouse click in other window"]
+ ,@(when commands
+ (list (cons "Open With"
+ (append
+ (mapcar (lambda (command)
+ `[,(or (get-text-property 0 'name command)
+ command)
+ (lambda ()
+ (interactive)
+ (dired-do-async-shell-command
+ ,command nil (list ,filename)))])
+ commands)))))))
(dolist (item (reverse (lookup-key easy-menu [menu-bar immediate])))
(when (consp item)
(define-key menu (vector (car item)) (cdr item))))))
@@ -2618,6 +2694,7 @@ Keybindings:
mode-line-buffer-identification
(propertized-buffer-identification "%17b"))
(add-to-invisibility-spec '(dired . t))
+ (dired-filename-update-invisibility-spec)
;; Ignore dired-hide-details-* value of invisible text property by default.
(when (eq buffer-invisibility-spec t)
(setq buffer-invisibility-spec (list t)))
@@ -3117,6 +3194,15 @@ See options: `dired-hide-details-hide-symlink-targets'
and
;;; Functions to hide/unhide text
+(defun dired-filename-update-invisibility-spec ()
+ "Update `buffer-invisibility-spec' for filenames.
+Specifically, the filename invisibility spec is added in Dired
+buffers and removed in WDired buffers."
+ (funcall (if (derived-mode-p 'dired-mode)
+ 'add-to-invisibility-spec
+ 'remove-from-invisibility-spec)
+ '(dired-filename-hide . t)))
+
(defun dired--find-hidden-pos (start end)
(text-property-any start end 'invisible 'dired))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 2caaadc9f9e..7a61a8fce7e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -485,10 +485,6 @@ There can be multiple entries for the same NAME if it has
several aliases.")
(`(,(pred byte-code-function-p) . ,exps)
(cons fn (mapcar #'byte-optimize-form exps)))
- (`(,(pred (not symbolp)) . ,_)
- (byte-compile-warn-x form "`%s' is a malformed function" fn)
- form)
-
((guard (when for-effect
(if-let ((tmp (byte-opt--fget fn 'side-effect-free)))
(or byte-compile-delete-errors
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 31f513ec91b..674dfcc8f56 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2479,10 +2479,9 @@ Call from the source buffer."
(print-quoted t)
(print-gensym t)
(print-circle t)) ; Handle circular data structures.
- (if (and (memq (car-safe form) '(defvar defvaralias defconst
- autoload custom-declare-variable))
- (stringp (nth 3 form)))
- (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
+ (if (memq (car-safe form) '(defvar defvaralias defconst
+ autoload custom-declare-variable))
+ (byte-compile-output-docform nil nil nil '("\n(" ")") form nil 3 nil
(memq (car form)
'(defvaralias autoload
custom-declare-variable)))
@@ -2492,10 +2491,105 @@ Call from the source buffer."
(defvar byte-compile--for-effect)
-(defun byte-compile-output-docform (preface name info form specindex quoted)
- "Print a form with a doc string. INFO is (prefix doc-index postfix).
-If PREFACE and NAME are non-nil, print them too,
-before INFO and the FORM but after the doc string itself.
+(defun byte-compile--output-docform-recurse
+ (info position form cvecindex docindex specindex quoted)
+ "Print a form with a doc string. INFO is (prefix postfix).
+POSITION is where the next doc string is to be inserted.
+CVECINDEX is the index in the FORM of the constant vector, or nil.
+DOCINDEX is the index of the doc string (or nil) in the FORM.
+If SPECINDEX is non-nil, it is the index in FORM
+of the function bytecode string. In that case,
+we output that argument and the following argument
+\(the constants vector) together, for lazy loading.
+QUOTED says that we have to put a quote before the
+list that represents a doc string reference.
+`defvaralias', `autoload' and `custom-declare-variable' need that.
+
+Return the position after any inserted docstrings as comments."
+ (let ((index 0)
+ doc-string-position)
+ ;; Insert the doc string, and make it a comment with #@LENGTH.
+ (when (and byte-compile-dynamic-docstrings
+ (stringp (nth docindex form)))
+ (goto-char position)
+ (setq doc-string-position
+ (byte-compile-output-as-comment
+ (nth docindex form) nil)
+ position (point))
+ (goto-char (point-max)))
+
+ (insert (car info))
+ (prin1 (car form) byte-compile--outbuffer)
+ (while (setq form (cdr form))
+ (setq index (1+ index))
+ (insert " ")
+ (cond ((and (numberp specindex) (= index specindex)
+ ;; Don't handle the definition dynamically
+ ;; if it refers (or might refer)
+ ;; to objects already output
+ ;; (for instance, gensyms in the arg list).
+ (let (non-nil)
+ (when (hash-table-p print-number-table)
+ (maphash (lambda (_k v) (if v (setq non-nil t)))
+ print-number-table))
+ (not non-nil)))
+ ;; Output the byte code and constants specially
+ ;; for lazy dynamic loading.
+ (goto-char position)
+ (let ((lazy-position (byte-compile-output-as-comment
+ (cons (car form) (nth 1 form))
+ t)))
+ (setq position (point))
+ (goto-char (point-max))
+ (princ (format "(#$ . %d) nil" lazy-position)
+ byte-compile--outbuffer)
+ (setq form (cdr form))
+ (setq index (1+ index))))
+ ((eq index cvecindex)
+ (let* ((cvec (car form))
+ (len (length cvec))
+ (index2 0)
+ elt)
+ (insert "[")
+ (while (< index2 len)
+ (setq elt (aref cvec index2))
+ (if (byte-code-function-p elt)
+ (setq position
+ (byte-compile--output-docform-recurse
+ '("#[" "]") position
+ (append elt nil) ; Convert the vector to a list.
+ 2 4 specindex nil))
+ (prin1 elt byte-compile--outbuffer))
+ (setq index2 (1+ index2))
+ (unless (eq index2 len)
+ (insert " ")))
+ (insert "]")))
+ ((= index docindex)
+ (cond
+ (doc-string-position
+ (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
+ doc-string-position)
+ byte-compile--outbuffer))
+ ((stringp (car form))
+ (let ((print-escape-newlines nil))
+ (goto-char (prog1 (1+ (point))
+ (prin1 (car form)
+ byte-compile--outbuffer)))
+ (insert "\\\n")
+ (goto-char (point-max))))
+ (t (prin1 (car form) byte-compile--outbuffer))))
+ (t (prin1 (car form) byte-compile--outbuffer))))
+ (insert (cadr info))
+ position))
+
+(defun byte-compile-output-docform (preface tailpiece name info form
+ cvecindex docindex
+ specindex quoted)
+ "Print a form with a doc string. INFO is (prefix postfix).
+If PREFACE, NAME, and TAILPIECE are non-nil, print them too,
+before/after INFO and the FORM but after the doc string itself.
+CVECINDEX is the index in the FORM of the constant vector, or nil.
+DOCINDEX is the index of the doc string (or nil) in the FORM.
If SPECINDEX is non-nil, it is the index in FORM
of the function bytecode string. In that case,
we output that argument and the following argument
@@ -2505,73 +2599,30 @@ list that represents a doc string reference.
`defvaralias', `autoload' and `custom-declare-variable' need that."
;; We need to examine byte-compile-dynamic-docstrings
;; in the input buffer (now current), not in the output buffer.
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
+ (let ((byte-compile-dynamic-docstrings byte-compile-dynamic-docstrings))
(with-current-buffer byte-compile--outbuffer
- (let (position)
- ;; Insert the doc string, and make it a comment with #@LENGTH.
- (when (and (>= (nth 1 info) 0) dynamic-docstrings)
- (setq position (byte-compile-output-as-comment
- (nth (nth 1 info) form) nil)))
-
- (let ((print-continuous-numbering t)
- print-number-table
- (index 0)
- ;; FIXME: The bindings below are only needed for when we're
- ;; called from ...-defmumble.
- (print-escape-newlines t)
- (print-length nil)
- (print-level nil)
- (print-quoted t)
- (print-gensym t)
- (print-circle t)) ; Handle circular data structures.
- (if preface
- (progn
- ;; FIXME: We don't handle uninterned names correctly.
- ;; E.g. if cl-define-compiler-macro uses uninterned name we
get:
- ;; (defalias '#1=#:foo--cmacro #[514 ...])
- ;; (put 'foo 'compiler-macro '#:foo--cmacro)
- (insert preface)
- (prin1 name byte-compile--outbuffer)))
- (insert (car info))
- (prin1 (car form) byte-compile--outbuffer)
- (while (setq form (cdr form))
- (setq index (1+ index))
- (insert " ")
- (cond ((and (numberp specindex) (= index specindex)
- ;; Don't handle the definition dynamically
- ;; if it refers (or might refer)
- ;; to objects already output
- ;; (for instance, gensyms in the arg list).
- (let (non-nil)
- (when (hash-table-p print-number-table)
- (maphash (lambda (_k v) (if v (setq non-nil t)))
- print-number-table))
- (not non-nil)))
- ;; Output the byte code and constants specially
- ;; for lazy dynamic loading.
- (let ((position
- (byte-compile-output-as-comment
- (cons (car form) (nth 1 form))
- t)))
- (princ (format "(#$ . %d) nil" position)
- byte-compile--outbuffer)
- (setq form (cdr form))
- (setq index (1+ index))))
- ((= index (nth 1 info))
- (if position
- (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
- position)
- byte-compile--outbuffer)
- (let ((print-escape-newlines nil))
- (goto-char (prog1 (1+ (point))
- (prin1 (car form)
- byte-compile--outbuffer)))
- (insert "\\\n")
- (goto-char (point-max)))))
- (t
- (prin1 (car form) byte-compile--outbuffer)))))
- (insert (nth 2 info)))))
- nil)
+ (let ((position (point))
+ (print-continuous-numbering t)
+ print-number-table
+ ;; FIXME: The bindings below are only needed for when we're
+ ;; called from ...-defmumble.
+ (print-escape-newlines t)
+ (print-length nil)
+ (print-level nil)
+ (print-quoted t)
+ (print-gensym t)
+ (print-circle t)) ; Handle circular data structures.
+ (when preface
+ ;; FIXME: We don't handle uninterned names correctly.
+ ;; E.g. if cl-define-compiler-macro uses uninterned name we get:
+ ;; (defalias '#1=#:foo--cmacro #[514 ...])
+ ;; (put 'foo 'compiler-macro '#:foo--cmacro)
+ (insert preface)
+ (prin1 name byte-compile--outbuffer))
+ (byte-compile--output-docform-recurse
+ info position form cvecindex docindex specindex quoted)
+ (when tailpiece
+ (insert tailpiece))))))
(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
@@ -2899,60 +2950,58 @@ not to take responsibility for the actual compilation
of the code."
;; Otherwise, we have a bona-fide defun/defmacro definition, and use
;; special code to allow dynamic docstrings and byte-code.
(byte-compile-flush-pending)
- (let ((index
- ;; If there's no doc string, provide -1 as the "doc string
- ;; index" so that no element will be treated as a doc string.
- (if (not (stringp (documentation code t))) -1 4)))
- (when byte-native-compiling
- ;; Spill output for the native compiler here.
- (push
- (if macro
- (make-byte-to-native-top-level
- :form `(defalias ',name '(macro . ,code) nil)
- :lexical lexical-binding)
- (make-byte-to-native-func-def :name name
- :byte-func code))
- byte-to-native-top-level-forms))
- ;; Output the form by hand, that's much simpler than having
- ;; b-c-output-file-form analyze the defalias.
- (byte-compile-output-docform
- "\n(defalias '"
- bare-name
- (if macro `(" '(macro . #[" ,index "])") `(" #[" ,index "]"))
- (append code nil) ; Turn byte-code-function-p into list.
- (and (atom code) byte-compile-dynamic
- 1)
- nil))
- (princ ")" byte-compile--outbuffer)
+ (when byte-native-compiling
+ ;; Spill output for the native compiler here.
+ (push
+ (if macro
+ (make-byte-to-native-top-level
+ :form `(defalias ',name '(macro . ,code) nil)
+ :lexical lexical-binding)
+ (make-byte-to-native-func-def :name name
+ :byte-func code))
+ byte-to-native-top-level-forms))
+ ;; Output the form by hand, that's much simpler than having
+ ;; b-c-output-file-form analyze the defalias.
+ (byte-compile-output-docform
+ "\n(defalias '" ")"
+ bare-name
+ (if macro '(" '(macro . #[" "])") '(" #[" "]"))
+ (append code nil) ; Turn byte-code-function-p into list.
+ 2 4
+ (and (atom code) byte-compile-dynamic 1)
+ nil)
t)))))
(defun byte-compile-output-as-comment (exp quoted)
- "Print Lisp object EXP in the output file, inside a comment.
-Return the file (byte) position it will have.
-If QUOTED is non-nil, print with quoting; otherwise, print without quoting."
+ "Print Lisp object EXP in the output file at point, inside a comment.
+Return the file (byte) position it will have. Leave point after
+the inserted text. If QUOTED is non-nil, print with quoting;
+otherwise, print without quoting."
(with-current-buffer byte-compile--outbuffer
- (let ((position (point)))
-
+ (let ((position (point)) end)
;; Insert EXP, and make it a comment with #@LENGTH.
(insert " ")
(if quoted
(prin1 exp byte-compile--outbuffer)
(princ exp byte-compile--outbuffer))
+ (setq end (point-marker))
+ (set-marker-insertion-type end t)
+
(goto-char position)
;; Quote certain special characters as needed.
;; get_doc_string in doc.c does the unquoting.
- (while (search-forward "\^A" nil t)
+ (while (search-forward "\^A" end t)
(replace-match "\^A\^A" t t))
(goto-char position)
- (while (search-forward "\000" nil t)
+ (while (search-forward "\000" end t)
(replace-match "\^A0" t t))
(goto-char position)
- (while (search-forward "\037" nil t)
+ (while (search-forward "\037" end t)
(replace-match "\^A_" t t))
- (goto-char (point-max))
+ (goto-char end)
(insert "\037")
(goto-char position)
- (insert "#@" (format "%d" (- (position-bytes (point-max))
+ (insert "#@" (format "%d" (- (position-bytes end)
(position-bytes position))))
;; Save the file position of the object.
@@ -2961,7 +3010,8 @@ If QUOTED is non-nil, print with quoting; otherwise,
print without quoting."
;; position to a file position.
(prog1
(- (position-bytes (point)) (point-min) -1)
- (goto-char (point-max))))))
+ (goto-char end)
+ (set-marker end nil)))))
(defun byte-compile--reify-function (fun)
"Return an expression which will evaluate to a function value FUN.
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 3e75020a013..e65c39e3998 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -615,11 +615,15 @@ places where they originally did not directly appear."
(cconv-convert exp env extend))
(`(,func . ,forms)
- ;; First element is function or whatever function-like forms are: or, and,
- ;; if, catch, progn, prog1, while, until
- `(,func . ,(mapcar (lambda (form)
- (cconv-convert form env extend))
- forms)))
+ (if (symbolp func)
+ ;; First element is function or whatever function-like forms are:
+ ;; or, and, if, catch, progn, prog1, while, until
+ `(,func . ,(mapcar (lambda (form)
+ (cconv-convert form env extend))
+ forms))
+ (macroexp--warn-wrap form (format-message "Malformed function `%S'"
+ (car form))
+ nil nil)))
(_ (or (cdr (assq form env)) form))))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 56eb83e6f75..0ef0d1e192a 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1379,6 +1379,7 @@ See the full list and their hierarchy in
`cl--typeof-types'."
(cl--generic-prefill-dispatchers 0 integer)
(cl--generic-prefill-dispatchers 1 integer)
(cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
+(cl--generic-prefill-dispatchers 0 (eql 'x) integer)
;;; Dispatch on major mode.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index a394156c93a..37c5ebdb6da 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -951,7 +951,10 @@ not nil."
(let ((slots (eieio--class-slots (eieio--object-class obj))))
(dotimes (i (length slots))
(let* ((name (cl--slot-descriptor-name (aref slots i)))
- (df (eieio-oref-default obj name)))
+ ;; If the `:initform` signals an error, just skip it,
+ ;; since the error is intended to be signal'ed from
+ ;; `initialize-instance` rather than at the time of `defclass`.
+ (df (ignore-errors (eieio-oref-default obj name))))
(if (or df set-all)
(eieio-oset obj name df))))))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 39a5fd5b19c..8224606ec57 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -213,9 +213,8 @@ and reference them using the function `class-option'."
,(internal--format-docstring-line
"Retrieve the slot `%S' from an object of class `%S'."
sname name)
- ;; FIXME: Why is this different from the :reader case?
- (if (slot-boundp this ',sname) (eieio-oref this ',sname)))
- accessors)
+ (slot-value this ',sname))
+ accessors)
(when (and eieio-backward-compatibility (eq alloc :class))
;; FIXME: How could I declare this *method* as obsolete.
(push `(cl-defmethod ,acces ((this (subclass ,name)))
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index d7b9b131bc8..04bea4723a2 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -48,6 +48,7 @@ Standard prefixes won't be registered anyway. I.e. if a file
\"foo.el\" defines variables or functions that use \"foo-\" as
prefix, that will not be registered. But all other prefixes will
be included.")
+;;;###autoload
(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)
(defvar no-update-autoloads nil
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index b09777be407..4f95fc91dd8 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -137,8 +137,6 @@ DOC should be a doc string, and ARGS are keywords as
applicable to
(declare-function sqlite-select "sqlite.c")
(declare-function sqlite-open "sqlite.c")
(declare-function sqlite-pragma "sqlite.c")
-(declare-function sqlite-transaction "sqlite.c")
-(declare-function sqlite-commit "sqlite.c")
(defvar multisession--db nil)
diff --git a/lisp/emacs-lisp/shorthands.el b/lisp/emacs-lisp/shorthands.el
index 82200ab88e9..b0665a55695 100644
--- a/lisp/emacs-lisp/shorthands.el
+++ b/lisp/emacs-lisp/shorthands.el
@@ -53,11 +53,16 @@
:group 'font-lock-faces)
(defun shorthands--mismatch-from-end (str1 str2)
+ "Tell index of first mismatch in STR1 and STR2, from end.
+The index is a valid 0-based index on STR1. Returns nil if STR1
+equals STR2. Return 0 if STR1 is a suffix of STR2."
(cl-loop with l1 = (length str1) with l2 = (length str2)
for i from 1
for i1 = (- l1 i) for i2 = (- l2 i)
- while (and (>= i1 0) (>= i2 0) (eq (aref str1 i1) (aref str2 i2)))
- finally (return (1- i))))
+ while (eq (aref str1 i1) (aref str2 i2))
+ if (zerop i2) return (if (zerop i1) nil i1)
+ if (zerop i1) return 0
+ finally (return i1)))
(defun shorthands-font-lock-shorthands (limit)
(when read-symbol-shorthands
@@ -69,10 +74,16 @@
font-lock-string-face)))
(intern-soft (match-string 1))))
(sname (and probe (symbol-name probe)))
- (mm (and sname (shorthands--mismatch-from-end
- (match-string 1) sname))))
- (unless (or (null mm) (= mm (length sname)))
- (add-face-text-property (match-beginning 1) (1+ (- (match-end 1) mm))
+ (mismatch (and sname (shorthands--mismatch-from-end
+ (match-string 1) sname)))
+ (guess (and mismatch (1+ mismatch))))
+ (when guess
+ (when (and (< guess (1- (length (match-string 1))))
+ ;; In bug#67390 we allow other separators
+ (eq (char-syntax (aref (match-string 1) guess)) ?_))
+ (setq guess (1+ guess)))
+ (add-face-text-property (match-beginning 1)
+ (+ (match-beginning 1) guess)
'elisp-shorthand-font-lock-face))))))
(font-lock-add-keywords 'emacs-lisp-mode '((shorthands-font-lock-shorthands))
t)
diff --git a/lisp/epg.el b/lisp/epg.el
index aae9b9444b4..b994c1b9ca2 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -595,7 +595,12 @@ callback data (if any)."
(if (epg-context-textmode context) '("--textmode"))
(if (epg-context-output-file context)
(list "--output" (epg-context-output-file context)))
- (if (epg-context-pinentry-mode context)
+ (if (and (epg-context-pinentry-mode context)
+ (not
+ ;; loopback doesn't work with gpgsm
+ (and (eq (epg-context-protocol context) 'CMS)
+ (eq (epg-context-pinentry-mode context)
+ 'loopback))))
(list "--pinentry-mode"
(symbol-name (epg-context-pinentry-mode
context))))
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index 83f60fd3162..82e881cb71c 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -91,7 +91,8 @@ enables when this option is `erc-fill-wrap' or when the module
an initial \"prefix\" width and `erc-fill-wrap-margin-width'
instead of `erc-fill-column' for influencing initial message
width. For adjusting these during a session, see the commands
-`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'."
+`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'. Read
+more about this style in the doc string for `erc-fill-wrap-mode'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
(const :tag "Dynamic word-wrap" erc-fill-wrap)
@@ -267,6 +268,14 @@ terminals."
:package-version '(ERC . "5.6")
:type 'boolean)
+(defface erc-fill-wrap-merge-indicator-face
+ '((((min-colors 88) (background light)) :foreground "Gray")
+ (((min-colors 16) (background light)) :foreground "LightGray")
+ (((min-colors 16) (background dark)) :foreground "DimGray")
+ (t :inherit shadow))
+ "ERC `fill-wrap' merge-indicator face."
+ :group 'erc-faces)
+
(defcustom erc-fill-wrap-merge-indicator nil
"Indicator to help distinguish between merged messages.
Only matters when the option `erc-fill-wrap-merge' is enabled.
@@ -277,21 +286,33 @@ previous message. (Note that the latter variant
nullifies any
intervening padding supplied by `erc-fill-line-spacing' and is
meant to supplant that option in text terminals.) In either
case, the second element should be a character, like ?>, and the
-last element a valid face. When in doubt, try the first prefab
-choice, (pre #xb7 shadow), which replaces a continued speaker's
-name with a nondescript dot-product-like glyph in `shadow' face.
-This option is currently experimental, and changing its value
-mid-session is not supported."
+last element a valid face. In special cases, you may also
+specify a cons of `pre'/`post' and a string, which tells ERC you
+know what you're doing and not to manage the process for you. If
+unsure, try either of the first two presets, both of which
+replace a continued speaker's name with a dot-product-like glyph
+in `shadow' face. Note that this option is still experimental,
+and changing its value mid-session is not yet supported (though,
+if you must, make sure to run \\[erc-fill-wrap-refill-buffer]
+afterward)."
:package-version '(ERC . "5.6")
- :type '(choice (const nil)
- (const :tag "Leading MIDDLE DOT as speaker (U+00B7)"
- (pre #xb7 shadow))
- (const :tag "Trailing PARAGRAPH SIGN (U+00B6)"
- (post #xb6 shadow))
- (const :tag "Leading > as speaker" (pre ?> shadow))
- (const :tag "Trailing ~" (post ?~ shadow))
- (list :tag "User-provided"
- (choice (const pre) (const post)) character face)))
+ :type
+ '(choice (const nil)
+ (const :tag "Leading MIDDLE DOT (U+00B7) as speaker"
+ (pre #xb7 erc-fill-wrap-merge-indicator-face))
+ (const :tag "Leading MIDDLE DOT (U+00B7) sans gap"
+ (pre . #("\u00b7" 0 1 (font-lock-face
+ erc-fill-wrap-merge-indicator-face))))
+ (const :tag "Leading RIGHT-ANGLE BRACKET (>) as speaker"
+ (pre ?> erc-fill-wrap-merge-indicator-face))
+ (const :tag "Trailing PARAGRAPH SIGN (U+00B6)"
+ (post #xb6 erc-fill-wrap-merge-indicator-face))
+ (const :tag "Trailing TILDE (~)"
+ (post ?~ erc-fill-wrap-merge-indicator-face))
+ (cons :tag "User-provided string (advanced)"
+ (choice (const pre) (const post)) string)
+ (list :tag "User-provided character-face pairing"
+ (choice (const pre) (const post)) character face)))
(defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args)
(apply (pcase erc-fill--wrap-visual-keys
@@ -439,7 +460,9 @@ And it \"wraps\" messages at a common margin width, as
determined
by the option `erc-fill-wrap-margin-width'. To use it, either
include `fill-wrap' in `erc-modules' or set `erc-fill-function'
to `erc-fill-wrap'. Most users will want to enable the
-`scrolltobottom' module as well. Once active, use
+`scrolltobottom' module as well.
+
+During sessions in which this module is active, use
\\[erc-fill-wrap-nudge] to adjust the width of the indent and the
stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for
cycling between logical- and screen-line oriented command
@@ -447,7 +470,11 @@ movement. Similarly, use \\[erc-fill-wrap-refill-buffer]
to fix
alignment problems after running certain commands, like
`text-scale-adjust'. Also see related stylistic options
`erc-fill-line-spacing', `erc-fill-wrap-merge', and
-`erc-fill-wrap-merge-indicator'.
+`erc-fill-wrap-merge-indicator'. Hint: in narrow windows, where
+is space tight, try setting `erc-fill-static-center' to 1. And
+if you also use the option `erc-fill-wrap-merge-indicator', set
+that to value-menu item \"Leading MIDDLE DOT (U+00B7) sans gap\"
+or one of the various \"trailing\" items.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
@@ -600,29 +627,34 @@ to be disabled."
(save-restriction
(widen)
(cl-assert (= ?\n (char-before (point))))
- (unless erc-fill--wrap-merge-indicator-pre
- (let ((option erc-fill-wrap-merge-indicator))
- (setq erc-fill--wrap-merge-indicator-pre
- (propertize (concat (string (nth 1 option)) "\n")
- 'font-lock-face (nth 2 option)))))
+ (unless erc-fill--wrap-merge-indicator-post
+ (let ((option (cdr erc-fill-wrap-merge-indicator)))
+ (setq erc-fill--wrap-merge-indicator-post
+ (if (stringp option)
+ (concat option
+ (and (not (string-suffix-p "\n" option)) "\n"))
+ (propertize (concat (string (car option)) "\n")
+ 'font-lock-face (cadr option))))))
(unless (eq (field-at-pos (- (point) 2)) 'erc-timestamp)
(put-text-property (1- (point)) (point)
- 'display erc-fill--wrap-merge-indicator-pre)))
+ 'display erc-fill--wrap-merge-indicator-post)))
0))
(defun erc-fill--wrap-insert-merged-pre ()
"Add `display' property in lieu of speaker."
- (if erc-fill--wrap-merge-indicator-post
+ (if erc-fill--wrap-merge-indicator-pre
(progn
(put-text-property (point-min) (point) 'display
- (car erc-fill--wrap-merge-indicator-post))
- (cdr erc-fill--wrap-merge-indicator-post))
- (let* ((option erc-fill-wrap-merge-indicator)
- (s (concat (propertize (string (nth 1 option))
- 'font-lock-face (nth 2 option))
- " ")))
+ (car erc-fill--wrap-merge-indicator-pre))
+ (cdr erc-fill--wrap-merge-indicator-pre))
+ (let* ((option (cdr erc-fill-wrap-merge-indicator))
+ (s (if (stringp option)
+ (concat option)
+ (concat (propertize (string (car option))
+ 'font-lock-face (cadr option))
+ " "))))
(put-text-property (point-min) (point) 'display s)
- (cdr (setq erc-fill--wrap-merge-indicator-post
+ (cdr (setq erc-fill--wrap-merge-indicator-pre
(cons s (erc-fill--wrap-measure (point-min) (point))))))))
(defun erc-fill-wrap ()
@@ -698,6 +730,8 @@ case this module's insert hooks run by way of the process
filter.
With REPAIRP, destructively fill gaps and re-merge speakers."
(goto-char start)
(cl-assert (null erc-fill--wrap-rejigger-last-message))
+ (setq erc-fill--wrap-merge-indicator-pre nil
+ erc-fill--wrap-merge-indicator-post nil)
(let (erc-fill--wrap-rejigger-last-message)
(while-let
(((< (point) finish))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index a2f4562d333..616129bf780 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -2394,7 +2394,9 @@ nil."
(set-marker-insertion-type erc-insert-marker t)
(cl-assert (= (field-end erc-insert-marker) erc-input-marker))
(goto-char old-point)
- (erc--unhide-prompt))
+ (let ((erc--hidden-prompt-overlay
+ (alist-get 'erc--hidden-prompt-overlay continued-session)))
+ (erc--unhide-prompt)))
(cl-assert (not (get-text-property (point) 'erc-prompt)))
;; In the original version from `erc-open', the snippet that
;; handled these newline insertions appeared twice close in
diff --git a/lisp/faces.el b/lisp/faces.el
index 7eacc40443a..8eaabbffc0e 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -2440,7 +2440,10 @@ If you set `term-file-prefix' to nil, this function does
nothing."
'((((supports :slant italic))
:slant italic)
(((supports :underline t))
- :underline t)
+ ;; Include italic, even if it isn't supported by the default
+ ;; font, because this face could be merged with another face
+ ;; which uses font that does have an italic variant.
+ :underline t :slant italic)
(t
;; Default to italic, even if it doesn't appear to be supported,
;; because in some cases the display engine will do its own
@@ -2457,7 +2460,9 @@ If you set `term-file-prefix' to nil, this function does
nothing."
(defface underline
'((((supports :underline t))
:underline t)
- (((supports :weight bold))
+ ;; Include underline, for when this face is merged with another
+ ;; whose font does support underline.
+ (((supports :weight bold :underline t))
:weight bold)
(t :underline t))
"Basic underlined face."
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 01e6a8f317f..9a1a6f9b27d 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -1745,45 +1745,43 @@ already. If INFO-UNCHANGED is non-nil, dribble buffer
is not updated."
gnus-level-killed))
(defun gnus-group-search-forward (&optional backward all level first-too)
- "Find the next newsgroup with unread articles.
-If BACKWARD is non-nil, find the previous newsgroup instead.
-If ALL is non-nil, just find any newsgroup.
-If LEVEL is non-nil, find group with level LEVEL, or higher if no such
-group exists.
-If FIRST-TOO, the current line is also eligible as a target."
+ "Move point to the next newsgroup with unread articles.
+If BACKWARD is non-nil, move to the previous newsgroup instead.
+If ALL is non-nil, consider any newsgroup, not only those with
+unread articles. If LEVEL is non-nil, find group with level
+LEVEL, or higher if no such group exists. If FIRST-TOO, the
+current line is also eligible as a target."
(let ((way (if backward -1 1))
(low gnus-level-killed)
(beg (point))
pos found lev)
- (if (and backward (progn (beginning-of-line)) (bobp))
- nil
- (unless first-too
- (forward-line way))
- (while (and
- (not (eobp))
- (not (setq
- found
- (and
- (get-text-property (point) 'gnus-group)
- (or all
- (and
- (let ((unread
- (get-text-property (point) 'gnus-unread)))
- (and (numberp unread) (> unread 0)))
- (setq lev (get-text-property (point)
- 'gnus-level))
- (<= lev gnus-level-subscribed)))
- (or (not level)
- (and (setq lev (get-text-property (point)
- 'gnus-level))
- (or (= lev level)
- (and (< lev low)
- (< level lev)
- (progn
- (setq low lev)
- (setq pos (point))
- nil))))))))
- (zerop (forward-line way)))))
+ (unless first-too
+ (forward-line way))
+ (while (and
+ (not (if backward (bobp) (eobp)))
+ (not (setq
+ found
+ (and
+ (get-text-property (point) 'gnus-group)
+ (or all
+ (and
+ (let ((unread
+ (get-text-property (point) 'gnus-unread)))
+ (and (numberp unread) (> unread 0)))
+ (setq lev (get-text-property (point)
+ 'gnus-level))
+ (<= lev gnus-level-subscribed)))
+ (or (not level)
+ (and (setq lev (get-text-property (point)
+ 'gnus-level))
+ (or (= lev level)
+ (and (< lev low)
+ (< level lev)
+ (progn
+ (setq low lev)
+ (setq pos (point))
+ nil))))))))
+ (zerop (forward-line way))))
(if found
(progn (gnus-group-position-point) t)
(goto-char (or pos beg))
diff --git a/lisp/indent.el b/lisp/indent.el
index 89de0a1d7d1..f856f0c9ab5 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -170,8 +170,7 @@ prefix argument is ignored."
(t
(let ((old-tick (buffer-chars-modified-tick))
(old-point (point))
- (old-indent (current-indentation))
- (syn (syntax-after (point))))
+ (old-indent (current-indentation)))
;; Indent the line.
(or (not (eq (indent--funcall-widened indent-line-function) 'noindent))
@@ -185,19 +184,14 @@ prefix argument is ignored."
((and (eq tab-always-indent 'complete)
(eql old-point (point))
(eql old-tick (buffer-chars-modified-tick))
- (or (null tab-first-completion)
- (eq last-command this-command)
- (and (eq tab-first-completion 'eol)
- (eolp))
- (and (memq tab-first-completion
- '(word word-or-paren word-or-paren-or-punct))
- (not (eql 2 syn)))
- (and (memq tab-first-completion
- '(word-or-paren word-or-paren-or-punct))
- (not (or (eql 4 syn)
- (eql 5 syn))))
- (and (eq tab-first-completion 'word-or-paren-or-punct)
- (not (eql 1 syn)))))
+ (or (eq last-command this-command)
+ (let ((syn (syntax-class (syntax-after (point)))))
+ (pcase tab-first-completion
+ ('nil t)
+ ('eol (eolp))
+ ('word (not (eql 2 syn)))
+ ('word-or-paren (not (memq syn '(2 4 5))))
+ ('word-or-paren-or-punct (not (memq syn '(2 4 5 1))))))))
(completion-at-point))
;; If a prefix argument was given, rigidly indent the following
diff --git a/lisp/info.el b/lisp/info.el
index 463aea93376..51e9eb72edf 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -1787,11 +1787,24 @@ By default, go to the current Info node."
(interactive (list (Info-read-node-name
"Go to node (default current page): " Info-current-node))
Info-mode)
- (browse-url-button-open-url
- (Info-url-for-node (format "(%s)%s" (file-name-sans-extension
- (file-name-nondirectory
- Info-current-file))
- node))))
+ (let (filename)
+ (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
+ node)
+ (setq filename (if (= (match-beginning 1) (match-end 1))
+ ""
+ (match-string 2 node))
+ node (match-string 3 node))
+ (let ((trim (string-match "\\s +\\'" filename)))
+ (if trim (setq filename (substring filename 0 trim))))
+ (let ((trim (string-match "\\s +\\'" node)))
+ (if trim (setq node (substring node 0 trim))))
+ (if (equal filename "")
+ (setq filename (file-name-sans-extension (file-name-nondirectory
+ Info-current-file))))
+ (if (equal node "")
+ (setq node "Top"))
+ (browse-url-button-open-url
+ (Info-url-for-node (format "(%s)%s" filename node)))))
(defun Info-url-for-node (node)
"Return a URL for NODE, a node in the GNU Emacs or Elisp manual.
@@ -1817,8 +1830,10 @@ and elisp manuals are supported."
""))
(concat "https://www.gnu.org/software/emacs/manual/html_node/";
manual "/"
- (url-hexify-string (string-replace " " "-" node))
- ".html")))
+ (and (not (equal node "Top"))
+ (concat
+ (url-hexify-string (string-replace " " "-" node))
+ ".html")))))
(defvar Info-read-node-completion-table)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 52ffb220d8b..849a8d8eaee 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.17
+;; Version: 1.0.18
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -64,6 +64,7 @@
:initarg :notification-dispatcher
:documentation "Dispatcher for remotely invoked notifications.")
(last-error
+ :initform nil
:accessor jsonrpc-last-error
:documentation "Last JSONRPC error message received from endpoint.")
(-request-continuations
@@ -71,6 +72,7 @@
:accessor jsonrpc--request-continuations
:documentation "A hash table of request ID to continuation lambdas.")
(-events-buffer
+ :initform nil
:accessor jsonrpc--events-buffer
:documentation "A buffer pretty-printing the JSONRPC events")
(-events-buffer-scrollback-size
@@ -286,6 +288,7 @@ CANCEL-ON-INPUT-RETVAL. Any future replies (normal or
error) are
ignored."
(let* ((tag (cl-gensym "jsonrpc-request-catch-tag")) id-and-timer
canceled
+ (throw-on-input nil)
(retval
(unwind-protect
(catch tag
@@ -353,6 +356,7 @@ ignored."
:initarg :process :accessor jsonrpc--process
:documentation "Process object wrapped by the this connection.")
(-expected-bytes
+ :initform nil
:accessor jsonrpc--expected-bytes
:documentation "How many bytes declared by server.")
(-on-shutdown
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 8306bd3b30c..b5dd5322ec1 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -269,7 +269,6 @@ The default value matches citations like `foo-bar>' plus
whitespace."
(defvar mail-abbrevs-loaded nil)
(defvar mail-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\M-\t" 'completion-at-point)
(define-key map "\C-c?" 'describe-mode)
(define-key map "\C-c\C-f\C-t" 'mail-to)
(define-key map "\C-c\C-f\C-b" 'mail-bcc)
diff --git a/lisp/man.el b/lisp/man.el
index f18e2f50b7c..3efa29d7aad 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -1191,8 +1191,8 @@ Return the buffer in which the manpage will appear."
(man-args topic)
(bufname
(if (file-remote-p default-directory)
- (format "*Man %s %s *" (file-remote-p default-directory)
man-args)
- (format "*Man %s *" man-args)))
+ (format "*Man %s %s*" (file-remote-p default-directory) man-args)
+ (format "*Man %s*" man-args)))
(buffer (get-buffer bufname)))
(if buffer
(Man-notify-when-ready buffer)
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index fff860b05c3..f17b7388844 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -686,7 +686,9 @@ operation. One of the following keywords is returned:
`:non-existent': Service name does not exist on this bus.
`:not-owner': We are neither the primary owner nor waiting in the
-queue of this service."
+queue of this service.
+
+When SERVICE is not a known name but a unique name, the function returns nil."
(maphash
(lambda (key value)
@@ -698,14 +700,17 @@ queue of this service."
(puthash key (delete elt value) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table)))))))
dbus-registered-objects-table)
- (let ((reply (dbus-call-method
- bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
- "ReleaseName" service)))
- (pcase reply
- (1 :released)
- (2 :non-existent)
- (3 :not-owner)
- (_ (signal 'dbus-error (list "Could not unregister service" service))))))
+
+ (unless (string-prefix-p ":" service)
+ (let ((reply (dbus-call-method
+ bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
+ "ReleaseName" service)))
+ (pcase reply
+ (1 :released)
+ (2 :non-existent)
+ (3 :not-owner)
+ (_ (signal
+ 'dbus-error (list "Could not unregister service" service)))))))
(defun dbus-register-signal
(bus service path interface signal handler &rest args)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index d8a66b2ce32..77bb6be2904 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -657,6 +657,8 @@ The renaming scheme is performed in accordance with
(setq eww-history-position 0)
(and last-coding-system-used
(set-buffer-file-coding-system last-coding-system-used))
+ (unless shr-fill-text
+ (visual-line-mode))
(run-hooks 'eww-after-render-hook)
;; Enable undo again so that undo works in text input
;; boxes.
@@ -1217,6 +1219,8 @@ the like."
(setq-local shr-url-transformer #'eww--transform-url)
;; Also rescale images when rescaling the text.
(add-hook 'text-scale-mode-hook #'eww--rescale-images nil t)
+ (setq-local outline-search-function 'shr-outline-search
+ outline-level 'shr-outline-level)
(setq buffer-read-only t))
(defvar text-scale-mode)
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 645e1cc51e5..9f030b4c743 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -163,6 +163,48 @@ the specpdl size. If nil, just give up."
:version "28.1"
:type 'boolean)
+(defcustom shr-fill-text t
+ "Non-nil means to fill the text according to the width of the window.
+If nil, text is not filled, and `visual-line-mode' can be used to reflow text."
+ :version "30.1"
+ :type 'boolean)
+
+
+(defcustom shr-sup-raise-factor 0.2
+ "The value of raise property for superscripts.
+Should be a non-negative float number between 0 and 1."
+ :version "30.1"
+ :type 'float)
+
+(defcustom shr-sub-raise-factor -0.2
+ "The value of raise property for subscripts.
+Should be a non-positive float number between 0 and 1."
+ :version "30.1"
+ :type 'float)
+
+(defcustom shr-image-ascent 100
+ "The value to be used for :ascent property when inserting images."
+ :version "30.1"
+ :type 'integer)
+
+(defcustom shr-max-inline-image-size nil
+ "If non-nil, determines when the images can be displayed inline.
+If nil, images are never displayed inline.
+
+It non-nil, it should be cons (WIDTH . HEIGHT).
+
+WIDTH can be an integer which is interpreted as number of pixels. If the width
+of an image exceeds this amount, the image is displayed on a separate line.
+WIDTH can also be floating point number, in which case the image is displayed
+inline if it occupies less than this fraction of window width.
+
+HEIGHT can be also be an integer or a floating point number. If it is an
+integer and the pixel height of an image exceeds it, the image image is
+displyed on a separate line. If it is a float number , the limit is
+interpreted as a multiple of the height of default font."
+ :version "30.1"
+ :type '(choice (const nil) (cons number number)))
+
(defvar shr-content-function nil
"If bound, this should be a function that will return the content.
This is used for cid: URLs, and the function is called with the
@@ -697,7 +739,8 @@ size, and full-buffer size."
(replace-match " " t t)))
(defun shr-insert (text)
- (when (and (not (bolp))
+ (when (and (not shr-max-inline-image-size)
+ (not (bolp))
(get-text-property (1- (point)) 'image-url))
(insert "\n"))
(cond
@@ -741,7 +784,7 @@ size, and full-buffer size."
(or shr-current-font 'shr-text)))))))))
(defun shr-fill-lines (start end)
- (if (<= shr-internal-width 0)
+ (if (or (not shr-fill-text) (<= shr-internal-width 0))
nil
(save-restriction
(narrow-to-region start end)
@@ -1049,6 +1092,19 @@ the mouse click event."
(declare-function image-size "image.c" (spec &optional pixels frame))
(declare-function image-animate "image" (image &optional index limit position))
+(defun shr--inline-image-p (image)
+ "Return non-nil if IMAGE should be displayed inline."
+ (when shr-max-inline-image-size
+ (let ((size (image-size image t))
+ (max-width (car shr-max-inline-image-size))
+ (max-height (cdr shr-max-inline-image-size)))
+ (unless (integerp max-width)
+ (setq max-width (* max-width (window-width nil t))))
+ (unless (integerp max-height)
+ (setq max-height (* max-height (frame-char-height))))
+ (and (< (car size) max-width)
+ (< (cdr size) max-height)))))
+
(defun shr-put-image (spec alt &optional flags)
"Insert image SPEC with a string ALT. Return image.
SPEC is either an image data blob, or a list where the first
@@ -1063,11 +1119,11 @@ element is the data blob and the second element is the
content-type."
(start (point))
(image (cond
((eq size 'original)
- (create-image data nil t :ascent 100
+ (create-image data nil t :ascent shr-image-ascent
:format content-type))
((eq content-type 'image/svg+xml)
(when (image-type-available-p 'svg)
- (create-image data 'svg t :ascent 100)))
+ (create-image data 'svg t :ascent shr-image-ascent)))
((eq size 'full)
(ignore-errors
(shr-rescale-image data content-type
@@ -1079,19 +1135,25 @@ element is the data blob and the second element is the
content-type."
(plist-get flags :width)
(plist-get flags :height)))))))
(when image
+ ;; The trailing space can confuse shr-insert into not
+ ;; putting any space after inline images.
+ (setq alt (string-trim alt))
;; When inserting big-ish pictures, put them at the
;; beginning of the line.
- (when (and (> (current-column) 0)
- (> (car (image-size image t)) 400))
- (insert "\n"))
- (let ((image-pos (point)))
- (if (eq size 'original)
- (insert-sliced-image image (or alt "*") nil 20 1)
- (insert-image image (or alt "*")))
- (put-text-property start (point) 'image-size size)
- (when (and shr-image-animate
- (cdr (image-multi-frame-p image)))
- (image-animate image nil 60 image-pos))))
+ (let ((inline (shr--inline-image-p image)))
+ (when (and (> (current-column) 0)
+ (not inline))
+ (insert "\n"))
+ (let ((image-pos (point)))
+ (if (eq size 'original)
+ (insert-sliced-image image (or alt "*") nil 20 1)
+ (insert-image image (or alt "*")))
+ (put-text-property start (point) 'image-size size)
+ (when (and (not inline) shr-max-inline-image-size)
+ (insert "\n"))
+ (when (and shr-image-animate
+ (cdr (image-multi-frame-p image)))
+ (image-animate image nil 60 image-pos)))))
image)
(insert (or alt ""))))
@@ -1114,7 +1176,7 @@ The size of the displayed image will not exceed
MAX-WIDTH/MAX-HEIGHT. If not given, use the current window
width/height instead."
(if (not (get-buffer-window (current-buffer) t))
- (create-image data nil t :ascent 100)
+ (create-image data nil t :ascent shr-image-ascent)
(let* ((edges (window-inside-pixel-edges
(get-buffer-window (current-buffer))))
(max-width (truncate (* shr-max-image-proportion
@@ -1135,13 +1197,13 @@ width/height instead."
(< (* height scaling) max-height))
(create-image
data (shr--image-type) t
- :ascent 100
+ :ascent shr-image-ascent
:width width
:height height
:format content-type)
(create-image
data (shr--image-type) t
- :ascent 100
+ :ascent shr-image-ascent
:max-width max-width
:max-height max-height
:format content-type)))))
@@ -1210,7 +1272,11 @@ START, and END. Note that START and END should be
markers."
(defun shr-heading (dom &rest types)
(shr-ensure-paragraph)
- (apply #'shr-fontize-dom dom types)
+ (let ((start (point))
+ (level (string-to-number
+ (string-remove-prefix "shr-h" (symbol-name (car types))))))
+ (apply #'shr-fontize-dom dom types)
+ (put-text-property start (pos-eol) 'outline-level level))
(shr-ensure-paragraph))
(defun shr-urlify (start url &optional title)
@@ -1381,13 +1447,20 @@ ones, in case fg and bg are nil."
(defun shr-tag-sup (dom)
(let ((start (point)))
(shr-generic dom)
- (put-text-property start (point) 'display '(raise 0.2))
+ (put-text-property start (point) 'display `(raise ,shr-sup-raise-factor))
(add-face-text-property start (point) 'shr-sup)))
(defun shr-tag-sub (dom)
+ ;; Why would a subscript be at the beginning of a line? It does
+ ;; happen sometimes because of a <br> tag and the intent seems to be
+ ;; alignment of subscript and superscript but I don't think that is
+ ;; possible in Emacs. So we remove the newline in that case.
+ (when (bolp)
+ (forward-char -1)
+ (delete-char 1))
(let ((start (point)))
(shr-generic dom)
- (put-text-property start (point) 'display '(raise -0.2))
+ (put-text-property start (point) 'display `(raise ,shr-sub-raise-factor))
(add-face-text-property start (point) 'shr-sup)))
(defun shr-tag-p (dom)
@@ -1652,7 +1725,8 @@ The preference is a float determined from
`shr-prefer-media-type'."
(and dom
(or (> (length (dom-attr dom 'src)) 0)
(> (length (dom-attr dom 'srcset)) 0))))
- (when (> (current-column) 0)
+ (when (and (not shr-max-inline-image-size)
+ (> (current-column) 0))
(insert "\n"))
(let ((alt (dom-attr dom 'alt))
(width (shr-string-number (dom-attr dom 'width)))
@@ -1703,8 +1777,14 @@ The preference is a float determined from
`shr-prefer-media-type'."
(when (image-type-available-p 'svg)
(insert-image
(shr-make-placeholder-image dom)
- (or alt "")))
- (insert " ")
+ (or (string-trim alt) "")))
+ ;; Paradoxically this space causes shr not to insert spaces after
+ ;; inline images. Since the image is temporary it seem like there
+ ;; should be no downside to not inserting it but since I don't
+ ;; understand the code well and for the sake of backward compatibility
+ ;; we preserve it unless user has set `shr-max-inline-image-size'.
+ (unless shr-max-inline-image-size
+ (insert " "))
(url-queue-retrieve
url #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
@@ -1840,7 +1920,7 @@ BASE is the URL of the HTML being rendered."
(svg-rectangle svg 0 0 width height :gradient "background"
:stroke-width 2 :stroke-color "black")
(let ((image (svg-image svg :scale 1)))
- (setf (image-property image :ascent) 100)
+ (setf (image-property image :ascent) shr-image-ascent)
image)))
(defun shr-tag-pre (dom)
@@ -2000,6 +2080,41 @@ BASE is the URL of the HTML being rendered."
(shr-generic dom)
(insert ?\N{POP DIRECTIONAL ISOLATE}))
+;;; Outline Support
+(defun shr-outline-search (&optional bound move backward looking-at)
+ "A function that can be used as `outline-search-function' for rendered html.
+See `outline-search-function' for BOUND, MOVE, BACKWARD and LOOKING-AT."
+ (if looking-at
+ (get-text-property (point) 'outline-level)
+ (let ((heading-found nil)
+ (bound (or bound
+ (if backward (point-min) (point-max)))))
+ (save-excursion
+ (when (and (not (bolp))
+ (get-text-property (point) 'outline-level))
+ (forward-line (if backward -1 1)))
+ (if backward
+ (unless (get-text-property (point) 'outline-level)
+ (goto-char (or (previous-single-property-change
+ (point) 'outline-level nil bound)
+ bound)))
+ (goto-char (or (text-property-not-all (point) bound 'outline-level
nil)
+ bound)))
+ (goto-char (pos-bol))
+ (when (get-text-property (point) 'outline-level)
+ (setq heading-found (point))))
+ (if heading-found
+ (progn
+ (set-match-data (list heading-found heading-found))
+ (goto-char heading-found))
+ (when move
+ (goto-char bound)
+ nil)))))
+
+(defun shr-outline-level ()
+ "Function to be used as `outline-level' with `shr-outline-search'."
+ (get-text-property (point) 'outline-level))
+
;;; Table rendering algorithm.
;; Table rendering is the only complicated thing here. We do this by
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index e19b8c78f8c..3baad82dda1 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -552,14 +552,17 @@ host runs a restricted shell, it shall be added to this
list, too."
;;;###tramp-autoload
(defcustom tramp-local-host-regexp
- (rx
- bos
- (| (literal tramp-system-name)
- (| "localhost" "localhost4" "localhost6" "127.0.0.1" "::1"))
- eos)
+ (rx bos
+ (| (literal tramp-system-name)
+ (| "localhost" "127.0.0.1" "::1"
+ ;; Fedora.
+ "localhost4" "localhost6"
+ ;; Ubuntu.
+ "ip6-localhost" "ip6-loopback"))
+ eos)
"Host names which are regarded as local host.
If the local host runs a chrooted environment, set this to nil."
- :version "29.1"
+ :version "30.1"
:type '(choice (const :tag "Chrooted environment" nil)
(regexp :tag "Host regexp")))
@@ -747,8 +750,9 @@ The regexp should match at end of buffer."
;; A security key requires the user physically to touch the device
;; with their finger. We must tell it to the user.
-;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey,
-;; which has also passed the tests, does not show such a message.
+;; Added in OpenSSH 8.2. I've tested it with yubikey. Nitrokey and
+;; Titankey, which have also passed the tests, do not show such a
+;; message.
(defcustom tramp-security-key-confirm-regexp
(rx bol (* "\r") "Confirm user presence for key " (* nonl) (* (any "\r\n")))
"Regular expression matching security key confirmation message.
@@ -6727,7 +6731,14 @@ If PROCESS is a process object which contains the
property
`remote-pid', or PROCESS is a number and REMOTE is a remote file name,
PROCESS is interpreted as process on the respective remote host, which
will be the process to signal.
+If PROCESS is a string, it is interpreted as process object with
+the respective process name, or as a number.
SIGCODE may be an integer, or a symbol whose name is a signal name."
+ (when (stringp process)
+ (setq process (or (get-process process)
+ (and (string-match-p (rx bol (+ digit) eol) process)
+ (string-to-number process))
+ (signal 'wrong-type-argument (list #'processp process)))))
(let (pid vec)
(cond
((processp process)
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 67d136b5a66..bc32598003e 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -390,7 +390,6 @@ reference.")
"C-c C-u" #'nxml-insert-named-char
"C-c C-o" nxml-outline-prefix-map
"/" #'nxml-electric-slash
- "M-TAB" #'completion-at-point
"S-<mouse-2>" #'nxml-mouse-hide-direct-text-content)
(defvar nxml-font-lock-keywords
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index a56ce26fc79..51f60f70131 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -356,11 +356,27 @@ PARENT, BOL, ARGS are the same as other anchor functions."
(apply (alist-get 'standalone-parent treesit-simple-indent-presets)
parent (treesit-node-parent parent) bol args))
+(defun c-ts-mode--prev-line-match (regexp)
+ "An indentation matcher that matches if previous line matches REGEXP."
+ (lambda (_n _p bol &rest _)
+ (save-excursion
+ (goto-char bol)
+ (forward-line -1)
+ (back-to-indentation)
+ (looking-at-p regexp))))
+
(defun c-ts-mode--indent-styles (mode)
"Indent rules supported by `c-ts-mode'.
MODE is either `c' or `cpp'."
(let ((common
`((c-ts-mode--for-each-tail-body-matcher prev-line
c-ts-mode-indent-offset)
+ ;; If the user types "if (...)" and hits RET, they expect
+ ;; point on the empty line to be indented; this rule
+ ;; does that.
+ ((and no-node
+ (c-ts-mode--prev-line-match
+ ,(rx (or "if" "else" "while" "do" "for"))))
+ prev-line c-ts-mode-indent-offset)
((parent-is "translation_unit") column-0 0)
((query "(ERROR (ERROR)) @indent") column-0 0)
@@ -453,6 +469,7 @@ MODE is either `c' or `cpp'."
;; These rules are for cases where the body is bracketless.
;; Tested by the "Bracketless Simple Statement" test.
((parent-is "if_statement") standalone-parent
c-ts-mode-indent-offset)
+ ((parent-is "else_clause") standalone-parent
c-ts-mode-indent-offset)
((parent-is "for_statement") standalone-parent
c-ts-mode-indent-offset)
((parent-is "while_statement") standalone-parent
c-ts-mode-indent-offset)
((parent-is "do_statement") standalone-parent
c-ts-mode-indent-offset)
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 48ea33c3ee1..d410367f902 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -977,15 +977,19 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
:accessor eglot--project-nickname
:reader eglot-project-nickname)
(languages
+ :initform nil
:documentation "Alist ((MODE . LANGUAGE-ID-STRING)...) of managed
languages."
:accessor eglot--languages)
(capabilities
+ :initform nil
:documentation "JSON object containing server capabilities."
:accessor eglot--capabilities)
(server-info
+ :initform nil
:documentation "JSON object containing server info."
:accessor eglot--server-info)
(shutdown-requested
+ :initform nil
:documentation "Flag set when server is shutting down."
:accessor eglot--shutdown-requested)
(project
@@ -1002,6 +1006,7 @@ ACTION is an LSP object of either `CodeAction' or
`Command' type."
:documentation "Map (DIR -> (WATCH ID1 ID2...)) for
`didChangeWatchedFiles'."
:initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
(managed-buffers
+ :initform nil
:documentation "List of buffers managed by server."
:accessor eglot--managed-buffers)
(saved-initargs
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index c687ed9d06b..62429308d96 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -86,17 +86,35 @@
:group 'elixir-ts
:version "30.1")
-(defface elixir-ts-font-comment-doc-identifier-face
+(defface elixir-ts-comment-doc-identifier
'((t (:inherit font-lock-doc-face)))
- "Face used for @comment.doc tags in Elixir files.")
+ "Face used for doc identifiers in Elixir files."
+ :group 'elixir-ts)
-(defface elixir-ts-font-comment-doc-attribute-face
+(defface elixir-ts-comment-doc-attribute
'((t (:inherit font-lock-doc-face)))
- "Face used for @comment.doc.__attribute__ tags in Elixir files.")
+ "Face used for doc attributes in Elixir files."
+ :group 'elixir-ts)
-(defface elixir-ts-font-sigil-name-face
+(defface elixir-ts-sigil-name
'((t (:inherit font-lock-string-face)))
- "Face used for @__name__ tags in Elixir files.")
+ "Face used for sigils in Elixir files."
+ :group 'elixir-ts)
+
+(defface elixir-ts-atom
+ '((t (:inherit font-lock-constant-face)))
+ "Face used for atoms in Elixir files."
+ :group 'elixir-ts)
+
+(defface elixir-ts-keyword-key
+ '((t (:inherit elixir-ts-atom)))
+ "Face used for keyword keys in Elixir files."
+ :group 'elixir-ts)
+
+(defface elixir-ts-attribute
+ '((t (:inherit font-lock-preprocessor-face)))
+ "Face used for attributes in Elixir files."
+ :group 'elixir-ts)
(defconst elixir-ts--sexp-regexp
(rx bol
@@ -114,7 +132,10 @@
"defoverridable" "defp" "defprotocol" "defstruct"))
(defconst elixir-ts--definition-keywords-re
- (concat "^" (regexp-opt elixir-ts--definition-keywords) "$"))
+ (concat "^" (regexp-opt
+ (append elixir-ts--definition-keywords
+ elixir-ts--test-definition-keywords))
+ "$"))
(defconst elixir-ts--kernel-keywords
'("alias" "case" "cond" "else" "for" "if" "import" "quote"
@@ -334,56 +355,73 @@
(treesit-node-start
(treesit-node-parent
(treesit-node-at (point) 'elixir))))
- 0)))))
+ 0)))))
(defvar elixir-ts--font-lock-settings
(treesit-font-lock-rules
:language 'elixir
- :feature 'elixir-comment
- '((comment) @font-lock-comment-face)
-
- :language 'elixir
- :feature 'elixir-string
- :override t
- '([(string) (charlist)] @font-lock-string-face)
-
+ :feature 'elixir-function-name
+ `((call target: (identifier) @target-identifier
+ (arguments (identifier) @font-lock-function-name-face)
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
+ (arguments
+ (call target: (identifier) @font-lock-function-name-face))
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
+ (arguments
+ (binary_operator
+ left: (call target: (identifier) @font-lock-function-name-face)))
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
+ (arguments (identifier) @font-lock-function-name-face)
+ (do_block)
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
+ (arguments
+ (call target: (identifier) @font-lock-function-name-face))
+ (do_block)
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (call target: (identifier) @target-identifier
+ (arguments
+ (binary_operator
+ left: (call target: (identifier) @font-lock-function-name-face)))
+ (do_block)
+ (:match ,elixir-ts--definition-keywords-re @target-identifier))
+ (unary_operator
+ operator: "@"
+ (call (arguments
+ (binary_operator
+ left: (call target: (identifier)
@font-lock-function-name-face))))))
+
+ ;; A function definition like "def _foo" is valid, but we should
+ ;; not apply the comment-face unless its a non-function identifier, so
+ ;; the comment matches has to be after the function matches.
:language 'elixir
- :feature 'elixir-string-interpolation
- :override t
- '((string
- [
- quoted_end: _ @font-lock-string-face
- quoted_start: _ @font-lock-string-face
- (quoted_content) @font-lock-string-face
- (interpolation
- "#{" @font-lock-regexp-grouping-backslash "}"
- @font-lock-regexp-grouping-backslash)
- ])
- (charlist
- [
- quoted_end: _ @font-lock-string-face
- quoted_start: _ @font-lock-string-face
- (quoted_content) @font-lock-string-face
- (interpolation
- "#{" @font-lock-regexp-grouping-backslash "}"
- @font-lock-regexp-grouping-backslash)
- ]))
+ :feature 'elixir-comment
+ '((comment) @font-lock-comment-face
+ ((identifier) @font-lock-comment-face
+ (:match "^_[a-z]\\|^_$" @font-lock-comment-face)))
:language 'elixir
- :feature 'elixir-keyword
- `(,elixir-ts--reserved-keywords-vector
- @font-lock-keyword-face
- (binary_operator
- operator: _ @font-lock-keyword-face
- (:match ,elixir-ts--reserved-keywords-re @font-lock-keyword-face)))
+ :feature 'elixir-variable
+ `((call target: (identifier)
+ (arguments
+ (binary_operator
+ (call target: (identifier)
+ (arguments ((identifier) @font-lock-variable-use-face))))))
+ (call target: (identifier)
+ (arguments
+ (call target: (identifier)
+ (arguments ((identifier)) @font-lock-variable-use-face))))
+ (dot left: (identifier) @font-lock-variable-use-face operator: "." ))
:language 'elixir
:feature 'elixir-doc
- :override t
`((unary_operator
- operator: "@" @elixir-ts-font-comment-doc-attribute-face
+ operator: "@" @elixir-ts-comment-doc-attribute
operand: (call
- target: (identifier)
@elixir-ts-font-comment-doc-identifier-face
+ target: (identifier) @elixir-ts-comment-doc-identifier
;; Arguments can be optional, so adding another
;; entry without arguments.
;; If we don't handle then we don't apply font
@@ -395,109 +433,128 @@
(charlist) @font-lock-doc-face
(sigil) @font-lock-doc-face
(boolean) @font-lock-doc-face
+ (keywords) @font-lock-doc-face
]))
(:match ,elixir-ts--doc-keywords-re
- @elixir-ts-font-comment-doc-identifier-face))
+ @elixir-ts-comment-doc-identifier))
(unary_operator
- operator: "@" @elixir-ts-font-comment-doc-attribute-face
+ operator: "@" @elixir-ts-comment-doc-attribute
operand: (call
- target: (identifier)
@elixir-ts-font-comment-doc-identifier-face)
+ target: (identifier) @elixir-ts-comment-doc-identifier)
(:match ,elixir-ts--doc-keywords-re
- @elixir-ts-font-comment-doc-identifier-face)))
+ @elixir-ts-comment-doc-identifier)))
:language 'elixir
- :feature 'elixir-unary-operator
- `((unary_operator operator: "@" @font-lock-preprocessor-face
- operand: [
- (identifier) @font-lock-preprocessor-face
- (call target: (identifier)
- @font-lock-preprocessor-face)
- (boolean) @font-lock-preprocessor-face
- (nil) @font-lock-preprocessor-face
- ])
+ :feature 'elixir-string
+ '((interpolation
+ "#{" @font-lock-escape-face
+ "}" @font-lock-escape-face)
+ (string (quoted_content) @font-lock-string-face)
+ (quoted_keyword (quoted_content) @font-lock-string-face)
+ (charlist (quoted_content) @font-lock-string-face)
+ ["\"" "'" "\"\"\""] @font-lock-string-face)
- (unary_operator operator: "&") @font-lock-function-name-face
- (operator_identifier) @font-lock-operator-face)
+ :language 'elixir
+ :feature 'elixir-sigil
+ `((sigil
+ (sigil_name) @elixir-ts-sigil-name
+ (quoted_content) @font-lock-string-face
+ ;; HEEx and Surface templates will handled by
+ ;; heex-ts-mode if its available.
+ (:match "^[^HF]$" @elixir-ts-sigil-name))
+ @font-lock-string-face
+ (sigil
+ (sigil_name) @font-lock-regexp-face
+ (:match "^[rR]$" @font-lock-regexp-face))
+ @font-lock-regexp-face
+ (sigil
+ "~" @font-lock-string-face
+ (sigil_name) @font-lock-string-face
+ quoted_start: _ @font-lock-string-face
+ quoted_end: _ @font-lock-string-face))
:language 'elixir
:feature 'elixir-operator
- '((binary_operator operator: _ @font-lock-operator-face)
- (dot operator: _ @font-lock-operator-face)
- (stab_clause operator: _ @font-lock-operator-face)
-
- [(boolean) (nil)] @font-lock-constant-face
- [(integer) (float)] @font-lock-number-face
- (alias) @font-lock-type-face
- (call target: (dot left: (atom) @font-lock-type-face))
- (char) @font-lock-constant-face
- [(atom) (quoted_atom)] @font-lock-type-face
- [(keyword) (quoted_keyword)] @font-lock-builtin-face)
+ `(["!"] @font-lock-negation-char-face
+ ["%"] @font-lock-bracket-face
+ ["," ";"] @font-lock-operator-face
+ ["(" ")" "[" "]" "{" "}" "<<" ">>"] @font-lock-bracket-face)
:language 'elixir
- :feature 'elixir-call
- `((call
- target: (identifier) @font-lock-keyword-face
- (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face))
- (call
- target: (identifier) @font-lock-keyword-face
- (:match ,elixir-ts--kernel-keywords-re @font-lock-keyword-face))
- (call
- target: [(identifier) @font-lock-function-name-face
- (dot right: (identifier) @font-lock-keyword-face)])
+ :feature 'elixir-data-type
+ '([(atom) (alias)] @font-lock-type-face
+ (keywords (pair key: (keyword) @elixir-ts-keyword-key))
+ [(keyword) (quoted_keyword)] @elixir-ts-atom
+ [(boolean) (nil)] @elixir-ts-atom
+ (unary_operator operator: "@" @elixir-ts-attribute
+ operand: [
+ (identifier) @elixir-ts-attribute
+ (call target: (identifier)
+ @elixir-ts-attribute)
+ (boolean) @elixir-ts-attribute
+ (nil) @elixir-ts-attribute
+ ])
+ (operator_identifier) @font-lock-operator-face)
+
+ :language 'elixir
+ :feature 'elixir-keyword
+ `(,elixir-ts--reserved-keywords-vector
+ @font-lock-keyword-face
+ (binary_operator
+ operator: _ @font-lock-keyword-face
+ (:match ,elixir-ts--reserved-keywords-re @font-lock-keyword-face))
+ (binary_operator operator: _ @font-lock-operator-face)
(call
target: (identifier) @font-lock-keyword-face
- (arguments
- [
- (identifier) @font-lock-keyword-face
- (binary_operator
- left: (identifier) @font-lock-keyword-face
- operator: "when")
- ])
(:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face))
(call
target: (identifier) @font-lock-keyword-face
- (arguments
- (binary_operator
- operator: "|>"
- right: (identifier)))
- (:match ,elixir-ts--definition-keywords-re @font-lock-keyword-face)))
+ (:match ,elixir-ts--kernel-keywords-re @font-lock-keyword-face)))
:language 'elixir
- :feature 'elixir-constant
- `((binary_operator operator: "|>" right: (identifier)
- @font-lock-function-name-face)
- ((identifier) @font-lock-keyword-face
- (:match ,elixir-ts--builtin-keywords-re
- @font-lock-keyword-face))
- ((identifier) @font-lock-comment-face
- (:match "^_" @font-lock-comment-face))
- (identifier) @font-lock-function-name-face
- ["%"] @font-lock-keyward-face
- ["," ";"] @font-lock-keyword-face
- ["(" ")" "[" "]" "{" "}" "<<" ">>"] @font-lock-keyword-face)
+ :feature 'elixir-function-call
+ '((call target: (identifier) @font-lock-function-call-face)
+ (unary_operator operator: "&" @font-lock-operator-face
+ operand: (binary_operator
+ left: (identifier)
+ @font-lock-function-call-face
+ operator: "/" right: (integer)))
+ (call
+ target: (dot right: (identifier) @font-lock-function-call-face))
+ (unary_operator operator: "&" @font-lock-variable-name-face
+ operand: (integer) @font-lock-variable-name-face)
+ (unary_operator operator: "&" @font-lock-operator-face
+ operand: (list)))
:language 'elixir
- :feature 'elixir-sigil
+ :feature 'elixir-string-escape
:override t
- `((sigil
- (sigil_name) @elixir-ts-font-sigil-name-face
- (:match "^[^HF]$" @elixir-ts-font-sigil-name-face))
- @font-lock-string-face
- (sigil
- (sigil_name) @font-lock-regexp-face
- (:match "^[rR]$" @font-lock-regexp-face))
- @font-lock-regexp-face
- (sigil
- "~" @font-lock-string-face
- (sigil_name) @elixir-ts-font-sigil-name-face
- quoted_start: _ @font-lock-string-face
- quoted_end: _ @font-lock-string-face
- (:match "^[HF]$" @elixir-ts-font-sigil-name-face)))
+ `((escape_sequence) @font-lock-escape-face)
:language 'elixir
- :feature 'elixir-string-escape
+ :feature 'elixir-number
+ '([(integer) (float)] @font-lock-number-face)
+
+ :language 'elixir
+ :feature 'elixir-variable
+ '((binary_operator left: (identifier) @font-lock-variable-name-face)
+ (binary_operator right: (identifier) @font-lock-variable-name-face)
+ (arguments ( (identifier) @font-lock-variable-name-face))
+ (tuple (identifier) @font-lock-variable-name-face)
+ (list (identifier) @font-lock-variable-name-face)
+ (pair value: (identifier) @font-lock-variable-name-face)
+ (body (identifier) @font-lock-variable-name-face)
+ (unary_operator operand: (identifier) @font-lock-variable-name-face)
+ (interpolation (identifier) @font-lock-variable-name-face)
+ (do_block (identifier) @font-lock-variable-name-face))
+
+ :language 'elixir
+ :feature 'elixir-builtin
:override t
- `((escape_sequence) @font-lock-regexp-grouping-backslash))
+ `(((identifier) @font-lock-builtin-face
+ (:match ,elixir-ts--builtin-keywords-re
+ @font-lock-builtin-face))))
+
"Tree-sitter font-lock settings.")
(defvar elixir-ts--treesit-range-rules
@@ -640,10 +697,12 @@ Return nil if NODE is not a defun node or doesn't have a
name."
;; Font-lock.
(setq-local treesit-font-lock-settings elixir-ts--font-lock-settings)
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-constant elixir-doc )
- ( elixir-string elixir-keyword elixir-unary-operator
- elixir-call elixir-operator )
- ( elixir-sigil elixir-string-escape
elixir-string-interpolation)))
+ '(( elixir-comment elixir-doc elixir-function-name)
+ ( elixir-string elixir-keyword elixir-data-type)
+ ( elixir-sigil elixir-variable elixir-builtin
+ elixir-string-escape)
+ ( elixir-function-call elixir-operator elixir-number )))
+
;; Imenu.
(setq-local treesit-simple-imenu-settings
@@ -675,13 +734,13 @@ Return nil if NODE is not a defun node or doesn't have a
name."
heex-ts--indent-rules))
(setq-local treesit-font-lock-feature-list
- '(( elixir-comment elixir-constant elixir-doc
+ '(( elixir-comment elixir-doc elixir-function-name
heex-comment heex-keyword heex-doctype )
- ( elixir-string elixir-keyword elixir-unary-operator
- elixir-call elixir-operator
- heex-component heex-tag heex-attribute heex-string)
- ( elixir-sigil elixir-string-escape
- elixir-string-interpolation ))))
+ ( elixir-string elixir-keyword elixir-data-type
+ heex-component heex-tag heex-attribute heex-string )
+ ( elixir-sigil elixir-variable elixir-builtin
+ elixir-string-escape)
+ ( elixir-function-call elixir-operator elixir-number ))))
(treesit-major-mode-setup)
(setq-local syntax-propertize-function #'elixir-ts--syntax-propertize)))
diff --git a/lisp/progmodes/erts-mode.el b/lisp/progmodes/erts-mode.el
index 8dce93eae7e..5ff74082461 100644
--- a/lisp/progmodes/erts-mode.el
+++ b/lisp/progmodes/erts-mode.el
@@ -181,7 +181,8 @@ expected results and the actual results in a separate
buffer."
(ert-test--erts-test
(list (cons 'dummy t)
(cons 'code (car (read-from-string test-function)))
- (cons 'point-char (erts-mode--preceding-spec "Point-Char")))
+ (cons 'point-char (save-match-data
+ (erts-mode--preceding-spec "Point-Char"))))
(buffer-file-name))
(:success (message "Test successful"))
(ert-test-failed
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index a910d759c83..7307a5b13f1 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -44,6 +44,7 @@
(declare-function treesit-node-first-child-for-pos "treesit.c")
(declare-function treesit-node-parent "treesit.c")
(declare-function treesit-node-start "treesit.c")
+(declare-function treesit-node-end "treesit.c")
(declare-function treesit-node-type "treesit.c")
(declare-function treesit-parser-create "treesit.c")
(declare-function treesit-search-subtree "treesit.c")
@@ -133,135 +134,141 @@
"Lua built-in functions for tree-sitter font-locking.")
(defvar lua-ts--keywords
- '("and" "do" "else" "elseif" "end" "for" "function"
- "goto" "if" "in" "local" "not" "or" "repeat"
- "return" "then" "until" "while")
+ '("and" "do" "else" "elseif" "end" "for" "function" "goto" "if"
+ "in" "local" "not" "or" "repeat" "return" "then" "until" "while")
"Lua keywords for tree-sitter font-locking and navigation.")
+(defun lua-ts--comment-font-lock (node override start end &rest _)
+ "Apply font lock to comment NODE within START and END.
+Applies `font-lock-comment-delimiter-face' and
+`font-lock-comment-face'. See `treesit-fontify-with-override' for
+values of OVERRIDE."
+ (let* ((node-start (treesit-node-start node))
+ (node-end (treesit-node-end node))
+ (node-text (treesit-node-text node t))
+ (delimiter-end (+ 2 node-start)))
+ (when (and (>= node-start start)
+ (<= delimiter-end end)
+ (string-match "\\`--" node-text))
+ (treesit-fontify-with-override node-start
+ delimiter-end
+ font-lock-comment-delimiter-face
+ override))
+ (treesit-fontify-with-override (max delimiter-end start)
+ (min node-end end)
+ font-lock-comment-face
+ override)))
+
(defvar lua-ts--font-lock-settings
(treesit-font-lock-rules
- :language 'lua
+ :default-language 'lua
:feature 'bracket
'(["(" ")" "[" "]" "{" "}"] @font-lock-bracket-face)
- :language 'lua
:feature 'delimiter
'(["," ";"] @font-lock-delimiter-face)
- :language 'lua
:feature 'constant
- '((variable_list
- attribute: (attribute (["<" ">"] (identifier))))
- @font-lock-constant-face
- (goto_statement (identifier) @font-lock-constant-face)
- (label_statement) @font-lock-constant-face)
+ '([(variable_list
+ attribute: (attribute (["<" ">"] (identifier))))
+ (label_statement)
+ (true) (false) (nil)]
+ @font-lock-constant-face)
- :language 'lua
:feature 'operator
- '(["and" "not" "or" "+" "-" "*" "/" "%" "^"
- "#" "==" "~=" "<=" ">=" "<" ">" "=" "&"
- "~" "|" "<<" ">>" "//" ".."]
- @font-lock-operator-face
- (vararg_expression) @font-lock-operator-face)
+ '(["+" "-" "*" "/" "%" "^" "#" "==" "~=" "<=" ">="
+ "<" ">" "=" "&" "~" "|" "<<" ">>" "//" ".."
+ (vararg_expression)]
+ @font-lock-operator-face)
- :language 'lua
:feature 'builtin
`(((identifier) @font-lock-builtin-face
(:match ,(regexp-opt lua-ts--builtins 'symbols)
@font-lock-builtin-face)))
- :language 'lua
:feature 'function
'((function_call name: (identifier) @font-lock-function-call-face)
(function_call
- name: (method_index_expression
- method: (identifier) @font-lock-function-call-face))
+ (method_index_expression
+ method: (identifier) @font-lock-function-call-face))
(function_call
- name: (dot_index_expression (identifier) @font-lock-function-call-face)))
+ (dot_index_expression
+ field: (identifier) @font-lock-function-call-face)))
- :language 'lua
:feature 'punctuation
'(["." ":"] @font-lock-punctuation-face)
- :language 'lua
:feature 'variable
'((function_call
- arguments: (arguments (identifier))
- @font-lock-variable-use-face)
+ (arguments (identifier) @font-lock-variable-use-face))
(function_call
- name: (method_index_expression
- table: (identifier) @font-lock-variable-use-face)))
+ (arguments
+ (binary_expression (identifier) @font-lock-variable-use-face)))
+ (function_call
+ (arguments
+ (bracket_index_expression (identifier) @font-lock-variable-use-face)))
+ (function_declaration
+ (parameters name: (identifier) @font-lock-variable-name-face)))
- :language 'lua
:feature 'number
'((number) @font-lock-number-face)
- :language 'lua
:feature 'keyword
- `((break_statement) @font-lock-keyword-face
- (true) @font-lock-constant-face
- (false) @font-lock-constant-face
- (nil) @font-lock-constant-face
- ,(vconcat lua-ts--keywords)
- @font-lock-keyword-face)
-
- :language 'lua
+ `([(break_statement)
+ ,(vconcat lua-ts--keywords)]
+ @font-lock-keyword-face
+ (goto_statement ((identifier) @font-lock-constant-face)))
+
:feature 'string
'((string) @font-lock-string-face)
- :language 'lua
:feature 'escape
:override t
'((escape_sequence) @font-lock-escape-face)
- :language 'lua
:feature 'comment
- '((comment) @font-lock-comment-face
+ '((comment) @lua-ts--comment-font-lock
(hash_bang_line) @font-lock-comment-face)
- :language 'lua
:feature 'definition
'((function_declaration
- name: (identifier) @font-lock-function-name-face)
- (assignment_statement
- (variable_list name: [(identifier)]) @font-lock-function-name-face
- (expression_list value: (function_definition)))
- (table_constructor
- (field
- name: (identifier) @font-lock-function-name-face
- value: (function_definition)))
- (function_declaration
- name: (dot_index_expression (identifier) @font-lock-function-name-face))
+ (identifier) @font-lock-function-name-face)
(function_declaration
- name: (method_index_expression (identifier)
@font-lock-function-name-face))
+ (dot_index_expression
+ field: (identifier) @font-lock-function-name-face))
(function_declaration
(method_index_expression
+ method: (identifier) @font-lock-function-name-face))
+ (assignment_statement
+ (variable_list
+ (identifier) @font-lock-function-name-face)
+ (expression_list value: (function_definition)))
+ (field
+ name: (identifier) @font-lock-function-name-face
+ value: (function_definition))
+ (assignment_statement
+ (variable_list
(dot_index_expression
- table: (identifier) @font-lock-function-name-face
- field: (identifier) @font-lock-property-name-face
- )))
- (parameters
- name: (identifier) @font-lock-variable-name-face)
+ field: (identifier) @font-lock-function-name-face))
+ (expression_list
+ value:
+ (function_definition))))
+
+ :feature 'assignment
+ '((variable_list (identifier) @font-lock-variable-name-face)
+ (variable_list
+ (bracket_index_expression
+ field: (identifier) @font-lock-variable-name-face))
+ (variable_list
+ (dot_index_expression
+ field: (identifier) @font-lock-variable-name-face))
(for_numeric_clause name: (identifier) @font-lock-variable-name-face))
- :language 'lua
:feature 'property
'((field name: (identifier) @font-lock-property-name-face)
(dot_index_expression
field: (identifier) @font-lock-property-use-face))
- :language 'lua
- :feature 'assignment
- '((variable_list
- [(identifier)
- (bracket_index_expression)]
- @font-lock-variable-name-face)
- (variable_list
- (dot_index_expression
- table: (identifier))
- @font-lock-variable-name-face))
-
- :language 'lua
:feature 'error
:override t
'((ERROR) @font-lock-warning-face))
@@ -665,13 +672,14 @@ Calls REPORT-FN directly."
(setq-local treesit-font-lock-settings lua-ts--font-lock-settings)
(setq-local treesit-font-lock-feature-list
'((comment definition)
- (keyword property string)
+ (keyword string)
(assignment builtin constant number)
(bracket
delimiter
escape
function
operator
+ property
punctuation
variable)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index bdf8aab003b..a81bb63fba4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1800,15 +1800,15 @@ It's also possible to enter an arbitrary directory not
in the list."
(choices
(let (ret)
;; Iterate in reverse order so project--name-history is in
- ;; the correct order.
+ ;; the same order as project--list.
(dolist (dir (reverse (project-known-project-roots)))
- ;; we filter out directories that no longer map to a project,
+ ;; We filter out directories that no longer map to a project,
;; since they don't have a clean project-name.
- (when-let (proj (project--find-in-directory dir))
- (let ((name (project-name proj)))
- (push name project--name-history)
- (push (cons name proj) ret))))
- ret))
+ (when-let ((proj (project--find-in-directory dir))
+ (name (project-name proj)))
+ (push name project--name-history)
+ (push (cons name proj) ret)))
+ (reverse ret)))
;; XXX: Just using this for the category (for the substring
;; completion style).
(table (project--file-completion-table
diff --git a/lisp/progmodes/ruby-ts-mode.el b/lisp/progmodes/ruby-ts-mode.el
index 4f85e1c63ff..b339e2028ab 100644
--- a/lisp/progmodes/ruby-ts-mode.el
+++ b/lisp/progmodes/ruby-ts-mode.el
@@ -197,8 +197,8 @@
(defun ruby-ts--comment-font-lock (node override start end &rest _)
"Apply font lock to comment NODE within START and END.
Applies `font-lock-comment-delimiter-face' and
-`font-lock-comment-face' See `treesit-fontify-with-override' for
-values of OVERRIDE"
+`font-lock-comment-face'. See `treesit-fontify-with-override' for
+values of OVERRIDE."
;; Empirically it appears as if (treesit-node-start node) will be
;; where the # character is at and (treesit-node-end node) will be
;; the end of the line
@@ -1128,6 +1128,7 @@ leading double colon is not added."
bol
(or
"class"
+ "singleton_class"
"module"
"method"
"array"
@@ -1137,15 +1138,22 @@ leading double colon is not added."
"array_pattern"
"hash_pattern"
"if"
+ "else"
+ "then"
"unless"
"case"
"case_match"
"when"
+ "while"
+ "until"
+ "for"
"block"
"do_block"
"begin"
"integer"
"identifier"
+ "self"
+ "super"
"constant"
"simple_symbol"
"hash_key_symbol"
diff --git a/lisp/progmodes/rust-ts-mode.el b/lisp/progmodes/rust-ts-mode.el
index 88344934e49..03ff2776d3a 100644
--- a/lisp/progmodes/rust-ts-mode.el
+++ b/lisp/progmodes/rust-ts-mode.el
@@ -153,7 +153,7 @@
:language 'rust
:feature 'comment
- '(([(block_comment) (line_comment)]) @font-lock-comment-face)
+ '(([(block_comment) (line_comment)]) @rust-ts-mode--comment-docstring)
:language 'rust
:feature 'delimiter
@@ -293,6 +293,17 @@
'((ERROR) @font-lock-warning-face))
"Tree-sitter font-lock settings for `rust-ts-mode'.")
+(defun rust-ts-mode--comment-docstring (node override start end &rest _args)
+ "Use the comment or documentation face appropriately for comments."
+ (let* ((beg (treesit-node-start node))
+ (end (treesit-node-end node))
+ (face (save-excursion
+ (goto-char beg)
+ (if (looking-at "///")
+ 'font-lock-doc-face
+ 'font-lock-comment-face))))
+ (treesit-fontify-with-override beg end face override start end)))
+
(defun rust-ts-mode--fontify-scope (node override start end &optional tail-p)
(let* ((case-fold-search nil)
(face
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index b6d5495adbb..7998b3740b6 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -107,6 +107,9 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((parent-is "member_expression") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "named_imports") parent-bol typescript-ts-mode-indent-offset)
((parent-is "statement_block") parent-bol
typescript-ts-mode-indent-offset)
+ ((or (node-is "case")
+ (node-is "default"))
+ parent-bol typescript-ts-mode-indent-offset)
((parent-is "switch_case") parent-bol typescript-ts-mode-indent-offset)
((parent-is "switch_default") parent-bol typescript-ts-mode-indent-offset)
((parent-is "type_arguments") parent-bol typescript-ts-mode-indent-offset)
@@ -483,7 +486,7 @@ This mode is intended to be inherited by concrete major
modes."
'((comment declaration)
(keyword string escape-sequence)
(constant expression identifier number pattern property)
- (function bracket delimiter)))
+ (operator function bracket delimiter)))
(setq-local syntax-propertize-function #'typescript-ts--syntax-propertize)
(treesit-major-mode-setup)))
diff --git a/lisp/register.el b/lisp/register.el
index ca6de450993..46ec38821e5 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -35,6 +35,8 @@
;; FIXME: Clean up namespace usage!
+(declare-function frameset-register-p "frameset")
+
(cl-defstruct
(registerv (:constructor nil)
(:constructor registerv--make (&optional data print-func
@@ -98,6 +100,15 @@ If nil, do not show register previews, unless `help-char'
(or a member of
:version "24.4"
:type '(choice number (const :tag "No preview unless requested" nil))
:group 'register)
+(make-obsolete-variable 'register-preview-delay "No longer used." "30.1")
+
+(defcustom register-preview-default-keys (mapcar #'string (number-sequence ?a
?z))
+ "Default keys for setting a new register."
+ :type '(repeat string))
+
+(defcustom register-use-preview t
+ "Always show register preview when non nil."
+ :type 'boolean)
(defun get-register (register)
"Return contents of Emacs register named REGISTER, or nil if none."
@@ -120,7 +131,8 @@ See the documentation of the variable `register-alist' for
possible VALUEs."
(defun register-preview-default (r)
"Function that is the default value of the variable
`register-preview-function'."
(format "%s: %s\n"
- (single-key-description (car r))
+ (propertize (string (car r))
+ 'display (single-key-description (car r)))
(register-describe-oneline (car r))))
(defvar register-preview-function #'register-preview-default
@@ -128,53 +140,263 @@ See the documentation of the variable `register-alist'
for possible VALUEs."
Called with one argument, a cons (NAME . CONTENTS) as found in
`register-alist'.
The function should return a string, the description of the argument.")
-(defun register-preview (buffer &optional show-empty)
+(cl-defstruct register-preview-info
+ "Store data for a specific register command.
+TYPES are the types of register supported.
+MSG is the minibuffer message to send when a register is selected.
+ACT is the type of action the command is doing on register.
+SMATCH accept a boolean value to say if command accept non matching register."
+ types msg act smatch)
+
+(cl-defgeneric register-command-info (command)
+ "Returns a `register-preview-info' object storing data for COMMAND."
+ (ignore command))
+(cl-defmethod register-command-info ((_command (eql insert-register)))
+ (make-register-preview-info
+ :types '(string number)
+ :msg "Insert register `%s'"
+ :act 'insert
+ :smatch t))
+(cl-defmethod register-command-info ((_command (eql jump-to-register)))
+ (make-register-preview-info
+ :types '(window frame marker kmacro
+ file buffer file-query)
+ :msg "Jump to register `%s'"
+ :act 'jump
+ :smatch t))
+(cl-defmethod register-command-info ((_command (eql view-register)))
+ (make-register-preview-info
+ :types '(all)
+ :msg "View register `%s'"
+ :act 'view
+ :smatch t))
+(cl-defmethod register-command-info ((_command (eql append-to-register)))
+ (make-register-preview-info
+ :types '(string number)
+ :msg "Append to register `%s'"
+ :act 'modify
+ :smatch t))
+(cl-defmethod register-command-info ((_command (eql prepend-to-register)))
+ (make-register-preview-info
+ :types '(string number)
+ :msg "Prepend to register `%s'"
+ :act 'modify
+ :smatch t))
+(cl-defmethod register-command-info ((_command (eql increment-register)))
+ (make-register-preview-info
+ :types '(string number)
+ :msg "Increment register `%s'"
+ :act 'modify
+ :smatch t))
+
+(defun register-preview-forward-line (arg)
+ "Move to next or previous line in register preview buffer.
+If ARG is positive goto next line, if negative to previous.
+Do nothing when defining or executing kmacros."
+ ;; Ensure user enter manually key in minibuffer when recording a macro.
+ (unless (or defining-kbd-macro executing-kbd-macro
+ (not (get-buffer-window "*Register Preview*" 'visible)))
+ (let ((fn (if (> arg 0) #'eobp #'bobp))
+ (posfn (if (> arg 0)
+ #'point-min
+ (lambda () (1- (point-max)))))
+ str)
+ (with-current-buffer "*Register Preview*"
+ (let ((ovs (overlays-in (point-min) (point-max)))
+ pos)
+ (goto-char (if ovs
+ (overlay-start (car ovs))
+ (point-min)))
+ (setq pos (point))
+ (and ovs (forward-line arg))
+ (when (and (funcall fn)
+ (or (> arg 0) (eql pos (point))))
+ (goto-char (funcall posfn)))
+ (setq str (buffer-substring-no-properties
+ (pos-bol) (1+ (pos-bol))))
+ (remove-overlays)
+ (with-selected-window (minibuffer-window)
+ (delete-minibuffer-contents)
+ (insert str)))))))
+
+(defun register-preview-next ()
+ "Goto next line in register preview buffer."
+ (interactive)
+ (register-preview-forward-line 1))
+
+(defun register-preview-previous ()
+ "Goto previous line in register preview buffer."
+ (interactive)
+ (register-preview-forward-line -1))
+
+(defun register-type (register)
+ "Return REGISTER type.
+Current register types actually returned are one of:
+- string
+- number
+- marker
+- buffer
+- file
+- file-query
+- window
+- frame
+- kmacro
+
+One can add new types to a specific command by defining a new `cl-defmethod'
+matching this command. Predicate for type in new `cl-defmethod' should
+satisfy `cl-typep' otherwise the new type should be defined with
+`cl-deftype'."
+ ;; Call register--type against the register value.
+ (register--type (if (consp (cdr register))
+ (cadr register)
+ (cdr register))))
+
+(cl-defgeneric register--type (regval)
+ "Returns type of register value REGVAL."
+ (ignore regval))
+
+(cl-defmethod register--type ((_regval string)) 'string)
+(cl-defmethod register--type ((_regval number)) 'number)
+(cl-defmethod register--type ((_regval marker)) 'marker)
+(cl-defmethod register--type ((_regval (eql 'buffer))) 'buffer)
+(cl-defmethod register--type ((_regval (eql 'file))) 'file)
+(cl-defmethod register--type ((_regval (eql 'file-query))) 'file-query)
+(cl-defmethod register--type ((_regval window-configuration)) 'window)
+(cl-deftype frame-register () '(satisfies frameset-register-p))
+(cl-defmethod register--type :extra "frame-register" (_regval) 'frame)
+(cl-deftype kmacro-register () '(satisfies kmacro-register-p))
+(cl-defmethod register--type :extra "kmacro-register" (_regval) 'kmacro)
+
+(defun register-of-type-alist (types)
+ "Filter `register-alist' according to TYPES."
+ (if (memq 'all types)
+ register-alist
+ (cl-loop for register in register-alist
+ when (memq (register-type register) types)
+ collect register)))
+
+(defun register-preview (buffer &optional show-empty types)
"Pop up a window showing the registers preview in BUFFER.
If SHOW-EMPTY is non-nil, show the window even if no registers.
+Argument TYPES (a list) specify the types of register to show, when nil show
all
+registers, see `register-type' for suitable types.
Format of each entry is controlled by the variable
`register-preview-function'."
- (when (or show-empty (consp register-alist))
- (with-current-buffer-window
- buffer
- (cons 'display-buffer-below-selected
- '((window-height . fit-window-to-buffer)
- (preserve-size . (nil . t))))
- nil
- (with-current-buffer standard-output
- (setq cursor-in-non-selected-windows nil)
- (mapc (lambda (elem)
- (when (get-register (car elem))
- (insert (funcall register-preview-function elem))))
- register-alist)))))
+ (let ((registers (register-of-type-alist (or types '(all)))))
+ (when (or show-empty (consp registers))
+ (with-current-buffer-window
+ buffer
+ (cons 'display-buffer-below-selected
+ '((window-height . fit-window-to-buffer)
+ (preserve-size . (nil . t))))
+ nil
+ (with-current-buffer standard-output
+ (setq cursor-in-non-selected-windows nil)
+ (mapc (lambda (elem)
+ (when (get-register (car elem))
+ (insert (funcall register-preview-function elem))))
+ registers))))))
+
+(cl-defgeneric register-preview-get-defaults (action)
+ "Returns default registers according to ACTION."
+ (ignore action))
+(cl-defmethod register-preview-get-defaults ((_action (eql set)))
+ (cl-loop for s in register-preview-default-keys
+ unless (assoc (string-to-char s) register-alist)
+ collect s))
(defun register-read-with-preview (prompt)
"Read and return a register name, possibly showing existing registers.
-Prompt with the string PROMPT. If `register-alist' and
-`register-preview-delay' are both non-nil, display a window
-listing existing registers after `register-preview-delay' seconds.
+Prompt with the string PROMPT.
If `help-char' (or a member of `help-event-list') is pressed,
display such a window regardless."
(let* ((buffer "*Register Preview*")
- (timer (when (numberp register-preview-delay)
- (run-with-timer register-preview-delay nil
- (lambda ()
- (unless (get-buffer-window buffer)
- (register-preview buffer))))))
- (help-chars (cl-loop for c in (cons help-char help-event-list)
- when (not (get-register c))
- collect c)))
+ (pat "")
+ (map (let ((m (make-sparse-keymap)))
+ (set-keymap-parent m minibuffer-local-map)
+ m))
+ (data (register-command-info this-command))
+ types msg result timer act win strs smatch)
+ (if data
+ (setq types (register-preview-info-types data)
+ msg (register-preview-info-msg data)
+ act (register-preview-info-act data)
+ smatch (register-preview-info-smatch data))
+ (setq types '(all)
+ msg "Overwrite register `%s'"
+ act 'set))
+ (setq strs (mapcar (lambda (x)
+ (string (car x)))
+ (register-of-type-alist types)))
+ (when (and (memq act '(insert jump view)) (null strs))
+ (error "No register suitable for `%s'" act))
+ (dolist (k (cons help-char help-event-list))
+ (define-key map
+ (vector k) (lambda ()
+ (interactive)
+ (unless (get-buffer-window buffer)
+ (with-selected-window (minibuffer-selected-window)
+ (register-preview buffer 'show-empty types))))))
+ (define-key map (kbd "<down>") 'register-preview-next)
+ (define-key map (kbd "<up>") 'register-preview-previous)
+ (define-key map (kbd "C-n") 'register-preview-next)
+ (define-key map (kbd "C-p") 'register-preview-previous)
+ (unless (or executing-kbd-macro (null register-use-preview))
+ (register-preview buffer nil types))
(unwind-protect
- (progn
- (while (memq (read-key (propertize prompt 'face 'minibuffer-prompt))
- help-chars)
- (unless (get-buffer-window buffer)
- (register-preview buffer 'show-empty)))
- (when (or (eq ?\C-g last-input-event)
- (eq 'escape last-input-event)
- (eq ?\C-\[ last-input-event))
- (keyboard-quit))
- (if (characterp last-input-event) last-input-event
- (error "Non-character input-event")))
- (and (timerp timer) (cancel-timer timer))
+ (progn
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq timer
+ (run-with-idle-timer
+ 0.01 'repeat
+ (lambda ()
+ (with-selected-window (minibuffer-window)
+ (let ((input (minibuffer-contents)))
+ (when (> (length input) 1)
+ (let ((new (substring input 1))
+ (old (substring input 0 1)))
+ (setq input (if (or (null smatch)
+ (member new strs))
+ new old))
+ (delete-minibuffer-contents)
+ (insert input)))
+ (when (and smatch (not (string= input ""))
+ (not (member input strs)))
+ (setq input "")
+ (delete-minibuffer-contents)
+ (minibuffer-message "Not matching"))
+ (when (not (string= input pat))
+ (setq pat input))))
+ (if (setq win (get-buffer-window buffer))
+ (with-selected-window win
+ (let ((ov (make-overlay (point-min)
(point-min))))
+ (goto-char (point-min))
+ (remove-overlays)
+ (unless (string= pat "")
+ (if (re-search-forward (concat "^" pat)
nil t)
+ (progn (move-overlay
+ ov
+ (match-beginning 0) (pos-eol))
+ (overlay-put ov 'face 'match)
+ (when msg
+ (with-selected-window
(minibuffer-window)
+ (minibuffer-message msg
pat))))
+ (with-selected-window (minibuffer-window)
+ (minibuffer-message
+ "Register `%s' is empty" pat))))))
+ (unless (string= pat "")
+ (if (member pat strs)
+ (with-selected-window (minibuffer-window)
+ (minibuffer-message msg pat))
+ (with-selected-window (minibuffer-window)
+ (minibuffer-message
+ "Register `%s' is empty" pat)))))))))
+ (setq result (read-from-minibuffer
+ prompt nil map nil nil
(register-preview-get-defaults act))))
+ (cl-assert (and result (not (string= result "")))
+ nil "No register specified")
+ (string-to-char result))
+ (when timer (cancel-timer timer))
(let ((w (get-buffer-window buffer)))
(and (window-live-p w) (delete-window w)))
(and (get-buffer buffer) (kill-buffer buffer)))))
diff --git a/lisp/simple.el b/lisp/simple.el
index c0384cf5c0c..6f36a02ab65 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4274,19 +4274,19 @@ This buffer is used when `shell-command' or
`shell-command-on-region'
is run interactively. A value of nil means that output to stderr and
stdout will be intermixed in the output stream.")
-(declare-function mailcap-file-default-commands "mailcap" (files))
(declare-function dired-get-filename "dired" (&optional localp
no-error-if-not-filep))
+(declare-function shell-command-guess "dired-aux" (files))
(defun minibuffer-default-add-shell-commands ()
"Return a list of all commands associated with the current file.
-This function is used to add all related commands retrieved by `mailcap'
-to the end of the list of defaults just after the default value."
- (interactive)
+This function is used to add all related commands retrieved by
+`shell-command-guess' to the end of the list of defaults just
+after the default value."
(let* ((filename (if (listp minibuffer-default)
(car minibuffer-default)
minibuffer-default))
- (commands (and filename (require 'mailcap nil t)
- (mailcap-file-default-commands (list filename)))))
+ (commands (and filename (require 'dired-aux)
+ (shell-command-guess (list filename)))))
(setq commands (mapcar (lambda (command)
(concat command " " filename))
commands))
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
index 8a525739c9a..22a0355d3cd 100644
--- a/lisp/sqlite.el
+++ b/lisp/sqlite.el
@@ -23,6 +23,10 @@
;;; Code:
+(declare-function sqlite-transaction "sqlite.c")
+(declare-function sqlite-commit "sqlite.c")
+(declare-function sqlite-rollback "sqlite.c")
+
(defmacro with-sqlite-transaction (db &rest body)
"Execute BODY while holding a transaction for DB.
If BODY completes normally, commit the changes and return
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index b71e85b0e37..4c3b22281bd 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -3680,6 +3680,28 @@ If APPEND is non-nil, don't erase previous debugging
output."
(if (>= column (- (window-width) 2))
(scroll-left (max (- column (window-width) -3) 10)))))))
+;;;###autoload
+(defun ispell-completion-at-point ()
+ "Word completion function for use in `completion-at-point-functions'."
+ (pcase (bounds-of-thing-at-point 'word)
+ (`(,beg . ,end)
+ (when (and (< beg (point)) (<= (point) end))
+ (let* ((word (buffer-substring-no-properties beg end))
+ (len (length word))
+ (inhibit-message t)
+ (all (cons word (ispell-lookup-words word)))
+ (cur all))
+ (while cur
+ (unless (string-prefix-p word (car cur))
+ (setcar cur (concat word (substring (car cur) len))))
+ (while (when-let ((next (cadr cur)))
+ (not (string-prefix-p word next t)))
+ (setcdr cur (cddr cur)))
+ (setq cur (cdr cur)))
+ (list beg end (cdr all)
+ :annotation-function (lambda (_) " Dictionary word")
+ :exclusive 'no))))))
+
;;; Interactive word completion.
;; Forces "previous-word" processing. Do we want to make this selectable?
@@ -3696,7 +3718,6 @@ This command uses a word-list file specified
by `ispell-alternate-dictionary' or by `ispell-complete-word-dict';
if none of those name an existing word-list file, this command
signals an error."
- ;; FIXME: completion-at-point-function.
(interactive "P")
(let ((case-fold-search-val case-fold-search)
(word (ispell-get-word nil "\\*")) ; force "previous-word" processing.
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index ccba1b063ab..7f38a1c463d 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -73,8 +73,20 @@
(defvar-keymap text-mode-map
:doc "Keymap for `text-mode'.
Many other modes, such as `mail-mode' and `outline-mode', inherit
-all the commands defined in this map."
- "C-M-i" #'ispell-complete-word)
+all the commands defined in this map.")
+
+(defcustom text-mode-meta-tab-ispell-complete-word nil
+ "Whether M-TAB invokes `ispell-complete-word' in Text mode.
+
+This user option only takes effect when you customize it in
+Custom or with `setopt', not with `setq'."
+ :group 'text
+ :type 'boolean
+ :version "30.1"
+ :set (lambda (sym val)
+ (if (set sym val)
+ (keymap-set text-mode-map "C-M-i" #'ispell-complete-word)
+ (keymap-unset text-mode-map "C-M-i" t))))
(easy-menu-define text-mode-menu text-mode-map
"Menu for `text-mode'."
@@ -131,7 +143,8 @@ Turning on Text mode runs the normal hook `text-mode-hook'."
;; Enable text conversion in this buffer.
(setq-local text-conversion-style t)
- (add-hook 'context-menu-functions 'text-mode-context-menu 10 t))
+ (add-hook 'context-menu-functions 'text-mode-context-menu 10 t)
+ (add-hook 'completion-at-point-functions #'ispell-completion-at-point 10 t))
(define-derived-mode paragraph-indent-text-mode text-mode "Parindent"
"Major mode for editing text, with leading spaces starting a paragraph.
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 1bd9ecb2193..3085e4b9f76 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1071,19 +1071,23 @@ Within directories, only files already under version
control are noticed."
(defvar diff-vc-backend)
(defvar diff-vc-revisions)
-;; Maybe we could even use comint-mode rather than shell-mode?
-(defvar vc-deduce-backend-nonvc-modes
+(defcustom vc-deduce-backend-nonvc-modes
+ ;; Maybe we could even use comint-mode rather than shell-mode?
'(dired-mode shell-mode eshell-mode compilation-mode)
"List of modes not supported by VC where backend should be deduced.
In these modes the backend is deduced based on `default-directory'.
-When nil, the backend is deduced in all modes.")
+If the value is t, the backend is deduced in all modes."
+ :type '(choice (const :tag "None" nil)
+ (repeat symbol)
+ (const :tag "All" t))
+ :version "30.1")
(defun vc-deduce-backend ()
(cond ((derived-mode-p 'vc-dir-mode) vc-dir-backend)
((derived-mode-p 'log-view-mode) log-view-vc-backend)
((derived-mode-p 'log-edit-mode) log-edit-vc-backend)
((derived-mode-p 'diff-mode) diff-vc-backend)
- ((or (null vc-deduce-backend-nonvc-modes)
+ ((or (eq vc-deduce-backend-nonvc-modes t)
(derived-mode-p vc-deduce-backend-nonvc-modes))
(ignore-errors (vc-responsible-backend default-directory)))
(vc-mode (vc-backend buffer-file-name))))
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 079d93d6011..b5b01f0d089 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -261,6 +261,10 @@ See `wdired-mode'."
(add-function :override (local 'revert-buffer-function) #'wdired-revert)
(set-buffer-modified-p nil)
(setq buffer-undo-list nil)
+ ;; Non-nil `dired-filename-display-length' may cause filenames to be
+ ;; hidden partly, so we remove filename invisibility spec
+ ;; temporarily to ensure filenames are visible for editing.
+ (dired-filename-update-invisibility-spec)
(run-mode-hooks 'wdired-mode-hook)
(message "%s" (substitute-command-keys
"Press \\[wdired-finish-edit] when finished \
@@ -456,6 +460,9 @@ non-nil means return old filename."
(dired-sort-set-mode-line)
(dired-advertise)
(dired-hide-details-update-invisibility-spec)
+ ;; Restore filename invisibility spec that is removed in
+ ;; `wdired-change-to-wdired-mode'.
+ (dired-filename-update-invisibility-spec)
(remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
(remove-hook 'before-change-functions #'wdired--before-change-fn t)
(remove-hook 'after-change-functions #'wdired--restore-properties t)
diff --git a/lisp/window.el b/lisp/window.el
index 0c5ccf167dc..fbdcd611068 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -5682,7 +5682,8 @@ 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
\(selected) window gets SIZE lines. If SIZE is negative, the
-lower (new) window gets -SIZE lines.
+lower (new) window gets -SIZE lines. Interactively, SIZE is
+the prefix numeric argument.
If the variable `split-window-keep-point' is non-nil, both
windows get the same value of point as the WINDOW-TO-SPLIT.
@@ -5734,8 +5735,9 @@ amount of redisplay; this is convenient on slow
terminals."
"Split root window of current frame in two.
The current window configuration is retained in the top window,
the lower window takes up the whole width of the frame. SIZE is
-handled as in `split-window-below'."
- (interactive "P")
+handled as in `split-window-below', and interactively is the
+prefix numeric argument."
+ (interactive "p")
(split-window-below size (frame-root-window)))
(defun split-window-right (&optional size window-to-split)
@@ -5752,7 +5754,7 @@ same width, or close to it. If SIZE is positive, the
left-hand
right-hand (new) window gets -SIZE columns. Here, SIZE includes
the width of the window's scroll bar; if there are no scroll
bars, it includes the width of the divider column to the window's
-right, if any."
+right, if any. Interactively, SIZE is the prefix numeric argument."
(interactive `(,(when current-prefix-arg
(prefix-numeric-value current-prefix-arg))
,(selected-window)))
@@ -5774,8 +5776,8 @@ right, if any."
The current window configuration is retained within the left
window, and a new window is created on the right, taking up the
whole height of the frame. SIZE is treated as by
-`split-window-right'."
- (interactive "P")
+`split-window-right' and interactively, is the prefix numeric argument."
+ (interactive "p")
(split-window-right size (frame-root-window)))
;;; Balancing windows.
diff --git a/src/pdumper.c b/src/pdumper.c
index 733cc1d8a73..330be13800a 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -3002,7 +3002,8 @@ dump_vectorlike (struct dump_context *ctx,
# error "pvec_type changed. See CHECK_STRUCTS comment in config.h."
#endif
const struct Lisp_Vector *v = XVECTOR (lv);
- switch (PSEUDOVECTOR_TYPE (v))
+ enum pvec_type ptype = PSEUDOVECTOR_TYPE (v);
+ switch (ptype)
{
case PVEC_FONT:
/* There are three kinds of font objects that all use PVEC_FONT,
@@ -3020,76 +3021,60 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_SUB_CHAR_TABLE:
case PVEC_RECORD:
case PVEC_PACKAGE:
- offset = dump_vectorlike_generic (ctx, &v->header);
- break;
+ return dump_vectorlike_generic (ctx, &v->header);
case PVEC_BOOL_VECTOR:
- offset = dump_bool_vector(ctx, v);
- break;
+ return dump_bool_vector(ctx, v);
case PVEC_HASH_TABLE:
- offset = dump_hash_table (ctx, lv, offset);
- break;
+ return dump_hash_table (ctx, lv, offset);
case PVEC_BUFFER:
- offset = dump_buffer (ctx, XBUFFER (lv));
- break;
+ return dump_buffer (ctx, XBUFFER (lv));
case PVEC_SUBR:
- offset = dump_subr (ctx, XSUBR (lv));
- break;
+ return dump_subr (ctx, XSUBR (lv));
case PVEC_FRAME:
case PVEC_WINDOW:
case PVEC_PROCESS:
case PVEC_TERMINAL:
- offset = dump_nilled_pseudovec (ctx, &v->header);
- break;
+ return dump_nilled_pseudovec (ctx, &v->header);
case PVEC_MARKER:
- offset = dump_marker (ctx, XMARKER (lv));
- break;
+ return dump_marker (ctx, XMARKER (lv));
case PVEC_OVERLAY:
- offset = dump_overlay (ctx, XOVERLAY (lv));
- break;
+ return dump_overlay (ctx, XOVERLAY (lv));
case PVEC_FINALIZER:
- offset = dump_finalizer (ctx, XFINALIZER (lv));
- break;
+ return dump_finalizer (ctx, XFINALIZER (lv));
case PVEC_BIGNUM:
- offset = dump_bignum (ctx, lv);
- break;
-#ifdef HAVE_NATIVE_COMP
+ return dump_bignum (ctx, lv);
case PVEC_NATIVE_COMP_UNIT:
- offset = dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
- break;
+#ifdef HAVE_NATIVE_COMP
+ return dump_native_comp_unit (ctx, XNATIVE_COMP_UNIT (lv));
#endif
- case PVEC_WINDOW_CONFIGURATION:
- error_unsupported_dump_object (ctx, lv, "window configuration");
- case PVEC_OTHER:
- error_unsupported_dump_object (ctx, lv, "other?!");
- case PVEC_XWIDGET:
- error_unsupported_dump_object (ctx, lv, "xwidget");
- case PVEC_XWIDGET_VIEW:
- error_unsupported_dump_object (ctx, lv, "xwidget view");
- case PVEC_MISC_PTR:
- case PVEC_USER_PTR:
- error_unsupported_dump_object (ctx, lv, "smuggled pointers");
+ break;
case PVEC_THREAD:
if (main_thread_p (v))
{
eassert (dump_object_emacs_ptr (lv));
return DUMP_OBJECT_IS_RUNTIME_MAGIC;
}
- error_unsupported_dump_object (ctx, lv, "thread");
+ break;
+ case PVEC_WINDOW_CONFIGURATION:
+ case PVEC_OTHER:
+ case PVEC_XWIDGET:
+ case PVEC_XWIDGET_VIEW:
+ case PVEC_MISC_PTR:
+ case PVEC_USER_PTR:
case PVEC_MUTEX:
- error_unsupported_dump_object (ctx, lv, "mutex");
case PVEC_CONDVAR:
- error_unsupported_dump_object (ctx, lv, "condvar");
case PVEC_SQLITE:
- error_unsupported_dump_object (ctx, lv, "sqlite");
case PVEC_MODULE_FUNCTION:
- error_unsupported_dump_object (ctx, lv, "module function");
case PVEC_SYMBOL_WITH_POS:
- error_unsupported_dump_object (ctx, lv, "symbol with pos");
- default:
- error_unsupported_dump_object(ctx, lv, "weird pseudovector");
+ case PVEC_FREE:
+ case PVEC_TS_PARSER:
+ case PVEC_TS_NODE:
+ case PVEC_TS_COMPILED_QUERY:
+ break;
}
-
- return offset;
+ char msg[60];
+ snprintf (msg, sizeof msg, "pseudovector type %d", (int) ptype);
+ error_unsupported_dump_object (ctx, lv, msg);
}
/* Add an object to the dump.
diff --git a/src/print.c b/src/print.c
index b3708e588f6..52f7f3f9d9e 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1599,76 +1599,69 @@ print_pointer (Lisp_Object printcharfun, char *buf,
const char *prefix,
}
#endif
-static bool
-print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag,
- char *buf)
+static void
+print_bignum (Lisp_Object obj, Lisp_Object printcharfun)
{
- /* First do all the vectorlike types that have a readable syntax. */
- switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
- {
- case PVEC_BIGNUM:
- {
- ptrdiff_t size = bignum_bufsize (obj, 10);
- USE_SAFE_ALLOCA;
- char *str = SAFE_ALLOCA (size);
- ptrdiff_t len = bignum_to_c_string (str, size, obj, 10);
- strout (str, len, len, printcharfun);
- SAFE_FREE ();
- }
- return true;
-
- case PVEC_BOOL_VECTOR:
- {
- EMACS_INT size = bool_vector_size (obj);
- ptrdiff_t size_in_bytes = bool_vector_bytes (size);
- ptrdiff_t real_size_in_bytes = size_in_bytes;
- unsigned char *data = bool_vector_uchar_data (obj);
-
- int len = sprintf (buf, "#&%"pI"d\"", size);
- strout (buf, len, len, printcharfun);
+ ptrdiff_t size = bignum_bufsize (obj, 10);
+ USE_SAFE_ALLOCA;
+ char *str = SAFE_ALLOCA (size);
+ ptrdiff_t len = bignum_to_c_string (str, size, obj, 10);
+ strout (str, len, len, printcharfun);
+ SAFE_FREE ();
+}
- /* Don't print more bytes than the specified maximum.
- Negative values of print-length are invalid. Treat them
- like a print-length of nil. */
- if (FIXNATP (Vprint_length)
- && XFIXNAT (Vprint_length) < size_in_bytes)
- size_in_bytes = XFIXNAT (Vprint_length);
+static void
+print_bool_vector (Lisp_Object obj, Lisp_Object printcharfun)
+{
+ EMACS_INT size = bool_vector_size (obj);
+ ptrdiff_t size_in_bytes = bool_vector_bytes (size);
+ ptrdiff_t real_size_in_bytes = size_in_bytes;
+ unsigned char *data = bool_vector_uchar_data (obj);
- for (ptrdiff_t i = 0; i < size_in_bytes; i++)
- {
- maybe_quit ();
- unsigned char c = data[i];
- if (c == '\n' && print_escape_newlines)
- print_c_string ("\\n", printcharfun);
- else if (c == '\f' && print_escape_newlines)
- print_c_string ("\\f", printcharfun);
- else if (c > '\177'
- || (print_escape_control_characters && c_iscntrl (c)))
- {
- /* Use octal escapes to avoid encoding issues. */
- octalout (c, data, i + 1, size_in_bytes, printcharfun);
- }
- else
- {
- if (c == '\"' || c == '\\')
- printchar ('\\', printcharfun);
- printchar (c, printcharfun);
- }
- }
+ char buf[sizeof "#&" + INT_STRLEN_BOUND (ptrdiff_t)];
+ int len = sprintf (buf, "#&%"pI"d\"", size);
+ strout (buf, len, len, printcharfun);
- if (size_in_bytes < real_size_in_bytes)
- print_c_string (" ...", printcharfun);
- printchar ('\"', printcharfun);
- }
- return true;
+ /* Don't print more bytes than the specified maximum.
+ Negative values of print-length are invalid. Treat them
+ like a print-length of nil. */
+ if (FIXNATP (Vprint_length)
+ && XFIXNAT (Vprint_length) < size_in_bytes)
+ size_in_bytes = XFIXNAT (Vprint_length);
- default:
- break;
+ for (ptrdiff_t i = 0; i < size_in_bytes; i++)
+ {
+ maybe_quit ();
+ unsigned char c = data[i];
+ if (c == '\n' && print_escape_newlines)
+ print_c_string ("\\n", printcharfun);
+ else if (c == '\f' && print_escape_newlines)
+ print_c_string ("\\f", printcharfun);
+ else if (c > '\177'
+ || (print_escape_control_characters && c_iscntrl (c)))
+ {
+ /* Use octal escapes to avoid encoding issues. */
+ octalout (c, data, i + 1, size_in_bytes, printcharfun);
+ }
+ else
+ {
+ if (c == '\"' || c == '\\')
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
}
- /* Then do all the pseudovector types that don't have a readable
- syntax. First check whether this is handled by
- `print-unreadable-function'. */
+ if (size_in_bytes < real_size_in_bytes)
+ print_c_string (" ...", printcharfun);
+ printchar ('\"', printcharfun);
+}
+
+/* Print a pseudovector that has no readable syntax. */
+static void
+print_vectorlike_unreadable (Lisp_Object obj, Lisp_Object printcharfun,
+ bool escapeflag, char *buf)
+{
+ /* First check whether this is handled by `print-unreadable-function'. */
if (!NILP (Vprint_unreadable_function)
&& FUNCTIONP (Vprint_unreadable_function))
{
@@ -1697,7 +1690,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
if (STRINGP (result))
print_string (result, printcharfun);
/* It's handled, so stop processing here. */
- return true;
+ return;
}
}
@@ -1718,7 +1711,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun);
}
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_SYMBOL_WITH_POS:
{
@@ -1742,7 +1735,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
printchar ('>', printcharfun);
}
}
- break;
+ return;
case PVEC_OVERLAY:
print_c_string ("#<overlay ", printcharfun);
@@ -1758,7 +1751,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
printcharfun);
}
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_USER_PTR:
{
@@ -1769,14 +1762,14 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
strout (buf, i, i, printcharfun);
printchar ('>', printcharfun);
}
- break;
+ return;
case PVEC_FINALIZER:
print_c_string ("#<finalizer", printcharfun);
if (NILP (XFINALIZER (obj)->function))
print_c_string (" used", printcharfun);
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_MISC_PTR:
{
@@ -1785,7 +1778,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
int i = sprintf (buf, "#<ptr %p>", xmint_pointer (obj));
strout (buf, i, i, printcharfun);
}
- break;
+ return;
case PVEC_PROCESS:
if (escapeflag)
@@ -1796,13 +1789,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
else
print_string (XPROCESS (obj)->name, printcharfun);
- break;
+ return;
case PVEC_SUBR:
print_c_string ("#<subr ", printcharfun);
print_c_string (XSUBR (obj)->symbol_name, printcharfun);
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_PACKAGE:
if (STRINGP (PACKAGE_NAMEX (obj)))
@@ -1833,15 +1826,15 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
#endif
strout (buf, len, len, printcharfun);
}
- break;
+ return;
}
-#else
- emacs_abort ();
#endif
+ break;
+
case PVEC_XWIDGET_VIEW:
print_c_string ("#<xwidget view", printcharfun);
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_WINDOW:
{
@@ -1856,7 +1849,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
printchar ('>', printcharfun);
}
- break;
+ return;
case PVEC_TERMINAL:
{
@@ -1870,7 +1863,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
printchar ('>', printcharfun);
}
- break;
+ return;
case PVEC_BUFFER:
if (!BUFFER_LIVE_P (XBUFFER (obj)))
@@ -1883,11 +1876,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
else
print_string (BVAR (XBUFFER (obj), name), printcharfun);
- break;
+ return;
case PVEC_WINDOW_CONFIGURATION:
print_c_string ("#<window-configuration>", printcharfun);
- break;
+ return;
case PVEC_FRAME:
{
@@ -1911,7 +1904,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
int len = sprintf (buf, " %p>", ptr);
strout (buf, len, len, printcharfun);
}
- break;
+ return;
case PVEC_FONT:
{
@@ -1944,7 +1937,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
printchar ('>', printcharfun);
}
- break;
+ return;
case PVEC_THREAD:
print_c_string ("#<thread ", printcharfun);
@@ -1957,7 +1950,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
strout (buf, len, len, printcharfun);
}
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_MUTEX:
print_c_string ("#<mutex ", printcharfun);
@@ -1970,7 +1963,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
strout (buf, len, len, printcharfun);
}
printchar ('>', printcharfun);
- break;
+ return;
case PVEC_CONDVAR:
print_c_string ("#<condvar ", printcharfun);
@@ -1983,10 +1976,10 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
strout (buf, len, len, printcharfun);
}
printchar ('>', printcharfun);
- break;
+ return;
-#ifdef HAVE_MODULES
case PVEC_MODULE_FUNCTION:
+#ifdef HAVE_MODULES
{
print_c_string ("#<module function ", printcharfun);
const struct Lisp_Module_Function *function = XMODULE_FUNCTION (obj);
@@ -2011,11 +2004,13 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
}
printchar ('>', printcharfun);
+ return;
}
- break;
#endif
-#ifdef HAVE_NATIVE_COMP
+ break;
+
case PVEC_NATIVE_COMP_UNIT:
+#ifdef HAVE_NATIVE_COMP
{
struct Lisp_Native_Comp_Unit *cu = XNATIVE_COMP_UNIT (obj);
print_c_string ("#<native compilation unit: ", printcharfun);
@@ -2023,27 +2018,32 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
printchar (' ', printcharfun);
print_object (cu->optimize_qualities, printcharfun, escapeflag);
printchar ('>', printcharfun);
+ return;
}
- break;
#endif
+ break;
-#ifdef HAVE_TREE_SITTER
case PVEC_TS_PARSER:
+#ifdef HAVE_TREE_SITTER
print_c_string ("#<treesit-parser for ", printcharfun);
Lisp_Object language = XTS_PARSER (obj)->language_symbol;
/* No need to print the buffer because it's not that useful: we
usually know which buffer a parser belongs to. */
print_string (Fsymbol_name (language), printcharfun);
printchar ('>', printcharfun);
+ return;
+#endif
break;
+
case PVEC_TS_NODE:
+#ifdef HAVE_TREE_SITTER
/* Prints #<treesit-node (identifier) in 12-15> or
#<treesit-node "keyword" in 28-31>. */
print_c_string ("#<treesit-node", printcharfun);
if (!treesit_node_uptodate_p (obj))
{
print_c_string ("-outdated>", printcharfun);
- break;
+ return;
}
printchar (' ', printcharfun);
/* Now the node must be up-to-date, and calling functions like
@@ -2064,11 +2064,16 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
printchar ('-', printcharfun);
print_object (Ftreesit_node_end (obj), printcharfun, escapeflag);
printchar ('>', printcharfun);
+ return;
+#endif
break;
+
case PVEC_TS_COMPILED_QUERY:
+#ifdef HAVE_TREE_SITTER
print_c_string ("#<treesit-compiled-query>", printcharfun);
- break;
+ return;
#endif
+ break;
case PVEC_SQLITE:
{
@@ -2084,13 +2089,23 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
print_c_string (XSQLITE (obj)->name, printcharfun);
printchar ('>', printcharfun);
}
- break;
+ return;
- default:
- emacs_abort ();
+ /* Types handled earlier. */
+ case PVEC_NORMAL_VECTOR:
+ case PVEC_RECORD:
+ case PVEC_COMPILED:
+ case PVEC_CHAR_TABLE:
+ case PVEC_SUB_CHAR_TABLE:
+ case PVEC_HASH_TABLE:
+ case PVEC_BIGNUM:
+ case PVEC_BOOL_VECTOR:
+ /* Impossible cases. */
+ case PVEC_FREE:
+ case PVEC_OTHER:
+ break;
}
-
- return true;
+ emacs_abort ();
}
static char
@@ -2597,29 +2612,21 @@ print_object (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag)
switch (PSEUDOVECTOR_TYPE (XVECTOR (obj)))
{
case PVEC_NORMAL_VECTOR:
- {
- print_stack_push_vector ("[", "]", obj, 0, ASIZE (obj),
- printcharfun);
- goto next_obj;
- }
+ print_stack_push_vector ("[", "]", obj, 0, ASIZE (obj),
+ printcharfun);
+ goto next_obj;
case PVEC_RECORD:
- {
- print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj),
- printcharfun);
- goto next_obj;
- }
+ print_stack_push_vector ("#s(", ")", obj, 0, PVSIZE (obj),
+ printcharfun);
+ goto next_obj;
case PVEC_COMPILED:
- {
- print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj),
- printcharfun);
- goto next_obj;
- }
+ print_stack_push_vector ("#[", "]", obj, 0, PVSIZE (obj),
+ printcharfun);
+ goto next_obj;
case PVEC_CHAR_TABLE:
- {
- print_stack_push_vector ("#^[", "]", obj, 0, PVSIZE (obj),
- printcharfun);
- goto next_obj;
- }
+ print_stack_push_vector ("#^[", "]", obj, 0, PVSIZE (obj),
+ printcharfun);
+ goto next_obj;
case PVEC_SUB_CHAR_TABLE:
{
/* Make each lowest sub_char_table start a new line.
@@ -2688,30 +2695,22 @@ print_object (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag)
goto next_obj;
}
+ case PVEC_BIGNUM:
+ print_bignum (obj, printcharfun);
+ break;
+
+ case PVEC_BOOL_VECTOR:
+ print_bool_vector (obj, printcharfun);
+ break;
+
default:
+ print_vectorlike_unreadable (obj, printcharfun, escapeflag, buf);
break;
}
-
- if (print_vectorlike (obj, printcharfun, escapeflag, buf))
break;
- FALLTHROUGH;
default:
- {
- int len;
- /* We're in trouble if this happens!
- Probably should just emacs_abort (). */
- print_c_string ("#<EMACS BUG: INVALID DATATYPE ", printcharfun);
- if (VECTORLIKEP (obj))
- len = sprintf (buf, "(PVEC 0x%08zx)", (size_t) ASIZE (obj));
- else
- len = sprintf (buf, "(0x%02x)", (unsigned) XTYPE (obj));
- strout (buf, len, len, printcharfun);
- print_c_string ((" Save your buffers immediately"
- " and please report this bug>"),
- printcharfun);
- break;
- }
+ emacs_abort ();
}
print_depth--;
diff --git a/src/process.c b/src/process.c
index 87ccdfda7d6..e49bf812169 100644
--- a/src/process.c
+++ b/src/process.c
@@ -7212,6 +7212,8 @@ If PROCESS is a process object which contains the property
`remote-pid', or PROCESS is a number and REMOTE is a remote file name,
PROCESS is interpreted as process on the respective remote host, which
will be the process to signal.
+If PROCESS is a string, it is interpreted as process object with the
+respective process name, or as a number.
SIGCODE may be an integer, or a symbol whose name is a signal name. */)
(Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
{
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 95c3366652d..cb4fbd58faa 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -2857,6 +2857,9 @@ forall_firstchar_1 (re_char *p, re_char *pend,
else
switch (*p)
{
+ case no_op:
+ p++; continue;
+
/* Cases which stop the iteration. */
case succeed:
case exactn:
@@ -2872,15 +2875,9 @@ forall_firstchar_1 (re_char *p, re_char *pend,
/* Cases which may match the empty string. */
case at_dot:
case begbuf:
- case no_op:
case wordbound:
case notwordbound:
case begline:
- p++;
- continue;
-
- /* Cases which may match the empty string and may
- tell us something about the next char. */
case endline:
case endbuf:
case wordbeg:
@@ -3201,6 +3198,11 @@ analyze_first_fastmap (const re_char *p, void *arg)
}
return true;
+ case at_dot:
+ case begbuf:
+ case wordbound:
+ case notwordbound:
+ case begline:
case endline:
case endbuf:
case wordbeg:
@@ -3244,6 +3246,11 @@ analyze_first_null (const re_char *p, void *arg)
case notcategoryspec:
return true;
+ case at_dot:
+ case begbuf:
+ case wordbound:
+ case notwordbound:
+ case begline:
case endline:
case endbuf:
case wordbeg:
@@ -3983,6 +3990,13 @@ mutually_exclusive_one (re_char *p2, void *arg)
RETURN_CONSTRAIN (*data->p1 == syntaxspec
&& (data->p1[1] == Ssymbol || data->p1[1] == Sword));
+ case at_dot:
+ case begbuf:
+ case wordbound:
+ case notwordbound:
+ case begline:
+ RETURN_CONSTRAIN (false);
+
case duplicate:
/* At this point, we know nothing about what this can match, sadly. */
return false;
diff --git a/src/xdisp.c b/src/xdisp.c
index 6a01c2dfda4..c73e648f2d7 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -18084,7 +18084,8 @@ set_cursor_from_row (struct window *w, struct glyph_row
*row,
else if (dpos == 0)
match_with_avoid_cursor = true;
}
- else if (STRINGP (glyph->object))
+ else if (STRINGP (glyph->object)
+ && !glyph->avoid_cursor_p)
{
Lisp_Object chprop;
ptrdiff_t glyph_pos = glyph->charpos;
@@ -18310,7 +18311,8 @@ set_cursor_from_row (struct window *w, struct glyph_row
*row,
/* Any glyphs that come from the buffer are here because
of bidi reordering. Skip them, and only pay
attention to glyphs that came from some string. */
- if (STRINGP (glyph->object))
+ if (STRINGP (glyph->object)
+ && !glyph->avoid_cursor_p)
{
Lisp_Object str;
ptrdiff_t tem;
diff --git a/src/xfaces.c b/src/xfaces.c
index 296f88527c8..33e6e88bfa4 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3370,12 +3370,13 @@ FRAME 0 means change the face on all frames, and change
the default
if (!CONSP (tem))
break;
v = XCAR (tem);
- tem = XCDR (tem);
if (EQ (k, QCline_width))
{
- if ((!CONSP(v) || !FIXNUMP (XCAR (v)) || XFIXNUM (XCAR (v))
== 0
- || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v))
== 0)
+ if ((!CONSP(v)
+ || !FIXNUMP (XCAR (v))
+ || XFIXNUM (XCAR (v)) == 0
+ || !FIXNUMP (XCDR (v)) || XFIXNUM (XCDR (v)) == 0)
&& (!FIXNUMP (v) || XFIXNUM (v) == 0))
break;
}
@@ -3386,12 +3387,16 @@ FRAME 0 means change the face on all frames, and change
the default
}
else if (EQ (k, QCstyle))
{
- if (!EQ (v, Qpressed_button) && !EQ (v, Qreleased_button)
- && !EQ(v, Qflat_button))
+ if (!NILP (v)
+ && !EQ (v, Qpressed_button)
+ && !EQ (v, Qreleased_button)
+ && !EQ (v, Qflat_button))
break;
}
else
break;
+
+ tem = XCDR (tem);
}
valid_p = NILP (tem);
diff --git a/test/lisp/completion-preview-tests.el
b/test/lisp/completion-preview-tests.el
new file mode 100644
index 00000000000..b5518e96254
--- /dev/null
+++ b/test/lisp/completion-preview-tests.el
@@ -0,0 +1,184 @@
+;;; completion-preview-tests.el --- tests for completion-preview.el -*-
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 'completion-preview)
+
+(defun completion-preview-tests--capf (completions &rest props)
+ (lambda ()
+ (when-let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (append (list (car bounds) (cdr bounds) completions) props))))
+
+(defun completion-preview-tests--check-preview (string &optional exact)
+ "Check that the completion preview is showing STRING.
+
+If EXACT is non-nil, check that STRING has the
+`completion-preview-exact' face. Otherwise check that STRING has
+the `completion-preview' face.
+
+If STRING is nil, check that there is no completion preview
+instead."
+ (if (not string)
+ (should (not completion-preview--overlay))
+ (should completion-preview--overlay)
+ (let ((after-string (completion-preview--get 'after-string)))
+ (should (string= after-string string))
+ (should (eq (get-text-property 0 'face after-string)
+ (if exact
+ 'completion-preview-exact
+ 'completion-preview))))))
+
+(ert-deftest completion-preview ()
+ "Test Completion Preview mode."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf '("foobarbaz"))))
+
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "barbaz" 'exact)
+
+ (insert "v")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; No match, no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+
+ ;; Exact match again
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-multiple-matches ()
+ "Test Completion Preview mode with multiple matching candidates."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, the preview shows the first one
+ (completion-preview-tests--check-preview "bar")
+
+ (completion-preview-next-candidate 1)
+
+ ;; Next match
+ (completion-preview-tests--check-preview "baz")))
+
+(ert-deftest completion-preview-exact-match-only ()
+ "Test `completion-preview-exact-match-only'."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("spam" "foobar" "foobaz")))
+ completion-preview-exact-match-only t)
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, so no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-region (point-min) (point-max))
+ (insert "spa")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "m" 'exact)))
+
+(ert-deftest completion-preview-function-capfs ()
+ "Test Completion Preview mode with capfs that return a function."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () #'ignore)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")))
+
+(ert-deftest completion-preview-non-exclusive-capfs ()
+ "Test Completion Preview mode with non-exclusive capfs."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("spam") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")
+ (setq-local completion-preview-exact-match-only t)
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-face-updates ()
+ "Test updating the face in completion preview when match is no longer exact."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobarbaz" "food"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")
+ (insert "b")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "arbaz" 'exact)
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")))
+
+(ert-deftest completion-preview-capf-errors ()
+ "Test Completion Preview mode with capfs that signal errors.
+
+`dabbrev-capf' is one example of such a capf."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () (user-error "bad"))
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+;;; completion-preview-tests.el ends here
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index c9993341f98..a0507afe833 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -1046,6 +1046,27 @@ Subclasses to override slot attributes."))
(should (eq (eieio-test--struct-a x) 1))
(should-error (setf (slot-value x 'c) 3) :type 'eieio-read-only)))
+(defclass foo-bug-66938 (eieio-instance-inheritor)
+ ((x :initarg :x
+ :accessor ref-x
+ :reader get-x))
+ "A class to test that delegation occurs under certain
+circumstances when using an accessor function, as it would when
+using the reader function.")
+
+(ert-deftest eieio-test-use-accessor-function-with-cloned-object ()
+ "The class FOO-BUG-66938 is a subclass of
+`eieio-instance-inheritor'. Therefore, given an instance OBJ1 of
+FOO-BUG-66938, and a clone (OBJ2), OBJ2 should delegate to OBJ1
+when accessing an unbound slot.
+
+In particular, its behavior should be identical to that of the
+reader function, when reading a slot."
+ (let* ((obj1 (foo-bug-66938 :x 4))
+ (obj2 (clone obj1)))
+ (should (eql (ref-x obj2) 4))
+ (should (eql (get-x obj2) (ref-x obj2)))))
+
(provide 'eieio-tests)
;;; eieio-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-auth-source.el
b/test/lisp/erc/erc-scenarios-auth-source.el
index 641b881666e..7eaf90e1e41 100644
--- a/test/lisp/erc/erc-scenarios-auth-source.el
+++ b/test/lisp/erc/erc-scenarios-auth-source.el
@@ -56,7 +56,7 @@
(should (string= (buffer-name) (if id
(symbol-name id)
(format "127.0.0.1:%d" port))))
- (erc-d-t-wait-for 5 (eq erc-network 'FooNet))))))
+ (erc-d-t-wait-for 10 (eq erc-network 'FooNet))))))
(ert-deftest erc-scenarios-base-auth-source-server--dialed ()
:tags '(:expensive-test)
diff --git a/test/lisp/erc/erc-scenarios-base-buffer-display.el
b/test/lisp/erc/erc-scenarios-base-buffer-display.el
index 6a80baeaaa9..889f274b8b1 100644
--- a/test/lisp/erc/erc-scenarios-base-buffer-display.el
+++ b/test/lisp/erc/erc-scenarios-base-buffer-display.el
@@ -193,7 +193,7 @@
(lambda (_)
(with-current-buffer "FooNet"
- (should erc--server-reconnect-display-timer))
+ (erc-d-t-wait-for 1 erc--server-reconnect-display-timer))
;; A non-interactive JOIN command doesn't signal that we're
;; done auto-reconnecting.
diff --git a/test/lisp/erc/erc-scenarios-base-renick.el
b/test/lisp/erc/erc-scenarios-base-renick.el
index 2bf3ef46257..5a87e5871f7 100644
--- a/test/lisp/erc/erc-scenarios-base-renick.el
+++ b/test/lisp/erc/erc-scenarios-base-renick.el
@@ -173,7 +173,7 @@
(with-current-buffer erc-server-buffer-foo
(should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
- (erc-d-t-wait-for 1 (get-buffer "foonet"))
+ (erc-d-t-wait-for 10 (get-buffer "foonet"))
(ert-info ("Joined by bouncer to #foo, pal persent")
(with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
diff --git a/test/lisp/erc/erc-scenarios-display-message.el
b/test/lisp/erc/erc-scenarios-display-message.el
index 5751a32212d..c7e0c2fc17a 100644
--- a/test/lisp/erc/erc-scenarios-display-message.el
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -57,6 +57,7 @@
(funcall expect 10 "*** dummy (~u@rdjcgiwfuwqmc.irc) has quit")
(should (eq 'QUIT (get-text-property (match-beginning 0) 'erc-msg)))))
- (erc-cmd-QUIT "")))
+ (with-current-buffer "foonet"
+ (erc-cmd-QUIT ""))))
;;; erc-scenarios-display-message.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index bb925eed836..2efcd7ec7fb 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -75,7 +75,7 @@
(ert-info ("All output sent")
(with-current-buffer "#chan/foonet"
- (funcall expect 8 "Some man or other"))
+ (funcall expect 16 "Some man or other"))
(with-current-buffer "#chan/barnet"
(funcall expect 10 "That's he that was Othello")))))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 980928aceac..912a85ad5e0 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -155,7 +155,9 @@
(set-process-query-on-exit-flag erc-server-process nil))
(ert-deftest erc-hide-prompt ()
- (let (erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (let ((erc-hide-prompt erc-hide-prompt)
+ ;;
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
(with-current-buffer (get-buffer-create "ServNet")
(erc-tests--send-prep)
@@ -812,6 +814,8 @@
(should-not calls))))
(ert-deftest erc--channel-modes ()
+ :tags (and (null (getenv "CI")) '(:unstable))
+
(setq erc--isupport-params (make-hash-table)
erc--target (erc--target-from-string "#test")
erc-server-parameters
@@ -827,15 +831,25 @@
(should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
(should (equal (erc--channel-modes 3 ",") "klt h2,3"))
+ ;; The function this tests behaves differently in different
+ ;; environments. For example, on one GNU Linux system, it returns
+ ;; truncation ellipsis when run interactively. Rather than have
+ ;; hard-to-read "nondeterministic" comparisons against sets of
+ ;; acceptable values, we use separate tests.
+ (when (display-graphic-p) (ert-pass))
+
;; Truncation cache populated and used.
(let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
first-run)
(should (zerop (hash-table-count cache)))
(should (equal (erc--channel-modes 1 ",") "klt h,3"))
(should (equal (setq first-run (map-pairs cache)) '(((1 ?k "h2") . "h"))))
+
+ ;; Second call uses cache.
(cl-letf (((symbol-function 'truncate-string-to-width)
(lambda (&rest _) (ert-fail "Shouldn't run"))))
(should (equal (erc--channel-modes 1 ",") "klt h,3")))
+
;; Same key for only entry matches that of first result.
(should (pcase (map-pairs cache)
((and '(((1 ?k "h2") . "h")) second-run)
@@ -847,6 +861,43 @@
(should (equal (erc--channel-modes 1) "klt h 3"))
(should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces
+(ert-deftest erc--channel-modes/graphic-p ()
+ :tags '(:unstable)
+ (unless (display-graphic-p) (ert-skip "See non-/graphic-p variant"))
+
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test")
+ erc-server-parameters
+ '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+
+ (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "hun2"))
+
+ ;; Truncation cache populated and used.
+ (let ((cache (erc--channel-mode-types-shortargs erc--channel-mode-types))
+ first-run)
+ (should (zerop (hash-table-count cache)))
+ (should (equal (erc--channel-modes 2 ",") "klt h…,3" ))
+ (should (equal (setq first-run (map-pairs cache))
+ '(((2 ?k "hun2") . "h…"))))
+
+ ;; Second call uses cache.
+ (cl-letf (((symbol-function 'truncate-string-to-width)
+ (lambda (&rest _) (ert-fail "Shouldn't run"))))
+ (should (equal (erc--channel-modes 2 ",") "klt h…,3" )))
+
+ ;; Same key for only entry matches that of first result.
+ (should (pcase (map-pairs cache)
+ ((and `(((2 ?k "hun2") . "h…")) second-run)
+ (eq (pcase first-run (`((,k . ,_)) k))
+ (pcase second-run (`((,k . ,_)) k)))))))
+
+ ;; A max length of 0 is nonsensical anyway, so skip those.
+ (should (equal (erc--channel-modes 3) "klt hu… 3"))
+ (should (equal (erc--channel-modes 2) "klt h… 3"))
+ (should (equal (erc--channel-modes 1) "klt … 3")))
+
(ert-deftest erc--update-user-modes ()
(let ((erc--user-modes (list ?a)))
(should (equal (erc--update-user-modes "+a") '(?a)))
diff --git a/test/lisp/erc/resources/base/reuse-buffers/server/barnet.eld
b/test/lisp/erc/resources/base/reuse-buffers/server/barnet.eld
index cc7aff10076..5b64a58c98f 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/server/barnet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/server/barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :barnet:changeme"))
-((nick 1 "NICK tester"))
-((user 2 "USER user 0 * :tester")
+((pass 10 "PASS :barnet:changeme"))
+((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 Sun, 25 Apr 2021
11:28:28 UTC")
diff --git a/test/lisp/erc/resources/base/reuse-buffers/server/foonet.eld
b/test/lisp/erc/resources/base/reuse-buffers/server/foonet.eld
index 3a846108466..260ff74c20c 100644
--- a/test/lisp/erc/resources/base/reuse-buffers/server/foonet.eld
+++ b/test/lisp/erc/resources/base/reuse-buffers/server/foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :foonet:changeme"))
+((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 Sun, 25 Apr 2021
11:28:28 UTC")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index 802ccaeedaa..311d8a82d72 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -654,10 +654,17 @@ Bug#48598: 28.0.50; buffer-naming collisions involving
bouncers in ERC."
(with-current-buffer erc-server-buffer-foo (erc-cmd-JOIN "#chan"))
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
(funcall expect 5 "vile thing")
- (erc-cmd-QUIT "")))
+ (erc-cmd-QUIT "")
- (erc-d-t-wait-for 2 "Foonet connection deceased"
- (not (erc-server-process-alive erc-server-buffer-foo)))
+ (ert-info ("Prompt hidden in channel buffer upon quitting")
+ (erc-d-t-wait-for 10 (erc--prompt-hidden-p))
+ (should (overlays-in erc-insert-marker erc-input-marker)))))
+
+ (with-current-buffer erc-server-buffer-foo
+ (ert-info ("Prompt hidden after process dies in server buffer")
+ (erc-d-t-wait-for 2 (not (erc-server-process-alive)))
+ (erc-d-t-wait-for 10 (erc--prompt-hidden-p))
+ (should (overlays-in erc-insert-marker erc-input-marker))))
(should (equal erc-autojoin-channels-alist
(if foo-id '((oofnet "#chan")) '((foonet "#chan")))))
@@ -706,6 +713,10 @@ Bug#48598: 28.0.50; buffer-naming collisions involving
bouncers in ERC."
(setq erc-server-process-foo erc-server-process)
(erc-d-t-wait-for 2 (eq erc-network 'foonet))
(should (string= (buffer-name) (if foo-id "oofnet" "foonet")))
+
+ (ert-info ("Prompt unhidden")
+ (should-not (erc--prompt-hidden-p))
+ (should-not (overlays-in erc-insert-marker erc-input-marker)))
(funcall expect 5 "foonet")))
(ert-info ("#chan@foonet is clean, no cross-contamination")
@@ -713,7 +724,11 @@ Bug#48598: 28.0.50; buffer-naming collisions involving
bouncers in ERC."
(erc-d-t-wait-for 3 (eq erc-server-process erc-server-process-foo))
(funcall expect 3 "<bob>")
(erc-d-t-absent-for 0.1 "<joe>")
- (funcall expect 20 "not given me")))
+ (funcall expect 30 "not given me")
+
+ (ert-info ("Prompt unhidden")
+ (should-not (erc--prompt-hidden-p))
+ (should-not (overlays-in erc-insert-marker erc-input-marker)))))
(ert-info ("All #chan@barnet output received")
(with-current-buffer chan-buf-bar
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 418ae61bb42..66240efd882 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -465,6 +465,9 @@
(should (eq (dbus-unregister-service bus dbus--test-service) :non-existent))
(should-not (member dbus--test-service (dbus-list-known-names bus)))
+ ;; Unregistering a unique name returns nil.
+ (should-not (dbus-unregister-service bus ":1.1"))
+
;; A service name is a string, constructed of at least two words
;; separated by ".".
(should
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 726403f193c..d8932a28e4d 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -5684,55 +5684,69 @@ If UNSTABLE is non-nil, the test is tagged as
`:unstable'."
(delete-exited-processes t)
kill-buffer-query-functions command proc)
- (dolist (sigcode '(2 INT))
- (unwind-protect
- (with-temp-buffer
- (setq command "trap 'echo boom; exit 1' 2; sleep 100"
- proc (start-file-process-shell-command
- (format "test1%s" sigcode) (current-buffer) command))
- (should (processp proc))
- (should (process-live-p proc))
- (should (equal (process-status proc) 'run))
- (should (numberp (process-get proc 'remote-pid)))
- (should (equal (process-get proc 'remote-command)
- (with-connection-local-variables
- `(,shell-file-name ,shell-command-switch
,command))))
- (should (zerop (signal-process proc sigcode)))
- ;; Let the process accept the signal.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (should-not (process-live-p proc)))
+ ;; If PROCESS is a string, it must be a process name or a process
+ ;; number. Check error handling.
+ (should-error
+ (signal-process (md5 (current-time-string)) 0)
+ :type 'wrong-type-argument)
+
+ ;; The PROCESS argument of `signal-process' can be a string. Test
+ ;; this as well.
+ (dolist
+ (func '(identity
+ (lambda (x) (format "%s" (if (processp x) (process-name x)
x)))))
+ (dolist (sigcode '(2 INT))
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test1-%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
+ (should
+ (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
+ (should (zerop (signal-process (funcall func proc) sigcode)))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
- ;; Cleanup.
- (ignore-errors (kill-process proc))
- (ignore-errors (delete-process proc)))
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc)))
- (unwind-protect
- (with-temp-buffer
- (setq command "trap 'echo boom; exit 1' 2; sleep 100"
- proc (start-file-process-shell-command
- (format "test2%s" sigcode) (current-buffer) command))
- (should (processp proc))
- (should (process-live-p proc))
- (should (equal (process-status proc) 'run))
- (should (numberp (process-get proc 'remote-pid)))
- (should (equal (process-get proc 'remote-command)
- (with-connection-local-variables
- `(,shell-file-name ,shell-command-switch
,command))))
- ;; `signal-process' has argument REMOTE since Emacs 29.
- (with-no-warnings
+ (unwind-protect
+ (with-temp-buffer
+ (setq command "trap 'echo boom; exit 1' 2; sleep 100"
+ proc (start-file-process-shell-command
+ (format "test2-%s" sigcode) (current-buffer) command))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
(should
- (zerop
- (signal-process
- (process-get proc 'remote-pid) sigcode default-directory))))
- ;; Let the process accept the signal.
- (with-timeout (10 (tramp--test-timeout-handler))
- (while (accept-process-output proc 0 nil t)))
- (should-not (process-live-p proc)))
+ (equal (process-get proc 'remote-command)
+ (with-connection-local-variables
+ `(,shell-file-name ,shell-command-switch ,command))))
+ ;; `signal-process' has argument REMOTE since Emacs 29.
+ (with-no-warnings
+ (should
+ (zerop
+ (signal-process
+ (funcall func (process-get proc 'remote-pid))
+ sigcode default-directory))))
+ ;; Let the process accept the signal.
+ (with-timeout (10 (tramp--test-timeout-handler))
+ (while (accept-process-output proc 0 nil t)))
+ (should-not (process-live-p proc)))
- ;; Cleanup.
- (ignore-errors (kill-process proc))
- (ignore-errors (delete-process proc))))))
+ ;; Cleanup.
+ (ignore-errors (kill-process proc))
+ (ignore-errors (delete-process proc)))))))
(ert-deftest tramp-test31-list-system-processes ()
"Check `list-system-processes'."
diff --git a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
index 221b3d809af..bac76fb7378 100644
--- a/test/lisp/progmodes/c-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/c-ts-mode-resources/indent.erts
@@ -149,6 +149,21 @@ for (int i = 0;
Name: Bracketless Simple Statement
+=-=
+for (int i = 0; i < 5; i++)
+continue;
+
+while (true)
+return 1;
+
+do
+i++;
+while (true)
+
+if (true)
+break;
+else
+break;
=-=
for (int i = 0; i < 5; i++)
continue;
@@ -159,6 +174,11 @@ while (true)
do
i++;
while (true)
+
+if (true)
+ break;
+else
+ break;
=-=-=
Name: Nested If-Else
diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
index 20f423259b4..7b6185e0386 100644
--- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
@@ -45,6 +45,23 @@ const foo = () => {
};
=-=-=
+Name: Switch statement
+
+=-=
+const foo = (x: string) => {
+ switch (x) {
+ case "a":
+ console.log(x);
+ return 1;
+ case "b":
+ return 2;
+ case "c":
+ default:
+ return 0;
+ }
+};
+=-=-=
+
Code:
(lambda ()
(setq indent-tabs-mode nil)
diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el
deleted file mode 100644
index 6283d1c31e0..00000000000
--- a/test/lisp/register-tests.el
+++ /dev/null
@@ -1,43 +0,0 @@
-;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*-
-
-;; Copyright (C) 2017-2023 Free Software Foundation, Inc.
-
-;; Author: Tino Calancha <tino.calancha@gmail.com>
-;; Keywords:
-
-;; 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 'ert)
-(require 'cl-lib)
-
-(ert-deftest register-test-bug27634 ()
- "Test for https://debbugs.gnu.org/27634 ."
- (dolist (event (list ?\C-g 'escape ?\C-\[))
- (cl-letf (((symbol-function 'read-key) #'ignore)
- (last-input-event event)
- (register-alist nil))
- (should (equal 'quit
- (condition-case err
- (call-interactively 'point-to-register)
- (quit (car err)))))
- (should-not register-alist))))
-
-(provide 'register-tests)
-;;; register-tests.el ends here