[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/pkg 29493889ecd: Merge remote-tracking branch 'origin/master' in
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/pkg 29493889ecd: Merge remote-tracking branch 'origin/master' into scratch/pkg |
|
Date: |
Sat, 25 Nov 2023 02:56:54 -0500 (EST) |
branch: scratch/pkg
commit 29493889ecdbf36b218133c3dee8a93d7e49f841
Merge: 5db5f285f0f b4be1027a73
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into scratch/pkg
---
configure.ac | 68 +-
doc/emacs/android.texi | 6 +-
doc/emacs/basic.texi | 25 +-
doc/emacs/cmdargs.texi | 3 +
doc/emacs/commands.texi | 2 +
doc/emacs/display.texi | 7 +-
doc/emacs/emacs.texi | 12 +-
doc/emacs/frames.texi | 15 +-
doc/emacs/input.texi | 145 ++--
doc/emacs/misc.texi | 5 +-
doc/emacs/programs.texi | 11 +
doc/emacs/search.texi | 7 +-
doc/emacs/windows.texi | 2 +-
doc/lispintro/emacs-lisp-intro.texi | 11 +-
doc/lispref/commands.texi | 52 +-
doc/lispref/control.texi | 26 +-
doc/lispref/debugging.texi | 30 +-
doc/lispref/frames.texi | 4 +-
doc/lispref/minibuf.texi | 3 +
doc/lispref/modes.texi | 42 +-
doc/lispref/objects.texi | 29 +-
doc/lispref/os.texi | 43 +-
doc/lispref/text.texi | 6 +-
doc/lispref/tips.texi | 26 +-
doc/misc/cc-mode.texi | 7 +
doc/misc/eglot.texi | 6 +-
doc/misc/erc.texi | 9 +-
doc/misc/org.org | 10 +-
etc/ERC-NEWS | 159 ++--
etc/NEWS | 179 ++--
etc/NEWS.29 | 5 +
etc/PROBLEMS | 31 +
etc/TODO | 49 +-
etc/images/gnus/gnus-pointer.svg | 94 ++
etc/refcards/orgcard.tex | 2 +-
java/org/gnu/emacs/EmacsApplication.java | 73 +-
java/org/gnu/emacs/EmacsOpenActivity.java | 13 +-
java/org/gnu/emacs/EmacsService.java | 156 +++-
java/org/gnu/emacs/EmacsWindow.java | 41 +-
lisp/abbrev.el | 39 +-
lisp/align.el | 5 +-
lisp/bindings.el | 16 +
lisp/button.el | 2 +-
lisp/calc/calc.el | 2 +-
lisp/calendar/todo-mode.el | 241 +++---
lisp/cedet/mode-local.el | 65 +-
lisp/cedet/semantic/db.el | 2 +-
lisp/cedet/semantic/grammar.el | 2 +-
lisp/cedet/semantic/lex-spp.el | 6 +-
lisp/cedet/semantic/wisent/python.el | 25 +-
lisp/cedet/srecode/find.el | 64 +-
lisp/cedet/srecode/map.el | 2 +-
lisp/cedet/srecode/table.el | 51 +-
lisp/completion-preview.el | 337 ++++++++
lisp/dired-aux.el | 117 +--
lisp/dired-x.el | 32 +-
lisp/dired.el | 200 +++--
lisp/doc-view.el | 2 +-
lisp/edmacro.el | 13 +-
lisp/emacs-lisp/advice.el | 3 -
lisp/emacs-lisp/byte-opt.el | 57 +-
lisp/emacs-lisp/cl-extra.el | 11 +-
lisp/emacs-lisp/cl-generic.el | 7 +-
lisp/emacs-lisp/cl-macs.el | 17 +-
lisp/emacs-lisp/cl-preloaded.el | 12 +-
lisp/emacs-lisp/comp-common.el | 5 +-
lisp/emacs-lisp/debug.el | 7 +
lisp/emacs-lisp/derived.el | 4 +-
lisp/emacs-lisp/easy-mmode.el | 2 +-
lisp/emacs-lisp/eieio-core.el | 61 +-
lisp/emacs-lisp/find-func.el | 25 +-
lisp/emacs-lisp/map-ynp.el | 10 +-
lisp/emacs-lisp/nadvice.el | 18 -
lisp/emacs-lisp/package.el | 4 +-
lisp/emacs-lisp/pcase.el | 10 +
lisp/emacs-lisp/shortdoc.el | 2 +-
lisp/emacs-lisp/subr-x.el | 7 +-
lisp/emulation/viper.el | 10 +-
lisp/erc/erc-backend.el | 83 +-
lisp/erc/erc-button.el | 4 +-
lisp/erc/erc-common.el | 18 +
lisp/erc/erc-compat.el | 20 +
lisp/erc/erc-fill.el | 152 +++-
lisp/erc/erc-goodies.el | 129 ++-
lisp/erc/erc-match.el | 14 +-
lisp/erc/erc-networks.el | 2 +-
lisp/erc/erc-nicks.el | 89 +-
lisp/erc/erc-speedbar.el | 59 +-
lisp/erc/erc-stamp.el | 44 +-
lisp/erc/erc-status-sidebar.el | 6 +-
lisp/erc/erc.el | 809 +++++++++++++++---
lisp/eshell/em-hist.el | 49 +-
lisp/eshell/esh-proc.el | 2 +-
lisp/files.el | 25 +-
lisp/gnus/gnus.el | 15 +-
lisp/gnus/message.el | 4 +-
lisp/help-fns.el | 3 +-
lisp/ibuf-ext.el | 31 +-
lisp/info-look.el | 28 +-
lisp/international/emoji.el | 8 +-
lisp/international/iso-transl.el | 2 +
lisp/isearch.el | 18 +-
lisp/leim/quail/hangul.el | 43 +-
lisp/leim/quail/pakistan.el | 726 ++++++++++++++++
lisp/loadhist.el | 10 +-
lisp/locate.el | 52 +-
lisp/mail/emacsbug.el | 2 +-
lisp/minibuffer.el | 87 +-
lisp/net/tramp-adb.el | 17 +-
lisp/net/tramp-crypt.el | 2 +-
lisp/net/tramp-fuse.el | 18 +-
lisp/net/tramp-gvfs.el | 6 +-
lisp/net/tramp-integration.el | 4 +-
lisp/net/tramp-sh.el | 110 +--
lisp/net/tramp-smb.el | 19 +-
lisp/net/tramp-sudoedit.el | 20 +-
lisp/net/tramp.el | 179 ++--
lisp/org/ob-core.el | 10 +-
lisp/org/ob-shell.el | 12 +-
lisp/org/ol-info.el | 14 +-
lisp/org/org-agenda.el | 10 +
lisp/org/org-version.el | 4 +-
lisp/org/org.el | 2 +-
lisp/org/ox.el | 28 +-
lisp/progmodes/bug-reference.el | 43 +-
lisp/progmodes/c-ts-mode.el | 4 +-
lisp/progmodes/cc-engine.el | 209 +++--
lisp/progmodes/cmake-ts-mode.el | 14 +-
lisp/progmodes/cperl-mode.el | 31 +-
lisp/progmodes/eglot.el | 6 +-
lisp/progmodes/elixir-ts-mode.el | 12 +
lisp/progmodes/gdb-mi.el | 15 +-
lisp/progmodes/idlwave.el | 4 +-
lisp/progmodes/lua-ts-mode.el | 20 +-
lisp/progmodes/project.el | 39 +-
lisp/progmodes/python.el | 8 +-
lisp/progmodes/tcl.el | 4 +-
lisp/progmodes/typescript-ts-mode.el | 5 +
lisp/replace.el | 5 +-
lisp/simple.el | 24 +-
lisp/so-long.el | 5 +-
lisp/sqlite.el | 21 +-
lisp/startup.el | 10 +-
lisp/subr.el | 194 ++++-
lisp/term/android-win.el | 86 ++
lisp/textmodes/ispell.el | 3 +-
lisp/textmodes/tex-mode.el | 1 +
lisp/thingatpt.el | 14 +-
lisp/touch-screen.el | 943 +++++++++++++++------
lisp/transient.el | 5 +-
lisp/treesit.el | 14 +-
lisp/url/url-irc.el | 14 +-
lisp/userlock.el | 3 +-
lisp/vc/vc-git.el | 4 +-
lisp/vc/vc-hg.el | 4 +-
lisp/vc/vc-hooks.el | 12 +-
lisp/vc/vc.el | 12 +-
lisp/wdired.el | 2 +-
lisp/whitespace.el | 4 +-
lisp/wid-edit.el | 2 +-
lisp/window.el | 6 +-
src/android.c | 57 +-
src/android.h | 4 +
src/androidfns.c | 46 +
src/androidterm.c | 4 +-
src/editfns.c | 5 +-
src/eval.c | 8 +-
src/fileio.c | 2 +-
src/fns.c | 2 +-
src/haikufns.c | 5 +
src/image.c | 1 +
src/keyboard.c | 2 +-
src/module-env-30.h | 6 +-
src/nsfns.m | 5 +
src/pgtkfns.c | 5 +
src/search.c | 18 +-
src/sfntfont.c | 18 +-
src/sqlite.c | 2 +
src/w32fns.c | 5 +
src/xdisp.c | 26 +-
src/xfns.c | 5 +
test/lisp/emacs-lisp/bytecomp-tests.el | 10 +
test/lisp/erc/erc-fill-tests.el | 21 +-
test/lisp/erc/erc-nicks-tests.el | 79 +-
test/lisp/erc/erc-scenarios-base-chan-modes.el | 84 ++
.../erc/erc-scenarios-base-misc-regressions.el | 44 -
test/lisp/erc/erc-scenarios-base-send-message.el | 126 +++
test/lisp/erc/erc-scenarios-display-message.el | 2 -
test/lisp/erc/erc-scenarios-misc-commands.el | 94 ++
test/lisp/erc/erc-scenarios-prompt-format.el | 117 +++
test/lisp/erc/erc-tests.el | 318 ++++++-
.../erc/resources/base/assoc/reconplay/foonet.eld | 2 +-
.../resources/base/display-message/multibuf.eld | 2 +-
.../lisp/erc/resources/base/modes/chan-changed.eld | 55 ++
.../resources/base/send-message/noncommands.eld | 52 ++
.../erc/resources/{base => }/commands/motd.eld | 0
test/lisp/erc/resources/commands/squery.eld | 31 +
.../snapshots/merge-wrap-indicator-post-01.eld | 1 +
.../fill/snapshots/merge-wrap-indicator-pre-01.eld | 1 +
test/lisp/eshell/em-hist-tests.el | 93 +-
test/lisp/files-tests.el | 25 +
test/lisp/isearch-tests.el | 151 ++++
test/lisp/minibuffer-tests.el | 16 +-
test/lisp/net/tramp-tests.el | 10 +-
test/lisp/progmodes/bug-reference-tests.el | 15 +
.../typescript-ts-mode-resources/indent.erts | 22 +
test/lisp/subr-tests.el | 38 +-
test/src/search-tests.el | 38 +
208 files changed, 7165 insertions(+), 2208 deletions(-)
diff --git a/configure.ac b/configure.ac
index 4456cd89b7a..debc6d1078f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1320,6 +1320,7 @@ if test "$ANDROID" = "yes"; then
with_mailutils=no
with_pop=no
with_harfbuzz=no
+ with_native_compilation=no
fi
with_rsvg=no
@@ -1693,7 +1694,7 @@ AC_ARG_WITH([native-compilation],
*) AC_MSG_ERROR([bad value $withval for native-compilation option])
;;
esac
with_native_compilation=$withval],
- [with_native_compilation=no]
+ [with_native_compilation=default]
)
AC_SUBST([NATIVE_COMPILATION_AOT])
@@ -5077,20 +5078,20 @@ AC_DEFUN([libgccjit_smoke_test], [
return 0;
}]])])
-AC_DEFUN([libgccjit_not_found], [
+AC_DEFUN([libgccjit_not_found_err], [
AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit was not
found.
Please try installing libgccjit or a similar package.
If you are sure you want Emacs be compiled without ELisp native compiler,
pass the --without-native-compilation option to configure.])])
-AC_DEFUN([libgccjit_dev_not_found], [
+AC_DEFUN([libgccjit_dev_not_found_err], [
AC_MSG_ERROR([ELisp native compiler was requested, but libgccjit header
files were
not found.
Please try installing libgccjit-dev or a similar package.
If you are sure you want Emacs be compiled without ELisp native compiler,
pass the --without-native-compilation option to configure.])])
-AC_DEFUN([libgccjit_broken], [
+AC_DEFUN([libgccjit_broken_err], [
AC_MSG_ERROR([The installed libgccjit failed to compile and run a test
program using
the libgccjit library; see config.log for the details of the failure.
The test program can be found here:
@@ -5115,6 +5116,50 @@ If you really want to try it anyway, use the configure
option
fi
fi
+AC_DEFUN([libgccjit_not_found], [
+ AC_MSG_WARN([Elisp native compiler can't be enabled as libgccjit was not
+found.
+Please try installing libgccjit or a similar package if you want to have it
+enabled.])
+
+ with_native_compilation=no
+])
+
+AC_DEFUN([libgccjit_dev_not_found], [
+ AC_MSG_WARN([Elisp native compiler can't be enabled as libgccjit header files
+were not found.
+Please try installing libgccjit-dev or a similar package if you want to have it
+enabled.])
+
+ with_native_compilation=no
+])
+
+AC_DEFUN([libgccjit_broken], [
+ AC_MSG_WARN([Elisp native compiler can't be enabled as the installed
libgccjit
+failed to compile and run a test program using the libgccjit library; see
+config.log for the details of the failure.
+The test program can be found here:
+<https://gcc.gnu.org/onlinedocs/jit/intro/tutorial01.html>.
+You can try compiling it yourself to investigate the issues.
+Please report the issue to your distribution if libgccjit was installed
+through that.
+You can find the instructions on how to compile and install libgccjit from
+source on this site:
+<https://gcc.gnu.org/wiki/JIT>.])
+
+ with_native_compilation=no])
+
+if test "${with_native_compilation}" = "default"; then
+ # Check if libgccjit is available.
+ AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire],
+ [], [libgccjit_not_found])
+ AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found])
+ if test "${with_native_compilation}" != "no"; then
+ # Check if libgccjit really works.
+ AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken])
+ fi
+fi
+
if test "${with_native_compilation}" != "no"; then
if test "$with_unexec" = yes; then
AC_MSG_ERROR(['--with-native-compilation' is not compatible with
unexec])
@@ -5162,12 +5207,15 @@ if test "${with_native_compilation}" != "no"; then
fi
fi
- # Check if libgccjit is available.
- AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire],
- [], [libgccjit_not_found])
- AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found])
- # Check if libgccjit really works.
- AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken])
+ # In the default case we already checked
+ if test "${with_native_compilation}" != "default"; then
+ # Check if libgccjit is available.
+ AC_CHECK_LIB([gccjit], [gcc_jit_context_acquire],
+ [], [libgccjit_not_found_err])
+ AC_CHECK_HEADERS([libgccjit.h], [], [libgccjit_dev_not_found_err])
+ # Check if libgccjit really works.
+ AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken_err])
+ fi
HAVE_NATIVE_COMP=yes
case "${opsys}" in
# mingw32 loads the library dynamically.
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 161712493a6..915ba948b93 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -9,9 +9,9 @@
Alliance. This section describes the peculiarities of using Emacs on
an Android device running Android 2.2 or later.
- Android devices commonly rely on user input through a touch screen
-or digitizer device and on-screen keyboard. For more information
-about using such devices with Emacs, @pxref{Other Input Devices}.
+ Android devices commonly rely a touch screen or digitizer device and
+virtual keyboard for user input. For more information about using
+such devices with Emacs, @pxref{Other Input}.
@menu
* What is Android?:: Preamble.
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index a271cb65bdc..d41e5f2f16c 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -360,15 +360,15 @@ preserve the horizontal position, as usual.
@vindex line-move-visual
When a line of text in the buffer is longer than the width of the
-window, Emacs usually displays it on two or more @dfn{screen lines}.
-For convenience, @kbd{C-n} and @kbd{C-p} move point by screen lines,
-as do the equivalent keys @kbd{@key{down}} and @kbd{@key{up}}. You
-can force these commands to move according to @dfn{logical lines}
-(i.e., according to the text lines in the buffer) by setting the
-variable @code{line-move-visual} to @code{nil}; if a logical line
-occupies multiple screen lines, the cursor then skips over the
-additional screen lines. For details, see @ref{Continuation Lines}.
-@xref{Variables}, for how to set variables such as
+window, Emacs usually displays it on two or more @dfn{screen lines},
+a.k.a.@: @dfn{visual lines}. For convenience, @kbd{C-n} and @kbd{C-p}
+move point by screen lines, as do the equivalent keys @kbd{@key{down}}
+and @kbd{@key{up}}. You can force these commands to move according to
+@dfn{logical lines} (i.e., according to the text lines in the buffer)
+by setting the variable @code{line-move-visual} to @code{nil}; if a
+logical line occupies multiple screen lines, the cursor then skips
+over the additional screen lines. For details, see @ref{Continuation
+Lines}. @xref{Variables}, for how to set variables such as
@code{line-move-visual}.
Unlike @kbd{C-n} and @kbd{C-p}, most of the Emacs commands that work
@@ -596,10 +596,13 @@ lines, if any exists.
@cindex wrapping
@cindex line wrapping
@cindex fringes, and continuation lines
+@cindex logical line
+@cindex screen line
+@cindex visual line
Sometimes, a line of text in the buffer---a @dfn{logical line}---is
too long to fit in the window, and Emacs displays it as two or more
-@dfn{screen lines}. This is called @dfn{line wrapping} or
-@dfn{continuation}, and the long logical line is called a
+@dfn{screen lines}, or @dfn{visual lines}. This is called @dfn{line
+wrapping} or @dfn{continuation}, and the long logical line is called a
@dfn{continued line}. On a graphical display, Emacs indicates line
wrapping with small bent arrows in the left and right window fringes.
On a text terminal, Emacs indicates line wrapping by displaying a
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 9514e3414e1..38e683bd7f5 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -309,6 +309,9 @@ This is like @samp{--script}, but suppresses loading the
init files
reaches the end of the script, it exits Emacs and uses the value of
the final form as the exit value from the script (if the final value
is numerical). Otherwise, it will always exit with a zero value.
+Note that when Emacs reads the Lisp code in this case, it ignores any
+file-local variables (@pxref{Specifying File Variables}), both in the
+first line and in a local-variables section near the end of the file.
@item --no-build-details
@opindex --no-build-details
diff --git a/doc/emacs/commands.texi b/doc/emacs/commands.texi
index 98f0610ee44..cb924519175 100644
--- a/doc/emacs/commands.texi
+++ b/doc/emacs/commands.texi
@@ -227,6 +227,8 @@ until you are interested in customizing them. Then read
the basic
information on variables (@pxref{Variables}) and the information about
specific variables will make sense.
+@include input.texi
+
@ifnottex
@lowersections
@end ifnottex
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index cc178dbe99f..d9da4c1335c 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -2010,9 +2010,10 @@ line truncation. @xref{Split Window}, for the variable
@section Visual Line Mode
@cindex word wrap
- Another alternative to ordinary line continuation is to use
-@dfn{word wrap}. Here, each long logical line is divided into two or
-more screen lines, like in ordinary line continuation. However, Emacs
+ Another alternative to ordinary line continuation
+(@pxref{Continuation Lines}) is to use @dfn{word wrap}. Here, each
+long logical line is divided into two or more screen lines, or
+``visual lines'', like in ordinary line continuation. However, Emacs
attempts to wrap the line at word boundaries near the right window
edge. (If the line's direction is right-to-left, it is wrapped at the
left window edge instead.) This makes the text easier to read, as
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index da9696dfa4b..e1c55c0719e 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -149,6 +149,7 @@ Important General Concepts
editing action.
* Mouse Input:: Using the mouse and keypads.
* Commands:: Named functions run by key sequences to do editing.
+* Other Input:: Input besides the mouse, keyboard and keypads.
* Entering Emacs:: Starting Emacs from the shell.
* Exiting:: Stopping or killing Emacs.
@@ -224,7 +225,6 @@ Appendices
* Haiku:: Using Emacs on Haiku.
* Android:: Using Emacs on Android.
* Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS.
-* Other Input Devices:: Using Emacs with other input devices.
* Manifesto:: What's GNU? Gnu's Not Unix!
* Glossary:: Terms used in this manual.
@@ -258,6 +258,10 @@ The Organization of the Screen
* Mode Line:: Interpreting the mode line.
* Menu Bar:: How to use the menu bar.
+Touchscreen Input and Virtual Keyboards
+* Touchscreens:: Interacting with Emacs from touchscreens.
+* On-Screen Keyboards:: Text input with virtual keyboards.
+
Basic Editing Commands
* Inserting Text:: Inserting text by simply typing it.
@@ -1274,11 +1278,6 @@ Emacs and Android
* Android Troubleshooting:: Dealing with problems.
* Android Software:: Getting extra software.
-Emacs and Unconventional Input Devices
-
-* Touchscreens:: Using Emacs on touchscreens.
-* On-Screen Keyboards:: Using Emacs with virtual keyboards.
-
Emacs and Microsoft Windows/MS-DOS
* Windows Startup:: How to start Emacs on Windows.
@@ -1652,7 +1651,6 @@ Lisp programming.
@include android.texi
@c Includes msdos-xtra.
@include msdos.texi
-@include input.texi
@include gnu.texi
@include glossary.texi
@ifnottex
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index e2e30408a65..1862ed2d5d4 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1586,14 +1586,13 @@ the items that operate on the clicked tab. Dragging
the tab with
wheel scrolling switches to the next or previous tab. Holding down
the @key{SHIFT} key during scrolling moves the tab to the left or right.
- Touch screen input (@pxref{Other Input Devices}) can also be used to
-operate on tabs. Long-pressing (@pxref{Touchscreens}) a tab will
-display a context menu with items that operate on the tab that was
-pressed, and long-pressing the tab bar itself will display a context
-menu which lets you create and remove tabs; tapping a tab itself will
-result in that tab's window configuration being selected, and tapping
-a button on the tab bar will behave as if it was clicked with
-@kbd{mouse-1}.
+ Touch screen input (@pxref{Other Input}) can also be used to operate
+on tabs. Long-pressing (@pxref{Touchscreens}) a tab will display a
+context menu with items that operate on the tab that was pressed, and
+long-pressing the tab bar itself will display a context menu which
+lets you create and remove tabs; tapping a tab itself will result in
+that tab's window configuration being selected, and tapping a button
+on the tab bar will behave as if it was clicked with @kbd{mouse-1}.
@findex tab-bar-history-mode
You can enable @code{tab-bar-history-mode} to remember window
diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi
index 0dd7fca41cc..7f9d37b52de 100644
--- a/doc/emacs/input.texi
+++ b/doc/emacs/input.texi
@@ -1,26 +1,27 @@
@c This is part of the Emacs manual.
@c Copyright (C) 2023 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
-@node Other Input Devices
-@appendix Emacs and Unconventional Input Devices
+@node Other Input
+@section Touchscreen Input and Virtual Keyboards
@cindex other input devices
- Emacs was originally developed with the assumption that its users
-have access to a desktop computer or computer terminal, with a
-keyboard and perhaps a suitable pointing device such as a mouse.
+ Emacs was first written assuming that its users were to use it from
+a desktop computer or computer terminal, equipped with a keyboard and
+perhaps a suitable pointing device such as a mouse (@pxref{Mouse
+Input}).
- However, recent developments in the X Window System and operating
-systems such as Android mean that this assumption no longer holds
-true. Emacs supports input from various other kinds of input devices,
-which is detailed here.
+ Emacs is also capable of receiving input from alternative sources of
+input, enabling users to interact with it even if it is installed on a
+computer that substitutes such input sources for the customary
+combination of keyboard and mouse.
@menu
-* Touchscreens:: Using Emacs on touchscreens.
-* On-Screen Keyboards:: Using Emacs with virtual keyboards.
+* Touchscreens:: Interacting with Emacs from touchscreens.
+* On-Screen Keyboards:: Text input with virtual keyboards.
@end menu
@node Touchscreens
-@section Using Emacs on Touchscreens
+@subsection Using Emacs on Touchscreens
@cindex touchscreen input
Touchscreen input is the manipulation of a frame's contents by the
@@ -28,9 +29,11 @@ placement and motion of tools (instanced by fingers and such
pointing
devices as styluses) on a monitor or computer terminal where it is
displayed.
- Under the X Window System or Android, Emacs detects and translates
-the following sequences of movements (@dfn{gestures}) to common
-actions:
+ Two factors, the order and position on which such tools are placed,
+are compared against predefined patterns dubbed @dfn{gestures}, after
+which any gesture those factors align with designates a series of
+actions to be taken on the text beneath the tools; the gestures
+presently recognized are:
@itemize @bullet
@item
@@ -88,6 +91,13 @@ indicating the position of the point within the echo area.
If
surrounding point is displayed in the echo area (@pxref{Echo Area})
during the motion of the tool, below which is another line indicating
the position of point relative to the first.
+
+@item
+@cindex pinching, touchscreens
+ @dfn{Pinching}, the placement of two tools apart on the screen
+followed by adjustments to their position such as to increase or
+decrease the distance between them will modify the text scale
+(@pxref{Text Scale}) in proportion to the change in that distance.
@end itemize
@vindex touch-screen-delay
@@ -96,84 +106,87 @@ upon the screen exceeds 0.7 seconds. This delay can be
adjusted
through customizing the variable @code{touch-screen-delay}.
@node On-Screen Keyboards
-@section Using Emacs with Virtual Keyboards
+@subsection Using Emacs with Virtual Keyboards
@cindex virtual keyboards
@cindex on-screen keyboards
- When there is no physical keyboard attached to a system, the
-windowing system typically provides an on-screen keyboard, more often
-known as a ``virtual keyboard'', containing rows of clickable buttons
-that send keyboard input to the application, much like a real keyboard
-would. This virtual keyboard is hidden by default, as it uses up
-valuable on-screen real estate, and must be opened once the program
-being used is ready to accept keyboard input.
-
- Under the X Window System, the client that provides the on-screen
-keyboard typically detects when the application is ready to accept
-keyboard input through a set of complex heuristics, and automatically
-displays the keyboard when necessary.
+ When there is no physical keyboard attached to a system, its
+windowing system might provide an on-screen keyboard, widely known as
+a ``virtual keyboard'', containing rows of clickable buttons that send
+keyboard input to the application, much as a real keyboard would.
- On other systems such as Android, Emacs must tell the system when it
-is ready to accept keyboard input. Typically, this is done in
-response to a touchscreen ``tap'' gesture (@pxref{Touchscreens}), or
-once to the minibuffer becomes in use (@pxref{Minibuffer}.)
+ This virtual keyboard is hidden when the focused program is not
+requesting text input as it occupies scarce space on display, and
+programs are therefore enjoined to display it once they are ready to
+accept keyboard input. Systems running X detect when the presence of
+the virtual keyboard is warranted, but on others such as Android Emacs
+is responsible for displaying it when need be, generally in reaction
+to a touch screen ``tap'' gesture (@pxref{Touchscreens}) or the
+minibuffer being brought into use (@pxref{Minibuffer}).
@vindex touch-screen-set-point-commands
When a ``tap'' gesture results in a command being executed, Emacs
-checks to see whether or not the command is supposed to set the point
-by looking for it in the list @code{touch-screen-set-point-commands}.
-If it is, then Emacs looks up whether or not the text under the point
-is read-only; if not, it activates the on-screen keyboard, assuming
-that the user is about to enter text in to the current buffer.
+checks whether the command is meant to set the point by searching for
+it in the list @code{touch-screen-set-point-commands}. If it is and
+the text beneath the new point is not read-only, it activates the
+virtual keyboard, in anticipation that the user is about to enter text
+there.
-@vindex touch-screen-display-keyboard
- The user option @code{touch-screen-display-keyboard} forces Emacs to
-always display the on screen keyboard; it may also be set buffer
-locally, which means that Emacs should always display the keyboard
-when the buffer is selected.
+ The default value of @code{touch-screen-set-point-commands} holds
+only the command @code{mouse-set-point} (@pxref{Mouse Commands}),
+which is the default binding of @code{mouse-1}, and thus of
+touchscreen tap gestures as well.
- Emacs also provides a set of functions to show or hide the on-screen
-keyboard. For more details, @pxref{On-Screen Keyboards,,, elisp, The
+@vindex touch-screen-display-keyboard
+ The user option @code{touch-screen-display-keyboard} compels Emacs
+to display the virtual keyboard on such taps even if the text is read
+only; it may also be set buffer locally, in which case Emacs will
+always display the keyboard in response to a tap on a window
+displaying the buffer it is set in.
+
+ There are moreover several functions to show or hide the on-screen
+keyboard. For more details, @xref{On-Screen Keyboards,,, elisp, The
Emacs Lisp Reference Manual}.
@cindex quitting, without a keyboard
- Since it may not be possible for Emacs to display the on screen
+ Since it may not be possible for Emacs to display the virtual
keyboard while it is executing a command, Emacs implements a feature
-on devices with only an on-screen keyboard, by which two rapid clicks
-of a hardware button that is always present on the device results in
-Emacs quitting. @xref{Quitting}.
+on window systems frequently equipped with no physical keyboard, by
+which two rapid clicks of a hardware button that is always present on
+the device induces a quit. @xref{Quitting}.
@vindex x-quit-keysym
- The button afforded such special treatment varies; under X, no such
-button exists by default, but one can be configured through the
-variable @code{x-quit-keysym}, whereas under Android it is always the
-volume down buttons.
+ No such button is enabled on X, but one can be configured through
+the variable @code{x-quit-keysym}. On Android this button is always
+the volume down button.
@cindex text conversion, keyboards
- Most input methods designed to work with on-screen keyboards perform
-buffer edits differently from desktop input methods.
+ Most input methods designed to work with virtual keyboards edit text
+differently from desktop input methods.
On a conventional desktop windowing system, an input method will
-simply display the contents of any on going character compositions on
-screen, and send the appropriate key events to Emacs after completion.
+simply display the contents of any ongoing character composition on
+screen, and send key events reflecting its contents to Emacs after it
+is confirmed by the user.
- However, on screen keyboard input methods directly perform edits to
-the selected window of each frame; this is known as ``text
+ By contrast, virtual keyboard input methods directly perform edits
+to the selected window of each frame; this is known as ``text
conversion'', or ``string conversion'' under the X Window System.
-Emacs enables these input methods whenever the buffer local value of
-@code{text-conversion-style} is non-@code{nil}, normally inside
-derivatives of @code{text-mode} and @code{prog-mode}.
+
+ Emacs enables these input methods whenever the buffer local value of
+@code{text-conversion-style} is non-@code{nil}, that is to say,
+generally inside derivatives of @code{text-mode} and @code{prog-mode}.
Text conversion is performed asynchronously whenever Emacs receives
a request to perform the conversion from the input method, and Emacs
is not currently reading a key sequence for which one prefix key has
-already been read (@pxref{Keys}.) After the conversion completes, a
+already been read (@pxref{Keys}). After the conversion completes, a
@code{text-conversion} event is sent. @xref{Misc Events,,, elisp, the
Emacs Reference Manual}.
@vindex text-conversion-face
If the input method needs to work on a region of the buffer, then
-the region becomes known as the ``composing region'' (or
-``preconversion region''.) The variable @code{text-conversion-face}
-describes whether or not to display the composing region in a specific
-face.
+the region is designated the ``composing region'' (or ``preconversion
+region''). The variable @code{text-conversion-face} controls whether
+to display the composing region in a distinctive face, and if so,
+which face to employ.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index d3c5712099d..eb197f738f5 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2851,8 +2851,11 @@ want it to preserve certain buffers, customize the
variable
@code{desktop-clear-preserve-buffers-regexp}, whose value is a regular
expression matching the names of buffers not to kill.
+@vindex desktop-globals-to-save
If you want to save minibuffer history from one session to
-another, use the @code{savehist} library.
+another, use the @code{savehist} library. You can also save selected
+minibuffer-history variables as part of @code{desktop-save-mode} if
+you add those variables to the value of @code{desktop-globals-to-save}.
@node Recursive Edit
@section Recursive Editing Levels
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 7746bc8bc23..3f3801abdb4 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1701,6 +1701,17 @@ completion to the buffer. @xref{Completion}.
In Text mode and related modes, @kbd{M-@key{TAB}} completes words
based on the spell-checker's dictionary. @xref{Spelling}.
+@cindex completion preview
+@cindex preview completion
+@cindex suggestion preview
+@cindex Completion Preview mode
+@findex completion-preview-mode
+ Completion Preview mode is a minor mode that shows completion
+suggestions as you type. When you enable this mode (with @kbd{M-x
+completion-preview-mode}), Emacs automatically displays the
+suggested completion for text around point as an in-line preview
+right after point; type @key{TAB} to accept the suggestion.
+
@node MixedCase Words
@section MixedCase Words
@cindex camel case
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index a79176fcefb..7efd4cc796c 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -407,8 +407,11 @@ characters, that disables character folding during that
search.
@cindex invisible text, searching for
@kindex M-s i @r{(Incremental search)}
@findex isearch-toggle-invisible
- To toggle whether or not invisible text is searched, type
-@kbd{M-s i} (@code{isearch-toggle-invisible}). @xref{Outline Search}.
+ To toggle whether or not the search will find text made invisible by
+overlays, type @kbd{M-s i} (@code{isearch-toggle-invisible}).
+@xref{Outline Search}. To make all incremental searches find matches
+inside invisible text, whether due to text properties or overlay
+properties, customize @code{search-invisible} to the value @code{t}.
@kindex M-r @r{(Incremental Search)}
@kindex M-s r @r{(Incremental Search)}
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index ca5e424d939..a2946bcada9 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -664,7 +664,7 @@ to the window-local tab line of buffers, and clicking on
the @kbd{x}
icon of a tab deletes it. The mouse wheel on the tab line scrolls
the tabs horizontally.
- Touch screen input (@pxref{Other Input Devices}) can also be used to
+ Touch screen input (@pxref{Other Input}) can also be used to
interact with the ``tab line''. Long-pressing (@pxref{Touchscreens})
a tab will display a context menu with items that operate on the tab
that was pressed; tapping a tab itself will result in switching to
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index c5b33ac5eaa..e4a0f585f69 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -8165,9 +8165,9 @@ the expectation that all goes well has a @code{when}.
The code uses
text that exists.
A @code{when} expression is simply a programmers' convenience. It is
-an @code{if} without the possibility of an else clause. In your mind,
-you can replace @code{when} with @code{if} and understand what goes
-on. That is what the Lisp interpreter does.
+like an @code{if} without the possibility of an else clause. In your
+mind, you can replace @code{when} with @code{if} and understand what
+goes on. That is what the Lisp interpreter does.
Technically speaking, @code{when} is a Lisp macro. A Lisp macro
enables you to define new control constructs and other language
@@ -8176,8 +8176,9 @@ expression which will in turn compute the value. In this
case, the
other expression is an @code{if} expression.
The @code{kill-region} function definition also has an @code{unless}
-macro; it is the converse of @code{when}. The @code{unless} macro is
-an @code{if} without a then clause
+macro; it is the opposite of @code{when}. The @code{unless} macro is
+like an @code{if} except that it has no then-clause, and it supplies
+an implicit @code{nil} for that.
For more about Lisp macros, see @ref{Macros, , Macros, elisp, The GNU
Emacs Lisp Reference Manual}. The C programming language also
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 41c30437dce..f6462a9e50b 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2106,8 +2106,9 @@ When no command is bound to @code{touchscreen-begin},
translate key sequences containing touch screen events into ordinary
mouse events (@pxref{Mouse Events}.) Since Emacs doesn't support
distinguishing events originating from separate mouse devices, it
-assumes that only one touchpoint is active while translation takes
-place; breaking this assumption may lead to unexpected behavior.
+assumes that a maximum of two touchpoints are active while translation
+takes place, and does not place any guarantees on the results of event
+translation when that restriction is overstepped.
Emacs applies two different strategies for translating touch events
into mouse events, contingent on factors such as the commands bound to
@@ -2159,6 +2160,15 @@ purpose of displaying pop-up menus, Emacs additionally
behaves as
illustrated in the last paragraph if @code{down-mouse-1} is bound to a
command whose name has the property @code{mouse-1-menu-command}.
+@cindex pinch-to-zoom touchscreen gesture translation
+When a second touch point is registered as a touch point is already
+being translated, gesture translation is terminated, and the distance
+from the second touch point (the @dfn{ancillary tool}) to the first is
+measured. Subsequent motion from either of those touch points will
+yield @code{touchscreen-pinch} events incorporating the ratio formed
+by the distance between their new positions and the distance measured
+at the outset, as illustrated in the following table.
+
@cindex touchscreen gesture events
If touch gestures are detected during translation, one of the
following input events may be generated:
@@ -2197,6 +2207,34 @@ This event is sent upon the start of a touch sequence
resulting in the
continuation of a ``drag-to-select'' gesture (subject to the
aformentioned user option) with @var{posn} set to the position list of
the initial @code{touchscreen-begin} event within that touch sequence.
+
+@cindex @code{touchscreen-pinch} event
+@item (touchscreen-pinch @var{posn} @var{ratio} @var{pan-x} @var{pan-y}
@var{ratio-diff})
+This event is delivered upon significant changes to the positions of
+either active touch point when an ancillary tool is active.
+
+@var{posn} is a mouse position list for the midpoint of a line drawn
+from the ancillary tool to the other touch point being observed.
+
+@var{ratio} is the distance between both touch points being observed
+divided by that distance when the ancillary point was first
+registered; which is to say, the scale of the ``pinch'' gesture.
+
+@var{pan-x} and @var{pan-y} are the difference between the pixel
+position of @var{posn} and this position within the last event
+delivered appertaining to this series of touch events, or in the case
+that no such event exists, the centerpoint between both touch points
+when the ancillary tool was first registered.
+
+@var{ratio-diff} is the difference between this event's ratio and
+@var{ratio} in the last event delivered; it is @var{ratio} if no such
+event exists.
+
+Such events are sent when the magnitude of the changes they represent
+will yield a @var{ratio} which differs by more than @code{0.2} from
+that in the previous event, or the sum of @var{pan-x} and @var{pan-y}
+will surpass half the frame's character width in pixels (@pxref{Frame
+Font}).
@end table
@cindex handling touch screen events
@@ -2207,7 +2245,7 @@ below is from commands bound directly to
@code{touchscreen-begin}
events; they allow responding to commonly used touch screen gestures
separately from mouse event translation.
-@defun touch-screen-track-tap event &optional update data
+@defun touch-screen-track-tap event &optional update data threshold
This function is used to track a single ``tap'' gesture originating
from the @code{touchscreen-begin} event @var{event}, often used to
set the point or to activate a button. It waits for a
@@ -2220,6 +2258,14 @@ contains at least one touchpoint with the same
identifier as in
the list of touchpoints in that @code{touchscreen-update} event, and
@var{data}.
+If @var{threshold} is non-@code{nil} and such an event indicates that
+the touchpoint represented by @var{event} has moved beyond a threshold
+of either @var{threshold} or 10 pixels if it is not a number from the
+position of @var{event}, @code{nil} is returned and mouse event
+translation is resumed for that touchpoint, so as not to impede the
+recognition of any subsequent touchscreen gesture arising from its
+sequence.
+
If any other event arrives in the mean time, @code{nil} is returned.
The caller should not perform any action in that case.
@end defun
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index dc5b9507efc..d4bd8c14ae3 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -598,6 +598,10 @@ Two symbols to avoid are @code{t}, which behaves like
@code{_}
Likewise, it makes no sense to bind keyword symbols
(@pxref{Constant Variables}).
+@item `@var{qpat}
+A backquote-style pattern. @xref{Backquote Patterns}, for the
+details.
+
@item (cl-type @var{type})
Matches if @var{expval} is of type @var{type}, which is a type
descriptor as accepted by @code{cl-typep} (@pxref{Type Predicates,,,cl,Common
@@ -1236,7 +1240,8 @@ The first three clauses use backquote-style patterns.
@code{`(add ,x ,y)} is a pattern that checks that @code{form}
is a three-element list starting with the literal symbol @code{add},
then extracts the second and third elements and binds them
-to symbols @code{x} and @code{y}, respectively.
+to symbols @code{x} and @code{y}, respectively. This is known as
+@dfn{destructuring}, see @ref{Destructuring with pcase Patterns}.
The clause body evaluates @code{x} and @code{y} and adds the results.
Similarly, the @code{call} clause implements a function call,
and the @code{fn} clause implements an anonymous function definition.
@@ -1883,6 +1888,9 @@ verbatim, don't just write @code{(error @var{string})}.
If @var{string}
@var{string} contains @samp{%}, @samp{`}, or @samp{'} it may be
reformatted, with undesirable results. Instead, use @code{(error "%s"
@var{string})}.
+
+When @code{noninteractive} is non-@code{nil} (@pxref{Batch Mode}),
+this function kills Emacs if the signaled error has no handler.
@end defun
@defun signal error-symbol data
@@ -1916,6 +1924,9 @@ variable to a list of the form @code{(@var{error-symbol}
.@:
The function @code{signal} never returns.
@c (though in older Emacs versions it sometimes could).
+If the error @var{error-symbol} has no handler, and
+@code{noninteractive} is non-@code{nil} (@pxref{Batch Mode}),
+this function eventually kills Emacs.
@example
@group
@@ -1980,11 +1991,14 @@ function which called the primitive that signaled the
error.
@end defvar
@cindex @code{debug-on-error} use
-An error that has no explicit handler may call the Lisp debugger. The
-debugger is enabled if the variable @code{debug-on-error} (@pxref{Error
-Debugging}) is non-@code{nil}. Unlike error handlers, the debugger runs
-in the environment of the error, so that you can examine values of
-variables precisely as they were at the time of the error.
+An error that has no explicit handler may call the Lisp debugger
+(@pxref{Invoking the Debugger}). The debugger is enabled if the
+variable @code{debug-on-error} (@pxref{Error Debugging}) is
+non-@code{nil}. Unlike error handlers, the debugger runs in the
+environment of the error, so that you can examine values of variables
+precisely as they were at the time of the error. In batch mode
+(@pxref{Batch Mode}), the Emacs process then normally exits with a
+non-zero exit status.
@node Handling Errors
@subsubsection Writing Code to Handle Errors
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 169e3ac37d3..57ed5806855 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -13,11 +13,12 @@ Lisp program.
@itemize @bullet
@item
If a problem occurs when you run the program, you can use the built-in
-Emacs Lisp debugger to suspend the Lisp evaluator, and examine and/or
-alter its internal state.
+Emacs Lisp debugger (@pxref{Debugger}) to suspend the Lisp evaluator,
+and examine and/or alter its internal state.
@item
You can use Edebug, a source-level debugger for Emacs Lisp.
+@xref{Edebug}.
@item
@cindex tracing Lisp programs
@@ -47,6 +48,7 @@ You can use the ERT package to write regression tests for the
program.
@item
You can profile the program to get hints about how to make it more efficient.
+@xref{Profiling}.
@end itemize
Other useful tools for debugging input and output problems are the
@@ -629,11 +631,18 @@ This is a list of functions that are set to break on
entry by means of
to invoke the debugger.
@deffn Command debug &rest debugger-args
-This function enters the debugger. It switches buffers to a buffer
-named @file{*Backtrace*} (or @file{*Backtrace*<2>} if it is the second
-recursive entry to the debugger, etc.), and fills it with information
-about the stack of Lisp function calls. It then enters a recursive
-edit, showing the backtrace buffer in Debugger mode.
+This function enters the debugger. In interactive sessions, it
+switches to a buffer named @file{*Backtrace*} (or
+@file{*Backtrace*<2>} if it is the second recursive entry to the
+debugger, etc.), and fills it with information about the stack of Lisp
+function calls. It then enters a recursive edit, showing the
+backtrace buffer in Debugger mode. In batch mode (more generally,
+when @code{noninteractive} is non-@code{nil}, @pxref{Batch Mode}),
+this function shows the Lisp backtrace on the standard error stream,
+and then kills Emacs, causing it to exit with a non-zero exit code
+(@pxref{Killing Emacs}). Binding
+@code{backtrace-on-error-noninteractive} to @code{nil} suppresses the
+backtrace in batch mode, see below.
The Debugger mode @kbd{c}, @kbd{d}, @kbd{j}, and @kbd{r} commands exit
the recursive edit; then @code{debug} switches back to the previous
@@ -717,6 +726,13 @@ under which @code{debug} is called.
@end table
@end deffn
+@defvar backtrace-on-error-noninteractive
+If this variable is non-@code{nil}, the default, entering the debugger
+in batch mode shows the backtrace of Lisp functions calls. Binding
+the variable to the @code{nil} value suppresses the backtrace and
+shows only the error message.
+@end defvar
+
@node Internals of Debugger
@subsection Internals of the Debugger
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index ca8c79395ed..ec6f7fd9462 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4014,7 +4014,7 @@ storing their own data; however, only three are commonly
used: the
selection}. @xref{Cut and Paste,, Cut and Paste, emacs, The GNU Emacs
Manual}, for Emacs commands that make use of these selections. This
section documents the low-level functions for reading and setting
-window-system selections; @xref{Accessing Selections} for
+window-system selections; @xref{Accessing Selections}, for
documentation concerning selection types and data formats under
particular window systems.
@@ -4052,7 +4052,7 @@ programs. It takes two optional arguments, @var{type} and
The @var{data-type} argument specifies the form of data conversion to
use, to convert the raw data obtained from another program into Lisp
-data. @xref{X Selections} for an enumeration of data types valid
+data. @xref{X Selections}, for an enumeration of data types valid
under X, and @xref{Other Selections} for those elsewhere.
@end defun
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index be4d7e37261..ba7f1ca692e 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -1985,6 +1985,7 @@ the piece of the prefix and suffix covered by the
completion
boundaries. @xref{Basic Completion}, for the precise expected semantics
of completion boundaries.
+@cindex completion metadata
@item metadata
This specifies a request for information about the state of the
current completion. The return value should have the form
@@ -2001,6 +2002,8 @@ The following is a list of metadata entries that a
completion function
may return in response to a @code{metadata} flag argument:
@table @code
+@cindex @code{category}, in completion
+@cindex completion category
@item category
The value should be a symbol describing what kind of text the
completion function is trying to complete. If the symbol matches one
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index f365d88fade..13090a13d71 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -932,11 +932,41 @@ Do not write an @code{interactive} spec in the definition;
@code{define-derived-mode} does that automatically.
@end defmac
-@defun derived-mode-p &rest modes
+@defun derived-mode-p modes
This function returns non-@code{nil} if the current major mode is
-derived from any of the major modes given by the symbols @var{modes}.
+derived from any of the major modes given by the list of symbols
+in @var{modes}.
+Instead of a list, @var{modes} can also be a single mode symbol.
+
+Furthermore, we still support a deprecated calling convention where the
+@var{modes} were passed as separate arguments.
@end defun
+The graph of major modes is accessed with the following lower-level
+functions:
+
+@defun derived-mode-set-parent mode parent
+This function declares that @var{mode} inherits from @code{parent}.
+This is the function that @code{define-derived-mode} calls after
+defining @var{mode} to register the fact that @var{mode} was defined
+by reusing @code{parent}.
+@end defun
+
+@defun derived-mode-add-parents mode extra-parents
+This function makes it possible to register additional parents beside
+the one that was used when defining @var{mode}. This can be used when
+the similarity between @var{mode} and the modes in @var{extra-parents}
+is such that it makes sense to treat it as a child of those
+modes for purposes like applying directory-local variables.
+@end defun
+
+@defun derived-mode-all-parents mode
+This function returns the list of all the modes in the ancestry of
+@var{mode}, ordered from the most specific to the least specific, and
+starting with @var{mode} itself.
+@end defun
+
+
@node Basic Major Modes
@subsection Basic Major Modes
@@ -2667,7 +2697,7 @@ display in pixels, by multiplying the value of this
variable by the
value returned by @code{frame-char-width} (@pxref{Frame Font}), and
then use the result to align header-line text using the
@code{:align-to} display property spec (@pxref{Specified Space}) in
-pixels on the relevant parts of @code{header-line-frormat}.
+pixels on the relevant parts of @code{header-line-format}.
@end defvar
@defun window-header-line-height &optional window
@@ -3614,7 +3644,9 @@ errors are suppressed, is instead run by a timer. Thus,
this mode
allows using debugging aids such as @code{debug-on-error}
(@pxref{Error Debugging}) and Edebug (@pxref{Edebug}) for finding and
fixing problems in font-lock code and any other code run by JIT
-font-lock.
+font-lock. Another command that could be useful when developing and
+debugging font-lock is @code{font-lock-debug-fontify}, see @ref{Font
+Lock Basics}.
@end deffn
@node Levels of Font Lock
@@ -5097,7 +5129,7 @@ this matcher doesn't check that argument. For example,
to match the
first child where parent is @code{argument_list}, use
@example
-(match nil "argument_list" nil nil 0 0)
+(match nil "argument_list" nil 0 0)
@end example
In addition, @var{node-type} can be a special value @code{null},
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 9febcbefa33..17961ffadfa 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -96,6 +96,12 @@ Hash notation cannot be read at all, so the Lisp reader
signals the
error @code{invalid-read-syntax} whenever it encounters @samp{#<}.
@kindex invalid-read-syntax
+ We describe the read syntax and the printed representation of each
+Lisp data type where we describe that data type, in the following
+sections of this chapter. For example, see @ref{String Type}, and its
+subsections for the read syntax and printed representation of strings;
+see @ref{Vector Type} for the same information about vectors; etc.
+
In other languages, an expression is text; it has no other form. In
Lisp, an expression is primarily a Lisp object and only secondarily the
text that is the object's read syntax. Often there is no need to
@@ -321,6 +327,8 @@ number whose value is 1500. They are all equivalent.
A @dfn{character} in Emacs Lisp is nothing more than an integer. In
other words, characters are represented by their character codes. For
example, the character @kbd{A} is represented as the @w{integer 65}.
+That is also their usual printed representation; see @ref{Basic Char
+Syntax}.
Individual characters are used occasionally in programs, but it is
more common to work with @emph{strings}, which are sequences composed
@@ -1106,6 +1114,22 @@ character. Likewise, you can include a backslash by
preceding it with
another backslash, like this: @code{"this \\ is a single embedded
backslash"}.
+ Since a string is an array of characters, you can specify the string
+characters using the read syntax of characters, but without the
+leading question mark. This is useful for including in string
+constants characters that don't stand for themselves. Thus, control
+characters can be specified as escape sequences that start with a
+backslash; for example, @code{"foo\r"} yields @samp{foo} followed by
+the carriage return character. @xref{Basic Char Syntax}, for escape
+sequences of other control characters. Similarly, you can use the
+special read syntax for control characters (@pxref{Ctl-Char Syntax}),
+as in @code{"foo\^Ibar"}, which produces a tab character embedded
+within a string. You can also use the escape sequences for non-ASCII
+characters described in @ref{General Escape Syntax}, as in
+@w{@code{"\N@{LATIN SMALL LETTER A WITH GRAVE@}"}} and @code{"\u00e0"}
+(however, see a caveat with non-ASCII characters in @ref{Non-ASCII in
+Strings}).
+
@cindex newline in strings
The newline character is not special in the read syntax for strings;
if you write a new line between the double-quotes, it becomes a
@@ -1182,8 +1206,9 @@ but it does terminate any preceding hex escape.
as in character literals (but do not use the question mark that begins a
character constant). For example, you can write a string containing the
nonprinting characters tab and @kbd{C-a}, with commas and spaces between
-them, like this: @code{"\t, \C-a"}. @xref{Character Type}, for a
-description of the read syntax for characters.
+them, like this: @code{"\t, \C-a"}. @xref{Character Type}, and its
+subsections for a description of the various kinds of read syntax for
+characters.
However, not all of the characters you can write with backslash
escape-sequences are valid in strings. The only control characters that
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 5711ba9016a..a5ff1005e6b 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -2759,6 +2759,35 @@ way to specify the programs to run is with @samp{-l
@var{file}}, which
loads the library named @var{file}, or @samp{-f @var{function}}, which
calls @var{function} with no arguments, or @samp{--eval=@var{form}}.
+@defvar noninteractive
+This variable is non-@code{nil} when Emacs is running in batch mode.
+@end defvar
+
+ If the specified Lisp program signals an unhandled error in batch
+mode, Emacs exits with a non-zero exit status after invoking the Lisp
+debugger which shows the Lisp backtrace (@pxref{Invoking the
+Debugger}) on the standard error stream:
+
+@example
+$ emacs -Q --batch --eval '(error "foo")'; echo $?
+
+@group
+Error: error ("foo")
+mapbacktrace(#f(compiled-function (evald func args flags) #<bytecode -0x4f85c5
+7c45e2f81>))
+debug-early-backtrace()
+debug-early(error (error "foo"))
+signal(error ("foo"))
+error("foo")
+eval((error "foo") t)
+command-line-1(("--eval" "(error \"foo\")"))
+command-line()
+normal-top-level()
+@end group
+foo
+255
+@end example
+
Any Lisp program output that would normally go to the echo area,
either using @code{message}, or using @code{prin1}, etc., with
@code{t} as the stream (@pxref{Output Streams}), goes instead to
@@ -2776,6 +2805,7 @@ if it is non-@code{nil}; this can be overridden by binding
@code{coding-system-for-write} to a coding system of you choice
(@pxref{Explicit Encoding}).
+@vindex gc-cons-percentage@r{, in batch mode}
In batch mode, Emacs will enlarge the value of the
@code{gc-cons-percentage} variable from the default of @samp{0.1} up to
@samp{1.0}. Batch jobs that are supposed to run for a long time
@@ -2783,19 +2813,6 @@ should adjust the limit back down again, because this
means that less
garbage collection will be performed by default (and more memory
consumed).
-@defvar noninteractive
-This variable is non-@code{nil} when Emacs is running in batch mode.
-@end defvar
-
-If Emacs exits due to signaling an error in batch mode, the exit
-status of the Emacs command is non-zero:
-
-@example
-$ emacs -Q --batch --eval '(error "foo")'; echo $?
-foo
-255
-@end example
-
@node Session Management
@section Session Management
@cindex session manager
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 45436cd2bc6..5d05ef18d4f 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5486,7 +5486,11 @@ made by the transaction.
@defmac with-sqlite-transaction db body@dots{}
Like @code{progn} (@pxref{Sequencing}), but executes @var{body} with a
-transaction held, and commits the transaction at the end.
+transaction held, and commits the transaction at the end if @var{body}
+completes normally. If @var{body} signals an error, or committing the
+transaction fails, the changes in @var{db} performed by @var{body} are
+rolled back. The macro returns the value of @var{body} if it
+completes normally and commit succeeds.
@end defmac
@defun sqlite-pragma db pragma
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 81a5e1688fd..4c9dcee37d8 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -43,6 +43,7 @@ in batch mode, e.g., with a command run by @kbd{@w{M-x compile
@section Emacs Lisp Coding Conventions
@cindex coding conventions in Emacs Lisp
+@cindex conventions for Emacs Lisp programs
Here are conventions that you should follow when writing Emacs Lisp
code intended for widespread use:
@@ -264,6 +265,7 @@ which are lists of directory names.
@node Key Binding Conventions
@section Key Binding Conventions
@cindex key binding, conventions for
+@cindex conventions for key bindings
@itemize @bullet
@item
@@ -345,6 +347,7 @@ after @key{ESC}. In these states, you should define
@kbd{@key{ESC}
@node Programming Tips
@section Emacs Programming Tips
@cindex programming conventions
+@cindex conventions for Emacs programming
Following these conventions will make your program fit better
into Emacs when it runs.
@@ -477,6 +480,7 @@ buffer and let the user switch back at will.
@xref{Recursive Editing}.
@section Tips for Making Compiled Code Fast
@cindex execution speed
@cindex speedups
+@cindex tips for faster Lisp code
Here are ways of improving the execution speed of byte-compiled
Lisp programs.
@@ -531,6 +535,7 @@ the speed. @xref{Inline Functions}.
@node Warning Tips
@section Tips for Avoiding Compiler Warnings
@cindex byte compiler warnings, how to avoid
+@cindex warnings from byte compiler
@itemize @bullet
@item
@@ -585,6 +590,8 @@ is to put it inside @code{with-no-warnings}.
@xref{Compiler Errors}.
@node Documentation Tips
@section Tips for Documentation Strings
@cindex documentation strings, conventions and tips
+@cindex tips for documentation strings
+@cindex conventions for documentation strings
@findex checkdoc-minor-mode
Here are some tips and conventions for the writing of documentation
@@ -624,7 +631,12 @@ first line with a capital letter and end it with a period.
For a function, the first line should briefly answer the question,
``What does this function do?'' For a variable, the first line should
-briefly answer the question, ``What does this value mean?''
+briefly answer the question, ``What does this value mean?'' Prefer to
+answer these questions in a way that will make sense to users and
+callers of the function or the variable. In particular, do @emph{not}
+tell what the function does by enumerating the actions of its code;
+instead, describe the role of these actions and the function's
+contract.
Don't limit the documentation string to one line; use as many lines as
you need to explain the details of how to use the function or
@@ -638,11 +650,11 @@ include before the first blank line so as to make this
display useful.
@item
The first line should mention all the important arguments of the
-function, and should mention them in the order that they are written
-in a function call. If the function has many arguments, then it is
-not feasible to mention them all in the first line; in that case, the
-first line should mention the first few arguments, including the most
-important arguments.
+function (in particular, the mandatory arguments), and should mention
+them in the order that they are written in a function call. If the
+function has many arguments, then it is not feasible to mention them
+all in the first line; in that case, the first line should mention the
+first few arguments, including the most important arguments.
@item
When a function's documentation string mentions the value of an argument
@@ -915,6 +927,7 @@ versions, there is no need for this work-around.
@node Comment Tips
@section Tips on Writing Comments
@cindex comments, Lisp convention for
+@cindex conventions for Lisp comments
We recommend these conventions for comments:
@@ -1030,6 +1043,7 @@ semicolons.
@section Conventional Headers for Emacs Libraries
@cindex header comments
@cindex library header comments
+@cindex conventions for library header comments
Emacs has conventions for using special comments in Lisp libraries
to divide them into sections and give information such as who wrote
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 4ab95798468..8bc19235516 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -4507,6 +4507,13 @@ languages are syntactically equivalent to classes. Note
however that
the keyword @code{class} is meaningless in C and Objective-C.}.
Similarly, line 18 is assigned @code{class-close} syntax.
+Note that @code{class-open} and @code{class-close} syntactic elements
+have two anchor points. The first is the position of the beginning of
+the statement, the second is the position of the keyword which defines
+the construct (e.g. @code{class}). These are usually the same
+position, but differ when the statement starts off with
+@code{template} (C++ Mode) or @code{generic} (Java Mode) or similar.
+
@ssindex inher-intro
@ssindex inher-cont
Line 2 introduces the inheritance list for the class so it is assigned
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
index 2d9b2a2b60e..2d6fcb29d3f 100644
--- a/doc/misc/eglot.texi
+++ b/doc/misc/eglot.texi
@@ -692,12 +692,12 @@ This command reformats the current buffer, in the same
manner as
These commands allow you to invoke the so-called @dfn{code actions}:
requests for the language server to provide editing commands for
correcting, refactoring or beautifying your code. These commands may
-affect more than one visited file belong to the project.
+affect more than one visited file belonging to the project.
The command @code{eglot-code-actions} asks the server if there any
code actions for any point in the buffer or contained in the active
-region. If there are, you the choice to execute one of them via the
-minibuffer.
+region. If there are, you have the choice to execute one of them via
+the minibuffer.
A common use of code actions is fixing the Flymake error diagnostics
issued by Eglot (@pxref{Top,,, flymake, GNU Flymake manual}).
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 10902eac33f..d7260ffa329 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -450,6 +450,11 @@ Buttonize URLs, nicknames, and other text
@item capab-identify
Mark unidentified users on freenode and other servers supporting CAPAB.
+@cindex modules, command-indicator
+@item command-indicator
+Echo command lines for ``slash commands'', like @kbd{/JOIN #erc} and
+@kbd{/HELP join}
+
@cindex modules, completion
@cindex modules, pcomplete
@item completion (aka pcomplete)
@@ -1061,14 +1066,14 @@ The name of an SASL subprotocol type as a
@emph{lowercase} symbol.
The value can be one of the following:
@table @asis
-@item @code{plain} and @code{scram} (``password-based'')
+@item @code{plain} or @code{scram} (``password-based'')
Here, ``password'' refers to your account password, which is usually
your @samp{NickServ} password. To make this work, customize
@code{erc-sasl-user} and @code{erc-sasl-password} or specify the
@code{:user} and @code{:password} keyword arguments when invoking
@code{erc-tls}.
-@item @code{external} (via Client TLS Certificate)
+@item @code{external} (via client @acronym{TLS} certificate)
This works in conjunction with the @code{:client-certificate} keyword
offered by @code{erc-tls}. Just ensure you've registered your
fingerprint with the network beforehand. The fingerprint is usually a
diff --git a/doc/misc/org.org b/doc/misc/org.org
index 9721807a185..6ca14c851b0 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -20266,12 +20266,12 @@ packages are documented here.
#+vindex: org-table-formula-constants
Org can use names for constants in formulas in tables. Org can also
- use calculation suffixes for units, such as =M= for =Mega=. For
- a standard collection of such constants, install the =constants=
+ use calculation suffixes for units, such as =M= for =Mega=. For a
+ standard collection of such constants, install the =constants=
package. Install version 2.0 of this package, available at
- [[http://www.astro.uva.nl/~dominik/Tools]]. Org checks if the function
- ~constants-get~ has been autoloaded. Installation instructions are
- in the file =constants.el=.
+ [[https://github.com/cdominik/constants-for-Emacs]]. Org checks if the
+ function ~constants-get~ has been autoloaded. Installation
+ instructions are in the file =constants.el=.
- =cdlatex.el= by Carsten Dominik ::
#+cindex: @file{cdlatex.el}
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index f59023eae62..7b39af03a88 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -100,7 +100,7 @@ one's optionally accessible from the keyboard, just like
any other
side window. Hit '<RET>' over a nick to spawn a "/QUERY" or a
"Lastlog" (Occur) session. See 'erc-nickbar-mode' for more.
-** The option 'erc-timestamp-use-align-to' is more versatile.
+** Option 'erc-timestamp-use-align-to' more versatile.
While this option has always offered to right-align stamps via the
'display' text property, it's now more effective at doing so when set
to a number indicating an offset from the right edge. Users of the
@@ -157,6 +157,19 @@ asking users who've customized this option to switch to
that some other solution, like automatic migration, is justified,
please make that known on the bug list.
+** Module 'noncommands' deprecated, replaced by 'command-indicator'.
+Command-line echoing has returned to ERC after a near decade-long
+hiatus. This means you can elect to have ERC leave a trail of (most)
+slash-command input submitted at the prompt, in a manner resembling
+that of a shell or a REPL. The particulars are likely of little
+interest to most users, but the gist is that this functionality was
+removed in 5.3.x (Emacs 24.5) without mention in this document or a
+change log. Everything's mostly been restored, except that the
+feature is now opt-in. The only real gotcha is that related faces and
+options, like 'erc-command-indicator', have moved to the 'erc-goodies'
+library, although their Custom groups remain the same. Add
+'command-indicator' to 'erc-modules' to get started.
+
** 'erc-button-alist' and 'erc-nick-popup-alist' have evolved slightly.
It's no secret that the 'buttons' module treats potential nicknames
specially. This is perhaps most evident in its treatment of the
@@ -178,6 +191,16 @@ been restored with a slightly revised role contingent on a
few
assumptions explained in its doc string. For clarity, it has been
renamed 'erc-ensure-target-buffer-on-privmsg'.
+** A smarter, more responsive prompt.
+ERC's prompt can be told to respond dynamically to incoming and
+outgoing messages by leveraging the familiar function variant of the
+option 'erc-prompt'. With this release, only predefined functions can
+take full advantage of this new dynamism, but an interface to empower
+third parties with the same possibilities may follow suit. To get
+started, customize 'erc-prompt' to 'erc-prompt-format', and see the
+option of the same name ('erc-prompt-format') for a rudimentary
+templating facility reminiscent of 'erc-mode-line-format'.
+
** Module 'scrolltobottom' now optionally more aggressive.
Enabling the experimental option 'erc-scrolltobottom-all' makes ERC
more vigilant about staking down the input area in all ERC windows.
@@ -207,7 +230,7 @@ the same effect by issuing a "/CLEAR" at the prompt.
** The 'truncate' module no longer enables logging automatically.
Users expecting 'truncate' to perform logging based on the option
'erc-enable-logging' need to instead add 'log' to 'erc-modules' for
-continued integration. With the existing design, merely loading the
+continued integration. Under the original design, merely loading the
library 'erc-log' caused 'truncate' to start writing logs, possibly
against a user's wishes.
@@ -240,14 +263,23 @@ whenever ERC rejects prompt input containing
whitespace-only lines.
When paired with option 'erc-send-whitespace-lines', ERC echoes a
tally of blank lines padded and trailing blanks culled.
+** A context-dependent mode segment in header and mode lines.
+The "%m" specifier has traditionally expanded to a lone "+" in server
+and query buffers and a string containing all switch modes (plus
+"limit" and "key" args) in channel buffers. It now becomes a string
+of user modes in server buffers and disappears completely in query
+buffers. In channels, it's grown to include all letters and their
+possibly truncated arguments, with the exception of stateful list
+modes, like "b".
+
** Miscellaneous UX changes.
Some minor quality-of-life niceties have finally made their way to
ERC. For example, fool visibility has become togglable with the new
command 'erc-match-toggle-hidden-fools'. The 'button' module's
-'erc-button-previous' now moves to the beginning instead of the end of
-buttons. A new command, 'erc-news', can be invoked to visit this very
-file. And the 'irccontrols' module now supports additional colors and
-special handling for "spoilers" (hidden text).
+'erc-button-previous' command now moves to the beginning instead of
+the end of buttons. A new command, 'erc-news', can be invoked to
+visit this very file. And the 'irccontrols' module now supports
+additional colors and special handling for "spoilers" (hidden text).
** Changes in the library API.
@@ -263,21 +295,26 @@ sparingly, and the latter two have only been around for
one minor
release cycle, so their removal hopefully won't cause much churn.
*** Some ERC-applied text properties have changed.
-Chiefly, 'rear-sticky' has been replaced by 'erc-command', which
-records the IRC command (or numeric) associated with a message. Less
-impactfully, the value of the 'field' property for ERC's prompt has
-changed from 't' to the more useful 'erc-prompt', although the
-property of the same name has been retained and now has a value of
-'hidden' when disconnected.
+Chiefly, a new set of metadata-oriented properties, the details of
+which should be considered internal, now occupy the first character of
+all inserted messages, including local notices, date stamps, and
+interactive feedback. These properties will likely form the basis for
+a new message-traversal/insertion/deletion API in future versions.
+Less impactfully, the no-op property 'rear-sticky' has been removed,
+and the value of the 'field' property for ERC's prompt has changed
+from 't' to the more useful 'erc-prompt', although the property of the
+same name has been retained and now has a value of 'hidden' when
+disconnected.
*** Members of insert- and send-related hooks have been reordered.
-Built-in and third-party modules rely on certain hooks for adjusting
-incoming and outgoing messages upon insertion. And some modules only
-want to do so after others have done their damage. Traditionally,
-this has required various hacks and finagling to achieve. And while
-this release makes an effort to load modules in a more consistent
-order, that alone isn't enough to ensure similar predictability among
-essential members of important hooks.
+As anyone reading this is no doubt aware, both built-in and
+third-party modules rely on certain hooks for adjusting incoming and
+outgoing messages upon insertion. And some modules only want to do so
+after others have done their damage. Traditionally, this has required
+various hacks and finagling to achieve. And while this release makes
+an effort to load modules in a more consistent order, that alone isn't
+enough to ensure predictability among essential members of important
+hooks.
Luckily, ERC now leverages a feature introduced in Emacs 27, "hook
depth," to secure the positions of a few key members of
@@ -304,18 +341,18 @@ ERC's own code base in 2002. That this example has
endured makes some
sense because it's probably seen as less cumbersome than fiddling with
the more powerful and complicated 'erc-display-message'.
-The latest twist in this saga comes with this release, in which a
-healthy bit of "pre-insertion" business has taken up residence in
-'erc-display-message'. While this would seem to put antiquated
-patterns, like the above mentioned 'erc-make-notice' combo, at risk of
-having messages ignored or subject to degraded treatment by built-in
-modules, an adaptive measure has been introduced that recasts
-'erc-display-line' as a thin wrapper around 'erc-display-message'.
-And though nothing of the sort has been done for the lower-level
-'erc-display-line-1' (now an obsolete alias for 'erc-insert-line'),
-some last-ditch fallback code is in place to ensure baseline
-functionality. As always, if you find these developments disturbing,
-please say so on the tracker.
+The latest twist in this tale comes with this release, for which a
+healthy helping of "pre-insertion" business has permanently ensconced
+itself in none other than 'erc-display-message'. While this would
+seem to put antiquated patterns, like the above mentioned
+'erc-make-notice' combo, at risk of having messages ignored or subject
+to degraded treatment by built-in modules, an adaptive measure has
+been introduced that recasts 'erc-display-line' as a thin wrapper
+around 'erc-display-message'. And though nothing of the sort has been
+done for the lower-level 'erc-display-line-1' (now an obsolete alias
+for 'erc-insert-line'), some last-ditch fallback code has been
+introduced to guarantee baseline functionality. As always, if you
+find these developments disturbing, please say so on the tracker.
*** ERC now manages timestamp-related properties a bit differently.
For starters, the 'cursor-sensor-functions' text property is absent by
@@ -329,37 +366,45 @@ Also affecting the 'stamp' module is the deprecation of
the function
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
-This "propertizing" of surrounding white space also extends to all
+This "propertizing" of surrounding white space extends to all
'stamp'-applied properties, like 'field', in all intervening space
between message text and timestamps. Technically, this constitutes a
breaking change from the perspective of detecting a timestamp's
bounds. However, ERC has always propertized leading space before
-right-sided stamps on the same line as message text but not those
-folded onto the next line. Such inconsistency made stamp detection
-overly complex and produced uneven results when toggling stamp
-visibility.
+right-sided stamps on the same line as message text but not before
+those folded onto the next line. Such inconsistency made stamp
+detection overly complex and produced uneven results when toggling
+stamp visibility.
-*** Date stamps are independent messages.
+*** Date stamps have become independent messages.
ERC now inserts "date stamps" generated from the option
-'erc-timestamp-format-left' as separate, standalone messages. (This
-only matters if 'erc-insert-timestamp-function' is set to its default
-value of 'erc-insert-timestamp-left-and-right'.) ERC's near-term UI
-goals require exposing these stamps to existing code designed to
+'erc-timestamp-format-left' as separate, standalone messages. This
+currently only matters if 'erc-insert-timestamp-function' is set to
+its default value of 'erc-insert-timestamp-left-and-right', however
+plans exist to decouple these features. In any case, ERC's near-term
+UI goals require exposing these stamps to existing code designed to
operate on complete messages. For example, users likely expect date
stamps to be togglable with 'erc-toggle-timestamps' while also being
immune to hiding from commands like 'erc-match-toggle-hidden-fools'.
Before this change, meeting such expectations demanded brittle
heuristics that checked for the presence of these stamps in the
leading portion of message bodies as well as special casing to act on
-these areas without inflicting collateral damage. It may also be
-worth noting that as consequence of these changes, the internally
-managed variable 'erc-timestamp-last-inserted-left' no longer records
-the final trailing newline in 'erc-timestamp-format-left'. If you
-must, see variable 'erc-stamp-prepend-date-stamps-p' for a temporary
-escape hatch.
+these areas without inflicting collateral damage.
+
+Despite the rationale, this move admittedly ushers in a heightened
+potential for disruption because third-party members of ERC's
+modification hooks may not take kindly to encountering stamp-only
+messages. They may also expect members of 'erc-insert-pre-hook' and
+'erc-insert-done-hook' to run unconditionally, even though ERC
+suppresses those hooks when inserting date stamps. Third parties may
+also not appreciate that 'erc-timestamp-last-inserted-left' no longer
+records the final trailing newline in 'erc-timestamp-format-left'. If
+these inconveniences prove too encumbering to deal with right away,
+see the escape hatch 'erc-stamp-prepend-date-stamps-p', which should
+help ease the transition.
*** The role of a module's Custom group is now more clearly defined.
-Associating built-in modules with Custom groups and provided library
+Associating built-in modules with Custom groups and "provided" library
features has improved. More specifically, a module's group now enjoys
the singular purpose of determining where the module's minor mode
variable lives in the Customize interface. And although ERC is now
@@ -377,7 +422,8 @@ like bridges to other protocols.
Some IRC "slash" commands are hierarchical and require users to
specify a subcommand to actually carry out anything of consequence.
Built-in modules can now provide more detailed help for a particular
-subcommand by telling ERC to defer to a specialized handler.
+subcommand by telling ERC to defer to a specialized handler. This
+facility can be opened up to third parties should any one request it.
*** Longtime quasi modules made proper.
The 'fill' module is now defined by 'define-erc-module'. The same
@@ -410,7 +456,9 @@ than lone ones.
ERC now adjusts input lines to fall within allowed length limits
before showing hook members the result. For compatibility,
third-party code can request that the final input be adjusted again
-prior to being sent. See doc string for details.
+prior to being sent. To facilitate this, the 'erc-input' object
+shared among hook members has gained a new 'refoldp' slot, making this
+a breaking change, if only in theory. See doc string for details.
*** ERC's prompt survives the insertion of user input and messages.
Previously, ERC's prompt and its input marker disappeared while
@@ -451,6 +499,17 @@ release lacks a similar solution for detecting
"joinedness" directly,
but users can turn to 'xor'-ing 'erc-default-target' and 'erc-target'
as a makeshift kludge.
+*** Channel-mode handling has become stricter and more predictable.
+ERC has always processed channel modes using "standardized" letters
+and popular status prefixes. Starting with this release, ERC will
+begin preferring advertised "CHANMODES" when interpreting letters and
+their arguments. To facilitate this transition, the functions
+'erc-set-modes', 'erc-parse-modes', and 'erc-update-modes', have all
+been provisionally deprecated. Expect a new, replacement API for
+handling specific "MODE" types and letters in coming releases. If
+you'd like a say in shaping how this transpires, please share your
+ideas and use cases on the tracker.
+
*** Miscellaneous changes
Two helper macros from GNU ELPA's Compat library are now available to
third-party modules as 'erc-compat-call' and 'erc-compat-function'.
diff --git a/etc/NEWS b/etc/NEWS
index 767e4c27b43..259af667c03 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -31,6 +31,14 @@ NDK, SDK, and a suitable Java compiler must also be
installed.
See the file 'java/INSTALL' for more details.
+---
+** Native compilation is now enabled by default.
+'configure' will enable the Emacs Lisp native compiler, so long as
+libgccjit is present and functional on the system. To disable native
+compilation, configure Emacs with the option:
+
+ $ ./configure --with-native-compilation=no
+
---
** Emacs now defaults to ossaudio library for sound on NetBSD and OpenBSD.
Previously configure used ALSA libraries if installed on the
@@ -233,6 +241,12 @@ to enter the file you want to modify.
It can be used to customize the look of the appointment notification
displayed on the mode line when 'appt-display-mode-line' is non-nil.
+---
+*** Emacs now recognizes shebang lines that pass -S/--split-string to 'env'.
+When visiting a script that invokes 'env -S INTERPRETER ARGS...' in
+its shebang line, Emacs will now skip over 'env -S' and deduce the
+major mode based on the interpreter after 'env -S'.
+
** Emacs Server and Client
---
@@ -330,6 +344,15 @@ or narrow (if the variable is customized to the nil value).
This setting affects the results of 'string-width' and similar
functions in CJK locales.
+---
+*** New input methods for the Urdu, Pashto, and Sindhi languages.
+These languages are spoken in Pakistan and Afganistan.
+
+*** Additional 'C-x 8' key translations for æ and Æ.
+These characters can now be input with 'C-x 8 a e' and 'C-x 8 A E',
+respectively, in addition to the existing translations 'C-x 8 / e' and
+'C-x 8 / E'.
+
* Changes in Specialized Modes and Packages in Emacs 30.1
@@ -384,6 +407,40 @@ This is because it partly acts by modifying other rules
which may
occasionally be surprising. It can be re-enabled by adding 'omake' to
'compilation-error-regexp-alist'.
+** Project
+
++++
+*** New user option 'project-mode-line'.
+When non-nil, display the name of the current project on the mode
+line. Clicking 'mouse-1' on the project name pops up the project
+menu. The default value is nil.
+
+*** New user option 'project-file-history-behavior'.
+Customizing it to 'relativize' makes commands like 'project-find-file'
+and 'project-find-dir' display previous history entries relative to
+the current project.
+
+*** New user option 'project-key-prompt-style'.
+The look of the key prompt in the project switcher has been changed
+slightly. To get the previous one, set this option to 'brackets'.
+
+*** 'project-try-vc' tries harder to find the responsible VCS.
+When 'project-vc-extra-root-markers' is non-nil, and causes
+subdirectory project to be detected which is not a VCS root, we now
+additionally traverse the parent directories until a VCS root is found
+(if any), so that the ignore rules for that repository are used, and
+the file listing's performance is still optimized.
+
+*** New commands 'project-any-command' and 'project-prefix-or-any-command'.
+The former is now bound to 'C-x p o' by default.
+The latter is designed primarily for use as a value of
+'project-switch-commands'. If instead of a short menu you prefer to
+have access to all keys defined inside 'project-prefix-map', as well
+as global bindings (to run other commands inside the project root),
+you can add this to your init script:
+
+ (setopt project-switch-commands #'project-prefix-or-any-command)
+
** VC
---
@@ -392,6 +449,10 @@ This is a string or a list of strings that specifies the
Git log
switches for shortlogs, such as the one produced by 'C-x v L'.
'vc-git-log-switches' is no longer used for shortlogs.
+---
+*** New value 'no-backend' for user option 'vc-display-status'.
+With this value only the revision number is displayed on the mode-line.
+
---
*** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'.
The command was previously obsoleted and unbound in Emacs 28.
@@ -429,10 +490,11 @@ that shows as diffs replacements in the marked files in
Dired.
---
*** New user option 'dired-movement-style'.
-When non-nil, make 'dired-next-line' and 'dired-previous-line' skip
-empty lines. 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.
+When non-nil, make 'dired-next-line', 'dired-previous-line',
+'dired-next-dirline', 'dired-prev-dirline' skip empty lines.
+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.
** Ediff
@@ -536,6 +598,21 @@ calling external rgrep.
+++
*** If a command exits abnormally, the Eshell prompt now shows its exit code.
+** Minibuffer and Completions
+
+*** New commands 'previous-line-completion' and 'next-line-completion'.
+Bound to '<UP>' and '<DOWN>' arrow keys, respectively, they navigate
+the "*Completions*" buffer vertically by lines, wrapping at the
+top/bottom when 'completion-auto-wrap' is non-nil.
+
+*** New user option 'minibuffer-visible-completions'.
+When customized to non-nil, you can use arrow key in the minibuffer
+to navigate the completions displayed in the *Completions* window.
+Typing 'RET' selects the highlighted candidate. 'C-g' hides the
+completions window. When the completions window is not visible,
+then all these keys have their usual meaning in the minibuffer.
+This option is supported for in-buffer completion as well.
+
** Pcomplete
---
@@ -764,6 +841,13 @@ distracting and easily confused with actual code, or a
significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** JS Mode
+The binding 'M-.' has been removed from the major mode keymaps in
+'js-mode' and 'js-ts-mode', having it default to the global binding
+which calls 'xref-find-definitions'. If the previous one worked
+better for you, use 'define-key' in your init script to bind
+'js-find-symbol' to that combination again.
+
** Python mode
---
@@ -978,6 +1062,11 @@ For links in 'webjump-sites' without an explicit URI
scheme, it was
previously assumed that they should be prefixed with "http://";. Such
URIs are now prefixed with "https://"; instead.
+---
+*** 'bug-reference-mode' now supports 'thing-at-point'.
+Now, calling '(thing-at-point 'url)' when point is on a bug reference
+will return the URL for that bug.
+
** Customize
+++
@@ -1008,19 +1097,6 @@ A major mode based on the tree-sitter library for
editing Lua files.
** Minibuffer and Completions
-*** New commands 'previous-line-completion' and 'next-line-completion'.
-Bound to '<UP>' and '<DOWN>' arrow keys, respectively, they navigate
-the "*Completions*" buffer vertically by lines, wrapping at the
-top/bottom when 'completion-auto-wrap' is non-nil.
-
-*** New user option 'minibuffer-visible-completions'.
-When customized to non-nil, you can use arrow key in the minibuffer
-to navigate the completions displayed in the *Completions* window.
-Typing 'RET' selects the highlighted candidate. 'C-g' hides the
-completions window. When the completions window is not visible,
-then all these keys have their usual meaning in the minibuffer.
-This option is supported for in-buffer completion as well.
-
+++
*** New global minor mode 'minibuffer-regexp-mode'.
This is a minor mode for editing regular expressions in the minibuffer.
@@ -1028,6 +1104,12 @@ It highlights parens via ‘show-paren-mode’ and
‘blink-matching-paren’ in
a user-friendly way, avoids reporting alleged paren mismatches and makes
sexp navigation more intuitive.
++++
+*** New minor mode 'completion-preview-mode'.
+This minor mode shows you symbol completion suggestions as you type,
+using an inline preview. New user options in the 'completion-preview'
+customization group control exactly when Emacs displays this preview.
+
---
** The highly accessible Modus themes collection has eight items.
The 'modus-operandi' and 'modus-vivendi' are the main themes that have
@@ -1040,50 +1122,12 @@ the needs of users with red-green or blue-yellow color
deficiency.
The Info manual "(modus-themes) Top" describes the details and
showcases all their customization options.
-** Project
-
-+++
-*** New user option 'project-mode-line'.
-When non-nil, display the name of the current project on the mode
-line. Clicking 'mouse-1' on the project name pops up the project
-menu. The default value is nil.
-
-*** New user option 'project-file-history-behavior'.
-Customizing it to 'relativize' makes commands like 'project-find-file'
-and 'project-find-dir' display previous history entries relative to
-the current project.
-
-*** New user option 'project-key-prompt-style'.
-The look of the key prompt in the project switcher has been changed
-slightly. To get the previous one, set this option to 'brackets'.
-
-*** 'project-try-vc' tries harder to find the responsible VCS.
-When 'project-vc-extra-root-markers' is non-nil, and causes
-subdirectory project to be detected which is not a VCS root, we now
-additionally traverse the parent directories until a VCS root is found
-(if any), so that the ignore rules for that repository are used, and
-the file listing's performance is still optimized.
-
-*** New commands 'project-any-command' and 'project-prefix-or-any-command'.
-The former is now bound to 'C-x p o' by default.
-The latter is designed primarily for use as a value of
-'project-switch-commands'. If instead of a short menu you prefer to
-have access to all keys defined inside 'project-prefix-map', as well
-as global bindings (to run other commands inside the project root),
-you can add this to your init script:
-
- (setq project-switch-commands #'project-prefix-or-any-command)
-
-** JS Mode
-The binding 'M-.' has been removed from the major mode keymaps in
-'js-mode' and 'js-ts-mode', having it default to the global binding
-which calls 'xref-find-definitions'. If the previous one worked
-better for you, use 'define-key' in your init script to bind
-'js-find-symbol' to that combination again.
-
* Incompatible Lisp Changes in Emacs 30.1
+** '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.
+
** 'buffer-match-p' and 'match-buffers' take '&rest args'.
They used to take a single '&optional arg' and were documented to use
an unreliable hack to try and support condition predicates that
@@ -1181,6 +1225,25 @@ values.
* Lisp Changes in Emacs 30.1
+** New function 'merge-ordered-lists'.
+Mostly used internally to do a kind of topological sort of
+inheritance hierarchies.
+
+** New API for 'derived-mode-p' and control of the graph of major modes.
+
+*** 'derived-mode-p' now takes the list of modes as a single argument.
+The same holds for `provided-mode-derived-p`.
+The old calling convention where multiple modes are passed as
+separate arguments is deprecated.
+
+*** New functions to access the graph of major modes.
+While 'define-derived-mode' still only supports single inheritance,
+modes can declare additional parents (for tests like 'derived-mode-p')
+with `derived-mode-add-parents`.
+Accessing the 'derived-mode-parent' property directly is now
+deprecated in favor of the new functions 'derived-mode-set-parent'
+and 'derived-mode-all-parents'.
+
+++
** Drag-and-drop functions can now be called once for compound drops.
It is now possible for drag-and-drop handler functions to respond to
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index 1b3532b5657..333699f1015 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -62,6 +62,11 @@ of showing the shortcuts.
* Incompatible Lisp Changes in Emacs 29.2
++++
+** 'with-sqlite-transaction' rolls back changes if its BODY fails.
+If the BODY of the macro signals an error, or committing the results
+of the transaction fails, the changes will now be rolled back.
+
* Lisp Changes in Emacs 29.2
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index dfc34a4eaca..72a6639c978 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -2017,6 +2017,16 @@ modern X servers have so many other ways to send input
to clients
without signifying that the event is synthesized that it does not
matter.
+*** Programs which use XSendEvent cannot send input events to Emacs.
+
+Emacs built to use the X Input Extension cannot receive core input
+events sent through the SendEvent server request, since these events
+intercepted by the X server when sent to input extension clients.
+
+For such programs to function again, Emacs must be run on an X server
+where the input extension is disabled, or alternatively be configured
+with the "--without-xinput2" option.
+
* Runtime problems on character terminals
** The meta key does not work on xterm.
@@ -3557,6 +3567,27 @@ port is a large undertaking that we are looking for
volunteers to
perform. If you are interested in taking responsibility for this
task, please contact <emacs-devel@gnu.org>.
+** Emacs can only execute spasmodically in the background.
+
+Recent Android releases impose "battery optimization" on programs for
+which it is not expressly disabled; such optimization inhibits the
+execution of background services outside brief windows of time
+distributed at intervals of several dozens of minutes. Such programs
+as ERC which must send "keep-alive" packets at a rate beyond that at
+which these windows arrive consequently lose, yielding connection
+timeouts after Emacs has been in the background long enough that
+battery optimization enters into effect.
+
+This optimization can be disabled through the Settings app: navigate
+to "Apps & notifications", "Emacs", "Battery", "Battery Optimization",
+before clicking the drop-down menu labeled "Not Optimized", selecting
+the option "All Apps", scrolling to "Emacs", clicking on its entry and
+selecting "Don't Optimize" in the dialog box thus displayed.
+
+The organization of the Settings app might disagree with that
+illustrated above, which if true you should consult the documentation
+or any search mechanism for it.
+
* Build-time problems
** Configuration
diff --git a/etc/TODO b/etc/TODO
index 2292f100ac4..d2d124c9c8e 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -463,15 +463,6 @@ One way of doing this is to start with fx's dynamic
loading, and use it
to implement things like auto-loaded buffer parsers and database
access in cases which need more than Lisp.
-** Fix portable dumping so that you can redump without using -batch
-
-*** Redumps and native compiler "preloaded" sub-folder.
-In order to depose new .eln files being compiled into the "preloaded"
-sub-folder the native compiler needs to know in advance if this file
-will be preloaded or not. As .eln files are not moved afterwards
-subsequent redumps might refer to .eln file out of the "preloaded"
-sub-folder.
-
** Imenu could be extended into a file-structure browsing mechanism
This could use code like that of customize-groups.
@@ -888,6 +879,46 @@ It would make it easy to add (and remove) mappings like
* Things to be done for specific packages or features
+** Native compiler improvements
+
+*** Performance
+
+**** Intra compilation unit call optimization
+
+We could have a mechanism similar to what we use for optimizing calls
+to primitive functions. IE using a link table for each compilation
+unit (CU) such that calls from functions in a CU targeting functions
+in the same CU don't have to go through funcall. If one of these
+functions is redefined, a trampoline is compiled and installed to
+restore the redirection through funcall.
+
+*** Features to be improved or missing
+
+**** Diagnostic
+
+***** Filtering async warnings
+
+Add a new 'native-comp-async-report-warnings-errors' value such that
+we filter out all the uninteresting warnings (that the programmer
+already got during byte compilation) but we still report the important
+ones ('the function ‘xxx’ is not known to be defined.').
+
+This way even if the package developer doesn't use native compilation
+it can get the bug report for the issue and
+'*Async-native-compile-log*' is not too crowded.
+
+This new value for 'native-comp-async-report-warnings-errors' should
+be default.
+
+**** Fix portable dumping so that you can redump without using -batch
+
+***** Redumps and native compiler "preloaded" sub-folder.
+In order to depose new .eln files being compiled into the "preloaded"
+sub-folder the native compiler needs to know in advance if this file
+will be preloaded or not. As .eln files are not moved afterwards
+subsequent redumps might refer to .eln file out of the "preloaded"
+sub-folder.
+
** NeXTstep port
*** Missing features
diff --git a/etc/images/gnus/gnus-pointer.svg b/etc/images/gnus/gnus-pointer.svg
new file mode 100644
index 00000000000..67a631cdcf5
--- /dev/null
+++ b/etc/images/gnus/gnus-pointer.svg
@@ -0,0 +1,94 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Gnu Emacs Logo
+
+ Copyright (C) 2008-2023 Free Software Foundation, Inc.
+
+ Author: Francesc Rocher <f.rocher@member.fsf.org>
+
+ 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/>.
+
+-->
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+<svg
+ width="23.6206187542"
+ height="16"
+ version="1.0"
+ style="display:inline"
+ id="svg1"
+ sodipodi:docname="gnus-pointer.svg"
+ inkscape:version="1.3 (0e150ed6c4, 2023-07-21)"
+ viewBox="0 0 167.68044 113.58242"
+ xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape";
+ xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd";
+ xmlns="http://www.w3.org/2000/svg";
+ xmlns:svg="http://www.w3.org/2000/svg";
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
+ xmlns:cc="http://creativecommons.org/ns#";
+ xmlns:dc="http://purl.org/dc/elements/1.1/";>
+ <defs
+ id="defs1" />
+ <sodipodi:namedview
+ id="namedview1"
+ pagecolor="#ffffff"
+ bordercolor="#666666"
+ borderopacity="1.0"
+ inkscape:showpageshadow="2"
+ inkscape:pageopacity="0.0"
+ inkscape:pagecheckerboard="0"
+ inkscape:deskcolor="#d1d1d1"
+ inkscape:zoom="2.7948886"
+ inkscape:cx="128.09097"
+ inkscape:cy="123.26073"
+ inkscape:current-layer="layer1" />
+ <metadata
+ id="metadata2166">
+ <rdf:RDF>
+ <cc:Work
+ rdf:about="">
+ <dc:format>image/svg+xml</dc:format>
+ <dc:type
+ rdf:resource="http://purl.org/dc/dcmitype/StillImage"; />
+ <cc:license
+ rdf:resource="https://www.gnu.org/copyleft/gpl.html"; />
+ <dc:title>gnus</dc:title>
+ <dc:date>2008/06/28</dc:date>
+ <dc:creator>
+ <cc:Agent>
+ <dc:title>Francesc Rocher</dc:title>
+ </cc:Agent>
+ </dc:creator>
+ <dc:rights>
+ <cc:Agent>
+ <dc:title>GPL</dc:title>
+ </cc:Agent>
+ </dc:rights>
+ <dc:description>gnus icon image</dc:description>
+ <cc:license
+ rdf:resource="https://www.gnu.org/copyleft/gpl.html"; />
+ </cc:Work>
+ </rdf:RDF>
+ </metadata>
+ <g
+ inkscape:label="Layer 1"
+ inkscape:groupmode="layer"
+ id="layer1"
+ transform="translate(-214.53867,-140.13329)">
+ <path
+ style="fill-opacity:1"
+ d="m 321.70896,253.17911 c -0.36667,-0.36666 -0.67201,-5.20416
-0.67854,-10.75 -0.019,-16.11278 -3.80254,-26.01429 -11.53101,-30.17635
-1.90142,-1.02398 -3.45712,-2.07087 -3.45712,-2.32642 0,-1.43357
10.45296,-16.08056 11.47604,-16.08056 2.47319,0 9.23725,5.87604
10.97182,9.53138 5.03752,10.61578 4.34103,30.55989 -1.50929,43.21862
-3.28874,7.11606 -3.93373,7.9215 -5.2719,6.58333 z m -77.16152,-8.46295 c
-4.45468,-3.91126 -4.44465,-5.90837 0.0814,-16.20837 6.498,-14.78751 34.5082,-
[...]
+ id="path1" />
+ </g>
+</svg>
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index 240e3366b0b..4b73a544e80 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,5 +1,5 @@
% Reference Card for Org Mode
-\def\orgversionnumber{9.6.10}
+\def\orgversionnumber{9.6.11}
\def\versionyear{2023} % latest update
\input emacsver.tex
diff --git a/java/org/gnu/emacs/EmacsApplication.java
b/java/org/gnu/emacs/EmacsApplication.java
index 8afa5bcedb4..d70f16346e5 100644
--- a/java/org/gnu/emacs/EmacsApplication.java
+++ b/java/org/gnu/emacs/EmacsApplication.java
@@ -25,19 +25,61 @@ import java.io.FileFilter;
import android.content.Context;
import android.app.Application;
+
+import android.content.pm.ApplicationInfo;
+import android.content.pm.PackageManager.ApplicationInfoFlags;
+import android.content.pm.PackageManager;
+
+import android.os.Build;
+
import android.util.Log;
public final class EmacsApplication extends Application
{
private static final String TAG = "EmacsApplication";
- /* The name of the dump file to use. */
+ /* The name of the dump file to use, or NULL if this Emacs binary
+ has yet to be dumped. */
public static String dumpFileName;
+ /* The name of the APK file housing Emacs, or NULL if it could not
+ be ascertained. */
+ public static String apkFileName;
+
+ @SuppressWarnings ("deprecation")
+ private String
+ getApkFile ()
+ {
+ PackageManager manager;
+ ApplicationInfo info;
+
+ manager = getPackageManager ();
+
+ try
+ {
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.TIRAMISU)
+ info = manager.getApplicationInfo ("org.gnu.emacs", 0);
+ else
+ info = manager.getApplicationInfo ("org.gnu.emacs",
+ ApplicationInfoFlags.of (0));
+
+ /* Return an empty string upon failure. */
+
+ if (info.sourceDir != null)
+ return info.sourceDir;
+
+ return null;
+ }
+ catch (Exception e)
+ {
+ return null;
+ }
+ }
+
public static void
findDumpFile (Context context)
{
- File filesDirectory;
+ File filesDirectory, apk;
File[] allFiles;
String wantedDumpFile;
int i;
@@ -67,7 +109,29 @@ public final class EmacsApplication extends Application
for (i = 0; i < allFiles.length; ++i)
{
if (allFiles[i].getName ().equals (wantedDumpFile))
- dumpFileName = allFiles[i].getAbsolutePath ();
+ {
+ /* Compare the last modified time of the dumpfile with
+ that of apkFileName, the time at which Emacs was
+ installed. Delete it if the dump file was created
+ before Emacs was installed, even if the C signature
+ (representing libemacs.so) remains identical. */
+
+ if (apkFileName != null)
+ {
+ apk = new File (apkFileName);
+
+ if (apk.lastModified ()
+ > allFiles[i].lastModified ())
+ {
+ allFiles[i].delete ();
+
+ /* Don't set the dump file name in this case. */
+ continue;
+ }
+ }
+
+ dumpFileName = allFiles[i].getAbsolutePath ();
+ }
else
/* Delete this outdated dump file. */
allFiles[i].delete ();
@@ -83,6 +147,9 @@ public final class EmacsApplication extends Application
will be restored for the Emacs thread in `initEmacs'. */
EmacsNative.setupSystemThread ();
+ /* Establish the name of the APK. */
+ apkFileName = getApkFile ();
+
/* Locate a suitable dump file. */
findDumpFile (this);
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java
b/java/org/gnu/emacs/EmacsOpenActivity.java
index a5e8be2f238..5cca6cfcdff 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -414,6 +414,7 @@ public final class EmacsOpenActivity extends Activity
String subjectString, textString, attachmentString;
CharSequence tem;
String tem1;
+ String[] emails;
StringBuilder builder;
List<Parcelable> list;
@@ -466,16 +467,16 @@ public final class EmacsOpenActivity extends Activity
/* If fileName is merely mailto: (absent either an email
address or content), then the program launching Emacs
conceivably provided such an URI to exclude non-email
- programs from being enumerated within the Share dialog;
- whereupon Emacs should replace it with any address
- provided as EXTRA_EMAIL. */
+ programs from the Share dialog. Intents created thus
+ might hold the recipient email as a string array, which
+ is non-standard behavior. */
if (fileName.equals ("mailto:";) || fileName.equals ("mailto://";))
{
- tem = intent.getCharSequenceExtra (Intent.EXTRA_EMAIL);
+ emails = intent.getStringArrayExtra (Intent.EXTRA_EMAIL);
- if (tem != null)
- fileName = "mailto:"; + tem;
+ if (emails[0] != null && emails.length > 0)
+ fileName = "mailto:"; + emails[0];
}
/* Subsequently, escape fileName such that it is rendered
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 1aac1a6c4dd..3cc37dd992d 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -53,8 +53,6 @@ import android.content.Intent;
import android.content.IntentFilter;
import android.content.UriPermission;
-import android.content.pm.ApplicationInfo;
-import android.content.pm.PackageManager.ApplicationInfoFlags;
import android.content.pm.PackageManager;
import android.content.res.AssetManager;
@@ -65,6 +63,7 @@ import android.net.Uri;
import android.os.BatteryManager;
import android.os.Build;
+import android.os.Environment;
import android.os.Looper;
import android.os.IBinder;
import android.os.Handler;
@@ -75,6 +74,7 @@ import android.os.VibrationEffect;
import android.provider.DocumentsContract;
import android.provider.DocumentsContract.Document;
+import android.provider.Settings;
import android.util.Log;
import android.util.DisplayMetrics;
@@ -193,36 +193,6 @@ public final class EmacsService extends Service
return null;
}
- @SuppressWarnings ("deprecation")
- private String
- getApkFile ()
- {
- PackageManager manager;
- ApplicationInfo info;
-
- manager = getPackageManager ();
-
- try
- {
- if (Build.VERSION.SDK_INT < Build.VERSION_CODES.TIRAMISU)
- info = manager.getApplicationInfo ("org.gnu.emacs", 0);
- else
- info = manager.getApplicationInfo ("org.gnu.emacs",
- ApplicationInfoFlags.of (0));
-
- /* Return an empty string upon failure. */
-
- if (info.sourceDir != null)
- return info.sourceDir;
-
- return "";
- }
- catch (Exception e)
- {
- return "";
- }
- }
-
/* Return the display density, adjusted in accord with the user's
text scaling preferences. */
@@ -288,7 +258,7 @@ public final class EmacsService extends Service
/* Now provide this application's apk file, so a recursive
invocation of app_process (through android-emacs) can
find EmacsNoninteractive. */
- classPath = getApkFile ();
+ classPath = EmacsApplication.apkFileName;
Log.d (TAG, "Initializing Emacs, where filesDir = " + filesDir
+ ", libDir = " + libDir + ", and classPath = " + classPath
@@ -1941,4 +1911,124 @@ public final class EmacsService extends Service
return false;
}
+
+
+
+ /* Functions for detecting and requesting storage permissions. */
+
+ public boolean
+ externalStorageAvailable ()
+ {
+ final String readPermission;
+
+ readPermission = "android.permission.READ_EXTERNAL_STORAGE";
+
+ return (Build.VERSION.SDK_INT < Build.VERSION_CODES.R
+ ? (checkSelfPermission (readPermission)
+ == PackageManager.PERMISSION_GRANTED)
+ : Environment.isExternalStorageManager ());
+ }
+
+ private void
+ requestStorageAccess23 ()
+ {
+ Runnable runnable;
+
+ runnable = new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ EmacsActivity activity;
+ String permission, permission1;
+
+ permission = "android.permission.READ_EXTERNAL_STORAGE";
+ permission1 = "android.permission.WRITE_EXTERNAL_STORAGE";
+
+ /* Find an activity that is entitled to display a permission
+ request dialog. */
+
+ if (EmacsActivity.focusedActivities.isEmpty ())
+ {
+ /* If focusedActivities is empty then this dialog may
+ have been displayed immediately after another popup
+ dialog was dismissed. Try the EmacsActivity to be
+ focused. */
+
+ activity = EmacsActivity.lastFocusedActivity;
+
+ if (activity == null)
+ {
+ /* Still no luck. Return failure. */
+ return;
+ }
+ }
+ else
+ activity = EmacsActivity.focusedActivities.get (0);
+
+ /* Now request these permissions. */
+ activity.requestPermissions (new String[] { permission,
+ permission1, },
+ 0);
+ }
+ };
+
+ runOnUiThread (runnable);
+ }
+
+ private void
+ requestStorageAccess30 ()
+ {
+ Runnable runnable;
+ final Intent intent;
+
+ intent
+ = new Intent (Settings.ACTION_MANAGE_APP_ALL_FILES_ACCESS_PERMISSION,
+ Uri.parse ("package:org.gnu.emacs"));
+
+ runnable = new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ EmacsActivity activity;
+
+ /* Find an activity that is entitled to display a permission
+ request dialog. */
+
+ if (EmacsActivity.focusedActivities.isEmpty ())
+ {
+ /* If focusedActivities is empty then this dialog may
+ have been displayed immediately after another popup
+ dialog was dismissed. Try the EmacsActivity to be
+ focused. */
+
+ activity = EmacsActivity.lastFocusedActivity;
+
+ if (activity == null)
+ {
+ /* Still no luck. Return failure. */
+ return;
+ }
+ }
+ else
+ activity = EmacsActivity.focusedActivities.get (0);
+
+ /* Now request these permissions. */
+
+ activity.startActivity (intent);
+ }
+ };
+
+ runOnUiThread (runnable);
+ }
+
+ public void
+ requestStorageAccess ()
+ {
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.R)
+ requestStorageAccess23 ();
+ else
+ requestStorageAccess30 ();
+ }
};
diff --git a/java/org/gnu/emacs/EmacsWindow.java
b/java/org/gnu/emacs/EmacsWindow.java
index d7a37a8d57f..7d161fdcf88 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -648,6 +648,21 @@ public final class EmacsWindow extends EmacsHandleObject
long serial;
String characters;
+ if (keyCode == KeyEvent.KEYCODE_BACK)
+ {
+ /* New Android systems display Back navigation buttons on a
+ row of virtual buttons at the bottom of the screen. These
+ buttons function much as physical buttons do, in that key
+ down events are produced when a finger taps them, even if
+ the finger is not ultimately released after the OS's
+ gesture navigation is activated.
+
+ Deliver onKeyDown events in onKeyUp instead, so as not to
+ navigate backwards during gesture navigation. */
+
+ return;
+ }
+
state = eventModifiers (event);
/* Ignore meta-state understood by Emacs for now, or key presses
@@ -677,7 +692,7 @@ public final class EmacsWindow extends EmacsHandleObject
public void
onKeyUp (int keyCode, KeyEvent event)
{
- int state, state_1;
+ int state, state_1, unicode_char;
long time;
/* Compute the event's modifier mask. */
@@ -691,11 +706,21 @@ public final class EmacsWindow extends EmacsHandleObject
= state & ~(KeyEvent.META_ALT_MASK | KeyEvent.META_CTRL_MASK
| KeyEvent.META_SYM_ON | KeyEvent.META_META_MASK);
- EmacsNative.sendKeyRelease (this.handle,
- event.getEventTime (),
- state, keyCode,
- getEventUnicodeChar (event,
- state_1));
+ unicode_char = getEventUnicodeChar (event, state_1);
+
+ if (keyCode == KeyEvent.KEYCODE_BACK)
+ {
+ /* If the key press's been canceled, return immediately. */
+
+ if ((event.getFlags () & KeyEvent.FLAG_CANCELED) != 0)
+ return;
+
+ EmacsNative.sendKeyPress (this.handle, event.getEventTime (),
+ state, keyCode, unicode_char);
+ }
+
+ EmacsNative.sendKeyRelease (this.handle, event.getEventTime (),
+ state, keyCode, unicode_char);
if (keyCode == KeyEvent.KEYCODE_VOLUME_DOWN)
{
@@ -918,8 +943,8 @@ public final class EmacsWindow extends EmacsHandleObject
it in the map. */
pointerIndex = event.getActionIndex ();
pointerID = event.getPointerId (pointerIndex);
- coordinate = new Coordinate ((int) event.getX (0),
- (int) event.getY (0),
+ coordinate = new Coordinate ((int) event.getX (pointerIndex),
+ (int) event.getY (pointerIndex),
buttonForEvent (event),
pointerID);
pointerMap.put (pointerID, coordinate);
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 1a665efb0a5..e916cf25bf0 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -122,6 +122,9 @@ Otherwise display all the abbrevs."
found))
(defun prepare-abbrev-list-buffer (&optional local)
+ "Return buffer listing abbreviations and expansions for each abbrev table.
+
+If LOCAL is non-nil, include in the buffer only the local abbrevs."
(let ((local-table local-abbrev-table))
(with-current-buffer (get-buffer-create "*Abbrevs*")
(erase-buffer)
@@ -333,6 +336,20 @@ Don't use this function in a Lisp program; use
`define-abbrev' instead."
(add-abbrev global-abbrev-table "Global" arg))
(defun add-abbrev (table type arg)
+ "Define abbrev in TABLE, whose expansion is ARG words before point.
+Read the abbreviation from the minibuffer, with prompt TYPE.
+
+ARG of zero means the entire region is the expansion.
+
+A negative ARG means to undefine the specified abbrev.
+
+TYPE is an arbitrary string used to prompt user for the kind of
+abbrev, such as \"Global\", \"Mode\". (This has no influence on the
+choice of the actual TABLE).
+
+See `inverse-add-abbrev' for the opposite task.
+
+Don't use this function in a Lisp program; use `define-abbrev' instead."
(let ((exp
(cond
((or (and (null arg) (use-region-p))
@@ -353,7 +370,7 @@ Don't use this function in a Lisp program; use
`define-abbrev' instead."
(if (or (null exp)
(not (abbrev-expansion name table))
(y-or-n-p (format "%s expands into \"%s\"; redefine? "
- name (abbrev-expansion name table))))
+ name (abbrev-expansion name table))))
(define-abbrev table (downcase name) exp))))
(defun inverse-add-mode-abbrev (n)
@@ -393,6 +410,19 @@ to define an abbrev by specifying the abbreviation in the
minibuffer."
(inverse-add-abbrev global-abbrev-table "Global" n))
(defun inverse-add-abbrev (table type arg)
+ "Define the word before point as an abbrev in TABLE.
+Read the expansion from the minibuffer, using prompt TYPE, define
+the abbrev, and then expand the abbreviation in the current
+buffer.
+
+ARG means use the ARG-th word before point as the abbreviation.
+Negative ARG means use the ARG-th word after point.
+
+TYPE is an arbitrary string used to prompt user for the kind of
+abbrev, such as \"Global\", \"Mode\". (This has no influence on the
+choice of the actual TABLE).
+
+See also `add-abbrev', which performs the opposite task."
(let (name exp start end)
(save-excursion
(forward-word (1+ (- arg)))
@@ -1102,6 +1132,8 @@ Presumes that `standard-output' points to
`current-buffer'."
(insert ")\n"))
(defun abbrev--describe (sym)
+ "Describe abbrev SYM.
+Print on `standard-output' the abbrev, count of use, expansion."
(when (symbol-value sym)
(prin1 (symbol-name sym))
(if (null (abbrev-get sym :system))
@@ -1243,11 +1275,12 @@ which see."
(setq font-lock-multiline nil))
(defun abbrev--possibly-save (query &optional arg)
+ "Hook function for use by `save-some-buffer-functions'.
+
+Maybe save abbrevs, and record whether we either saved them or asked to."
;; Query mode.
(if (eq query 'query)
(and save-abbrevs abbrevs-changed)
- ;; Maybe save abbrevs, and record whether we either saved them or
- ;; asked to.
(and save-abbrevs
abbrevs-changed
(prog1
diff --git a/lisp/align.el b/lisp/align.el
index 9fa78525ecb..4daa20ddd2a 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -555,8 +555,7 @@ The possible settings for `align-region-separate' are:
(repeat . t)
(run-if . ,(lambda ()
(and (not (eq '- current-prefix-arg))
- (not (apply #'provided-mode-derived-p
- major-mode align-tex-modes))))))
+ (not (derived-mode-p align-tex-modes))))))
;; With a negative prefix argument, lists of dollar figures will
;; be aligned.
@@ -1286,7 +1285,7 @@ Otherwise, create a new marker at position POS, with type
TYPE."
This is decided by the `modes' and `run-if' keys in the alist
RULE. Their meaning is documented in `align-rules-list' (which see)."
(let-alist rule
- (not (or (and .modes (not (apply #'derived-mode-p (eval .modes))))
+ (not (or (and .modes (not (derived-mode-p (eval .modes))))
(and .run-if (not (funcall .run-if)))))))
(defun align-region (beg end separate rules exclude-rules
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 418ee265e69..fab77669595 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1042,6 +1042,14 @@ or backward in the buffer. This is in contrast with
\\[forward-word]
and \\[backward-word], which see.
Value is normally t.
+
+The word boundaries are normally determined by the buffer's syntax
+table and character script (according to `char-script-table'), but
+`find-word-boundary-function-table', such as set up by `subword-mode',
+can change that. If a Lisp program needs to move by words determined
+strictly by the syntax table, it should use `forward-word-strictly'
+instead. See Info node `(elisp) Word Motion' for details.
+
If an edge of the buffer or a field boundary is reached, point is left there
and the function returns nil. Field boundaries are not noticed
if `inhibit-field-text-motion' is non-nil."
@@ -1058,6 +1066,14 @@ or forward in the buffer. This is in contrast with
\\[backward-word]
and \\[forward-word], which see.
Value is normally t.
+
+The word boundaries are normally determined by the buffer's syntax
+table and character script (according to `char-script-table'), but
+`find-word-boundary-function-table', such as set up by `subword-mode',
+can change that. If a Lisp program needs to move by words determined
+strictly by the syntax table, it should use `forward-word-strictly'
+instead. See Info node `(elisp) Word Motion' for details.
+
If an edge of the buffer or a field boundary is reached, point is left there
and the function returns nil. Field boundaries are not noticed
if `inhibit-field-text-motion' is non-nil."
diff --git a/lisp/button.el b/lisp/button.el
index bfe6ccc8d1f..ed11c9583d8 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -495,7 +495,7 @@ pushing a button, use the `button-describe' command."
(if (eq (car-safe pos) 'touchscreen-down)
;; If touch-screen-track tap returns nil, then the
;; tap was cancelled.
- (when (touch-screen-track-tap pos)
+ (when (touch-screen-track-tap pos nil nil t)
(push-button (posn-point posn) t))
(push-button (posn-point posn) t))))))
;; POS is just normal position
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index b347cc1da23..41aeb17c252 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -2491,7 +2491,7 @@ the United States."
(defun calcDigit-backspace ()
(interactive)
(cond ((eq last-command 'calcDigit-start)
- (erase-buffer))
+ (delete-minibuffer-contents))
(t (with-suppressed-warnings ((interactive-only backward-delete-char))
(backward-delete-char 1))))
(if (= (calc-minibuffer-size) 0)
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 093ea0e22b6..ab9d629d9fc 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -139,8 +139,8 @@ automatically recalculated when the window width changes.
If the
string consists of more (or less) than one character, it will be
the value of `todo-done-separator'."
:type 'string
- :initialize 'custom-initialize-default
- :set 'todo-reset-done-separator-string
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-done-separator-string
:group 'todo-display)
(defun todo-done-separator ()
@@ -170,8 +170,8 @@ have its intended effect. The second string is inserted
after
the diary date."
:type '(list string string)
:group 'todo-edit
- :initialize 'custom-initialize-default
- :set 'todo-reset-nondiary-marker)
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-nondiary-marker)
(defconst todo-nondiary-start (nth 0 todo-nondiary-marker)
"String inserted before item date to block diary inclusion.")
@@ -189,20 +189,53 @@ The final element is \"*\", indicating an unspecified
month.")
"Array of abbreviated month names, in order.
The final element is \"*\", indicating an unspecified month.")
+(defconst todo--date-pattern-groups
+ (pcase calendar-date-style
+ ('american '((monthname . "6") (month . "7") (day . "8") (year .
"9")))
+ ('european '((day . "6") (monthname . "7") (month . "8") (year .
"9")))
+ ('iso '((year . "6") (monthname . "7") (month . "8") (day . "9"))))
+ "Alist for grouping date components in `todo-date-pattern'.")
+
(defconst todo-date-pattern
- (let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
- (concat "\\(?4:\\(?5:" dayname "\\)\\|"
- (calendar-dlet
- ((dayname)
- (monthname (format "\\(?6:%s\\)" (diary-name-pattern
- todo-month-name-array
- todo-month-abbrev-array)))
- (month "\\(?7:[0-9]+\\|\\*\\)")
- (day "\\(?8:[0-9]+\\|\\*\\)")
- (year "-?\\(?9:[0-9]+\\|\\*\\)"))
- (mapconcat #'eval calendar-date-display-form))
- "\\)"))
- "Regular expression matching a todo item date header.")
+ (let* ((dayname (diary-name-pattern calendar-day-name-array nil t))
+ (d (concat "\\(?" (alist-get 'day todo--date-pattern-groups)
+ ":[0-9]+\\|\\*\\)"))
+ (mn (format (concat "\\(?" (alist-get 'monthname
+ todo--date-pattern-groups)
+ ":%s\\)")
+ (diary-name-pattern todo-month-name-array
+ todo-month-abbrev-array)))
+ (m (concat "\\(?" (alist-get 'month todo--date-pattern-groups)
+ ":[0-9]+\\|\\*\\)"))
+ (y (concat "\\(?" (alist-get 'year todo--date-pattern-groups)
+ ":[0-9]+\\|\\*\\)"))
+ (dd "1111111")
+ (mm "2222222")
+ (yy "3333333")
+ (s (concat "\\(?4:\\(?5:" dayname "\\)\\|"
+ (calendar-dlet
+ ((dayname)
+ (monthname mn)
+ (year yy)
+ (month mm)
+ (day dd))
+ (mapconcat #'eval calendar-date-display-form))
+ "\\)")))
+ ;; The default value of calendar-iso-date-display-form calls
+ ;; `string-to-number' on the values of `month' and `day', so we
+ ;; gave them placeholder values above and now replace these with
+ ;; the necessary regexps with appropriately numbered groups, because
+ ;; `todo-edit-item--header' uses these groups.
+ (when (string-match dd s nil t)
+ (setq s (string-replace dd d s)))
+ (when (string-match mm s nil t)
+ (setq s (string-replace mm m s)))
+ (when (string-match yy s nil t)
+ (setq s (string-replace yy y s)))
+ s)
+ "Regular expression matching a todo item date header.
+The value of `calendar-date-display-form' determines the form of
+the date header.")
;; By itself this matches anything, because of the `?'; however, it's only
;; used in the context of `todo-date-pattern' (but Emacs Lisp lacks
@@ -215,8 +248,8 @@ The final element is \"*\", indicating an unspecified
month.")
(defcustom todo-done-string "DONE "
"Identifying string appended to the front of done todo items."
:type 'string
- :initialize 'custom-initialize-default
- :set 'todo-reset-done-string
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-done-string
:group 'todo-edit)
(defconst todo-done-string-start
@@ -242,16 +275,16 @@ The final element is \"*\", indicating an unspecified
month.")
(format-message
"Invalid value: must be distinct from `todo-item-mark'"))
widget)))
- :initialize 'custom-initialize-default
- :set 'todo-reset-prefix
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-prefix
:group 'todo-display)
(defcustom todo-number-prefix t
"Non-nil to prefix items with consecutively increasing integers.
These reflect the priorities of the items in each category."
:type 'boolean
- :initialize 'custom-initialize-default
- :set 'todo-reset-prefix
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-prefix
:group 'todo-display)
(defun todo-mode-line-control (cat)
@@ -273,8 +306,8 @@ todo category. The resulting control becomes the local
value of
(defcustom todo-highlight-item nil
"Non-nil means highlight items at point."
:type 'boolean
- :initialize 'custom-initialize-default
- :set 'todo-reset-highlight-item
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-highlight-item
:group 'todo-display)
(defcustom todo-wrap-lines t
@@ -572,8 +605,8 @@ This lacks the extension and directory components."
"Non-nil to make `todo-show' visit the current todo file.
Otherwise, `todo-show' always visits `todo-default-todo-file'."
:type 'boolean
- :initialize 'custom-initialize-default
- :set 'todo-set-show-current-file
+ :initialize #'custom-initialize-default
+ :set #'todo-set-show-current-file
:group 'todo)
(defcustom todo-show-first 'first
@@ -1334,7 +1367,7 @@ category there as well."
(list archive)))))
(dolist (buf buffers)
(with-current-buffer (find-file-noselect buf)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(setq todo-categories (todo-set-categories))
(save-excursion
(save-restriction
@@ -1382,7 +1415,7 @@ todo or done items."
"\"" (and arg " and all its entries")
"? "))))
(widen)
- (let ((buffer-read-only)
+ (let ((inhibit-read-only t)
(beg (re-search-backward
(concat "^" (regexp-quote (concat todo-category-beg cat))
"\n")
@@ -1762,8 +1795,8 @@ only when no items are marked."
(defcustom todo-comment-string "COMMENT"
"String inserted before optional comment appended to done item."
:type 'string
- :initialize 'custom-initialize-default
- :set 'todo-reset-comment-string
+ :initialize #'custom-initialize-default
+ :set #'todo-reset-comment-string
:group 'todo-edit)
(defcustom todo-undo-item-omit-comment 'ask
@@ -2044,7 +2077,7 @@ their associated keys and their effects."
(todo-date-from-calendar
(let (calendar-view-diary-initially-flag)
(calendar)) ; *Calendar* is now current buffer.
- (define-key calendar-mode-map [remap newline] 'exit-recursive-edit)
+ (define-key calendar-mode-map [remap newline] #'exit-recursive-edit)
;; If user exits Calendar before choosing a date, clean up properly.
(define-key calendar-mode-map
[remap calendar-exit] (lambda ()
@@ -2079,7 +2112,7 @@ prompt for a todo file and then for a category in it."
(calendar-exit)
(todo-insert-item--basic arg nil todo-date-from-calendar))
-(define-key calendar-mode-map "it" 'todo-insert-item-from-calendar)
+(define-key calendar-mode-map "it" #'todo-insert-item-from-calendar)
(defun todo-delete-item ()
"Delete at least one item in this category.
@@ -2100,7 +2133,7 @@ the item at point."
(save-excursion (todo-item-end))))
(overlay-put ov 'face 'todo-search)
(todo-y-or-n-p "Permanently delete this item? "))))
- buffer-read-only)
+ (inhibit-read-only t))
(when answer
(and marked (goto-char (point-min)))
(catch 'done
@@ -2350,10 +2383,18 @@ made in the number or names of categories."
(line-end-position) t)
(let* ((otime (match-string-no-properties 2))
(odayname (match-string-no-properties 5))
- (omonthname (match-string-no-properties 6))
- (omonth (match-string-no-properties 7))
- (oday (match-string-no-properties 8))
- (oyear (match-string-no-properties 9))
+ (mngroup (string-to-number
+ (alist-get 'monthname todo--date-pattern-groups)))
+ (omonthname (match-string-no-properties mngroup))
+ (mgroup (string-to-number
+ (alist-get 'month todo--date-pattern-groups)))
+ (omonth (match-string-no-properties mgroup))
+ (dgroup (string-to-number
+ (alist-get 'day todo--date-pattern-groups)))
+ (oday (match-string-no-properties dgroup))
+ (ygroup (string-to-number
+ (alist-get 'year todo--date-pattern-groups)))
+ (oyear (match-string-no-properties ygroup))
(tmn-array todo-month-name-array)
(mlist (append tmn-array nil))
(tma-array todo-month-abbrev-array)
@@ -2399,11 +2440,23 @@ made in the number or names of categories."
((eq what 'month)
(setf day oday
year oyear
- (if (memq 'month calendar-date-display-form)
+ ;; With default ISO style, 'month is in a
+ ;; sublist of c-d-d-f, so we flatten it.
+ (if (memq 'month (flatten-tree
+ calendar-date-display-form))
month
monthname)
(cond ((not current-prefix-arg)
- (todo-read-date 'month))
+ (let ((nmonth (todo-read-date 'month)))
+ ;; If old month is given as a number,
+ ;; have to convert new month name to
+ ;; the corresponding number.
+ (when omonth
+ (setq nmonth
+ (number-to-string
+ (1+ (seq-position tma-array
+ nmonth)))))
+ nmonth))
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
@@ -2513,7 +2566,7 @@ made in the number or names of categories."
(defun todo-edit-item--diary-inclusion (&optional nonmarking)
"Function providing diary marking facilities of `todo-edit-item'."
- (let ((buffer-read-only)
+ (let ((inhibit-read-only t)
(marked (assoc (todo-current-category) todo-categories-with-marks)))
(when marked (todo--user-error-if-marked-done-item))
(catch 'stop
@@ -2563,7 +2616,7 @@ items."
(goto-char (point-min))
(let ((todo-count (todo-get-count 'todo))
(diary-count (todo-get-count 'diary))
- (buffer-read-only))
+ (inhibit-read-only t))
(catch 'stop
(while (not (eobp))
(if (todo-done-item-p) ; We've gone too far.
@@ -2599,7 +2652,7 @@ items in this category."
(interactive "P")
(save-excursion
(goto-char (point-min))
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(catch 'stop
(while (not (eobp))
(if (todo-done-item-p) ; We've gone too far.
@@ -3269,13 +3322,14 @@ this category does not exist in the archive, it is
created."
(with-current-buffer archive
(unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
(let ((headers-hidden todo--item-headers-hidden)
- buffer-read-only)
+ (inhibit-read-only t))
(if headers-hidden (todo-toggle-item-header))
(widen)
(goto-char (point-min))
(if (and (re-search-forward
(concat "^" (regexp-quote
- (concat todo-category-beg cat)) "$")
+ (concat todo-category-beg cat))
+ "$")
nil t)
(re-search-forward (regexp-quote todo-category-done)
nil t))
@@ -3367,7 +3421,7 @@ the only category in the archive, the archive file is
deleted."
(item (concat (todo-item-string) "\n"))
(marked-count 0)
marked-items
- buffer-read-only)
+ (inhibit-read-only t))
(when marked
(save-excursion
(goto-char (point-min))
@@ -3379,7 +3433,7 @@ the only category in the archive, the archive file is
deleted."
;; Restore items to top of category's done section and update counts.
(with-current-buffer tbuf
(let ((headers-hidden todo--item-headers-hidden)
- buffer-read-only newcat)
+ (inhibit-read-only t) newcat)
(if headers-hidden (todo-toggle-item-header))
(widen)
(goto-char (point-min))
@@ -3869,7 +3923,7 @@ which is the value of the user option
(kill-all-local-variables)
(todo-categories-mode)
(let ((archive (member todo-current-todo-file todo-archives))
- buffer-read-only)
+ (inhibit-read-only t))
(erase-buffer)
(insert (format (concat "Category counts for todo "
(if archive "archive" "file")
@@ -3908,7 +3962,7 @@ which is the value of the user option
(forward-line -2)
(goto-char (next-single-char-property-change
(point) 'face nil (line-end-position))))))
- (buffer-read-only))
+ (inhibit-read-only t))
(forward-line 2)
(delete-region (point) (point-max))
;; Fill in the table with buttonized lines, each showing a category and
@@ -4480,7 +4534,7 @@ the values of FILTER and FILE-LIST."
(widen)))
(setq bufstr (buffer-string))
(with-current-buffer buf
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(insert bufstr)))))))
(set-window-buffer (selected-window) (set-buffer buf))
(todo-prefix-overlays)
@@ -5277,7 +5331,12 @@ changes you have made in the order of the categories.
;; Point is on done items separator.
(save-excursion (beginning-of-line) (looking-at todo-category-done))
;; Buffer is widened.
- (looking-at (regexp-quote todo-category-beg)))
+ (looking-at (regexp-quote todo-category-beg))
+ ;; Moving an item to a todo file (with `C-u m') that had
+ ;; not yet been read into a buffer puts point at the
+ ;; beginning of the file, from where it is impossible to
+ ;; reach todo-item-start by the loop below (bug#66994).
+ (= (point) 1))
(goto-char (line-beginning-position))
(while (not (looking-at todo-item-start))
(forward-line -1))
@@ -5842,7 +5901,7 @@ Also return t if answer is \"Y\", but unlike `y-or-n-p',
allow
SPC to affirm the question only if option `todo-y-with-space' is
non-nil."
(unless todo-y-with-space
- (define-key query-replace-map " " 'ignore))
+ (define-key query-replace-map " " #'ignore))
(prog1
(y-or-n-p prompt)
(define-key query-replace-map " " 'act)))
@@ -6275,7 +6334,7 @@ the empty string (i.e., no time string)."
(dolist (f files)
(let ((buf (find-buffer-visiting f)))
(with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(widen)
(goto-char (point-min))
(while (not (eobp))
@@ -6291,7 +6350,7 @@ the empty string (i.e., no time string)."
(replace-match (nth 1 value) t t nil 2))
(forward-line)))
(if buf
- (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (when (derived-mode-p '(todo-mode todo-archive-mode))
(todo-category-select))
(save-buffer)
(kill-buffer)))))))))
@@ -6305,7 +6364,7 @@ the empty string (i.e., no time string)."
(when (not (equal value oldvalue))
(dolist (f files)
(with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(setq todo-done-separator (todo-done-separator))
(when (= 1 (length value))
(todo-reset-done-separator sep)))
@@ -6324,7 +6383,7 @@ the empty string (i.e., no time string)."
(dolist (f files)
(let ((buf (find-buffer-visiting f)))
(with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(widen)
(goto-char (point-min))
(while (not (eobp))
@@ -6335,7 +6394,7 @@ the empty string (i.e., no time string)."
(replace-match value t t nil 1)
(forward-line)))
(if buf
- (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (when (derived-mode-p '(todo-mode todo-archive-mode))
(todo-category-select))
(save-buffer)
(kill-buffer)))))))))
@@ -6350,7 +6409,7 @@ the empty string (i.e., no time string)."
(dolist (f files)
(let ((buf (find-buffer-visiting f)))
(with-current-buffer (find-file-noselect f)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(widen)
(goto-char (point-min))
(while (not (eobp))
@@ -6361,7 +6420,7 @@ the empty string (i.e., no time string)."
(replace-match value t t nil 1)
(forward-line)))
(if buf
- (when (derived-mode-p 'todo-mode 'todo-archive-mode)
+ (when (derived-mode-p '(todo-mode todo-archive-mode))
(todo-category-select))
(save-buffer)
(kill-buffer)))))))))
@@ -6585,32 +6644,32 @@ Filtered Items mode following todo (not done) items."
(define-key map (nth 0 kb) (nth 1 kb)))
(dolist (kb todo-key-bindings-t+a)
(define-key map (nth 0 kb) (nth 1 kb)))
- (define-key map "a" 'todo-jump-to-archive-category)
- (define-key map "u" 'todo-unarchive-items)
+ (define-key map "a" #'todo-jump-to-archive-category)
+ (define-key map "u" #'todo-unarchive-items)
map)
"Todo Archive mode keymap.")
(defvar todo-edit-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "\C-x\C-q" 'todo-edit-quit)
+ (define-key map "\C-x\C-q" #'todo-edit-quit)
map)
"Todo Edit mode keymap.")
(defvar todo-categories-mode-map
(let ((map (make-sparse-keymap)))
- (define-key map "c" 'todo-sort-categories-alphabetically-or-numerically)
- (define-key map "t" 'todo-sort-categories-by-todo)
- (define-key map "y" 'todo-sort-categories-by-diary)
- (define-key map "d" 'todo-sort-categories-by-done)
- (define-key map "a" 'todo-sort-categories-by-archived)
- (define-key map "#" 'todo-set-category-number)
- (define-key map "l" 'todo-lower-category)
- (define-key map "r" 'todo-raise-category)
- (define-key map "n" 'todo-next-button)
- (define-key map "p" 'todo-previous-button)
- (define-key map [tab] 'todo-next-button)
- (define-key map [backtab] 'todo-previous-button)
- (define-key map "q" 'todo-quit)
+ (define-key map "c" #'todo-sort-categories-alphabetically-or-numerically)
+ (define-key map "t" #'todo-sort-categories-by-todo)
+ (define-key map "y" #'todo-sort-categories-by-diary)
+ (define-key map "d" #'todo-sort-categories-by-done)
+ (define-key map "a" #'todo-sort-categories-by-archived)
+ (define-key map "#" #'todo-set-category-number)
+ (define-key map "l" #'todo-lower-category)
+ (define-key map "r" #'todo-raise-category)
+ (define-key map "n" #'todo-next-button)
+ (define-key map "p" #'todo-previous-button)
+ (define-key map [tab] #'todo-next-button)
+ (define-key map [backtab] #'todo-previous-button)
+ (define-key map "q" #'todo-quit)
map)
"Todo Categories mode keymap.")
@@ -6620,8 +6679,8 @@ Filtered Items mode following todo (not done) items."
(define-key map (nth 0 kb) (nth 1 kb)))
(dolist (kb todo-key-bindings-t+f)
(define-key map (nth 0 kb) (nth 1 kb)))
- (define-key map "g" 'todo-go-to-source-item)
- (define-key map [remap newline] 'todo-go-to-source-item)
+ (define-key map "g" #'todo-go-to-source-item)
+ (define-key map [remap newline] #'todo-go-to-source-item)
map)
"Todo Filtered Items mode keymap.")
@@ -6777,13 +6836,9 @@ Added to `window-configuration-change-hook' in Todo
mode."
;; (add-hook 'find-file-hook #'todo-display-as-todo-file nil t)
)
-(put 'todo-mode 'mode-class 'special)
-
;;;###autoload
(define-derived-mode todo-mode special-mode "Todo"
- "Major mode for displaying, navigating and editing todo lists.
-
-\\{todo-mode-map}"
+ "Major mode for displaying, navigating and editing todo lists."
(if (called-interactively-p 'any)
(message "%s"
(substitute-command-keys
@@ -6805,15 +6860,11 @@ Added to `window-configuration-change-hook' in Todo
mode."
#'todo-reset-and-enable-done-separator nil t)
(add-hook 'kill-buffer-hook #'todo-reset-global-current-todo-file nil t)))
-(put 'todo-archive-mode 'mode-class 'special)
-
;; If todo-mode is parent, all todo-mode key bindings appear to be
;; available in todo-archive-mode (e.g. shown by C-h m).
;;;###autoload
(define-derived-mode todo-archive-mode special-mode "Todo-Arch"
- "Major mode for archived todo categories.
-
-\\{todo-archive-mode-map}"
+ "Major mode for archived todo categories."
(todo-modes-set-1)
(todo-modes-set-2)
(todo-modes-set-3)
@@ -6821,9 +6872,7 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local todo-show-done-only t))
(define-derived-mode todo-edit-mode text-mode "Todo-Ed"
- "Major mode for editing multiline todo items.
-
-\\{todo-edit-mode-map}"
+ "Major mode for editing multiline todo items."
(todo-modes-set-1)
(setq-local indent-line-function #'todo-indent)
(if (> (buffer-size) (- (point-max) (point-min)))
@@ -6836,12 +6885,8 @@ Added to `window-configuration-change-hook' in Todo
mode."
(setq-local todo-categories (todo-set-categories)))
(setq buffer-read-only nil))
-(put 'todo-categories-mode 'mode-class 'special)
-
(define-derived-mode todo-categories-mode special-mode "Todo-Cats"
- "Major mode for displaying and editing todo categories.
-
-\\{todo-categories-mode-map}"
+ "Major mode for displaying and editing todo categories."
(setq-local todo-current-todo-file todo-global-current-todo-file)
(setq-local todo-categories
;; Can't use find-buffer-visiting when
@@ -6852,13 +6897,9 @@ Added to `window-configuration-change-hook' in Todo
mode."
todo-current-todo-file 'nowarn)
todo-categories)))
-(put 'todo-filtered-items-mode 'mode-class 'special)
-
;;;###autoload
(define-derived-mode todo-filtered-items-mode special-mode "Todo-Fltr"
- "Mode for displaying and reprioritizing top priority Todo.
-
-\\{todo-filtered-items-mode-map}"
+ "Mode for displaying and reprioritizing top priority Todo."
(todo-modes-set-1)
(todo-modes-set-2))
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index c1a48bc50c8..4fb4460d4c6 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -68,22 +68,15 @@ walk through. It defaults to `buffer-list'."
(when (or (not predicate) (funcall predicate))
(funcall function))))))
-(defsubst get-mode-local-parent (mode)
+(defun get-mode-local-parent (mode)
"Return the mode parent of the major mode MODE.
Return nil if MODE has no parent."
+ (declare (obsolete derived-mode-all-parents "30.1"))
(or (get mode 'mode-local-parent)
(get mode 'derived-mode-parent)))
-;; FIXME doc (and function name) seems wrong.
-;; Return a list of MODE and all its parent modes, if any.
-;; Lists parent modes first.
-(defun mode-local-equivalent-mode-p (mode)
- "Is the major-mode in the current buffer equivalent to a mode in MODES."
- (let ((modes nil))
- (while mode
- (setq modes (cons mode modes)
- mode (get-mode-local-parent mode)))
- modes))
+(define-obsolete-function-alias 'mode-local-equivalent-mode-p
+ #'derived-mode-all-parents "30.1")
(defun mode-local-map-mode-buffers (function modes)
"Run FUNCTION on every file buffer with major mode in MODES.
@@ -91,13 +84,7 @@ MODES can be a symbol or a list of symbols.
FUNCTION does not have arguments."
(setq modes (ensure-list modes))
(mode-local-map-file-buffers
- function (lambda ()
- (let ((mm (mode-local-equivalent-mode-p major-mode))
- (ans nil))
- (while (and (not ans) mm)
- (setq ans (memq (car mm) modes)
- mm (cdr mm)) )
- ans))))
+ function (lambda () (apply #'derived-mode-p modes))))
;;; Hook machinery
;;
@@ -145,7 +132,8 @@ after changing the major mode."
"Set parent of major mode MODE to PARENT mode.
To work properly, this function should be called after PARENT mode
local variables have been defined."
- (put mode 'mode-local-parent parent)
+ (declare (obsolete derived-mode-add-parents "30.1"))
+ (derived-mode-add-parents mode (list parent))
;; Refresh mode bindings to get mode local variables inherited from
;; PARENT. To work properly, the following should be called after
;; PARENT mode local variables have been defined.
@@ -159,13 +147,8 @@ definition."
(declare (obsolete define-derived-mode "27.1") (indent 2))
`(mode-local--set-parent ',mode ',parent))
-(defun mode-local-use-bindings-p (this-mode desired-mode)
- "Return non-nil if THIS-MODE can use bindings of DESIRED-MODE."
- (let ((ans nil))
- (while (and (not ans) this-mode)
- (setq ans (eq this-mode desired-mode))
- (setq this-mode (get-mode-local-parent this-mode)))
- ans))
+(define-obsolete-function-alias 'mode-local-use-bindings-p
+ #'provided-mode-derived-p "30.1")
;;; Core bindings API
@@ -270,11 +253,13 @@ its parents."
(setq mode major-mode
bind (and mode-local-symbol-table
(intern-soft name mode-local-symbol-table))))
- (while (and mode (not bind))
- (or (and (get mode 'mode-local-symbol-table)
- (setq bind (intern-soft
- name (get mode 'mode-local-symbol-table))))
- (setq mode (get-mode-local-parent mode))))
+ (let ((parents (derived-mode-all-parents mode)))
+ (while (and parents (not bind))
+ (or (and (get (car parents) 'mode-local-symbol-table)
+ (setq bind (intern-soft
+ name (get (car parents)
+ 'mode-local-symbol-table))))
+ (setq parents (cdr parents)))))
bind))
(defsubst mode-local-symbol-value (symbol &optional mode property)
@@ -311,16 +296,12 @@ Elements are (SYMBOL . PREVIOUS-VALUE), describing one
variable."
(mode-local-on-major-mode-change)
;; Do the normal thing.
- (let (modes table old-locals)
+ (let (table old-locals)
(unless mode
(setq-local mode-local--init-mode major-mode)
(setq mode major-mode))
- ;; Get MODE's parents & MODE in the right order.
- (while mode
- (setq modes (cons mode modes)
- mode (get-mode-local-parent mode)))
;; Activate mode bindings following parent modes order.
- (dolist (mode modes)
+ (dolist (mode (derived-mode-all-parents mode))
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
(lambda (var)
@@ -345,14 +326,13 @@ If MODE is not specified it defaults to current
`major-mode'."
(kill-local-variable 'mode-local--init-mode)
(setq mode major-mode))
(let (table)
- (while mode
+ (dolist (mode (derived-mode-all-parents mode))
(when (setq table (get mode 'mode-local-symbol-table))
(mapatoms
(lambda (var)
(when (get var 'mode-variable-flag)
(kill-local-variable (intern (symbol-name var)))))
- table))
- (setq mode (get-mode-local-parent mode)))))
+ table)))))
(defmacro with-mode-local-symbol (mode &rest body)
"With the local bindings of MODE symbol, evaluate BODY.
@@ -866,12 +846,11 @@ META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
(when table
(princ "\n- Buffer local\n")
(mode-local-print-bindings table))
- (while mode
+ (dolist (mode (derived-mode-all-parents mode))
(setq table (get mode 'mode-local-symbol-table))
(when table
(princ (format-message "\n- From `%s'\n" mode))
- (mode-local-print-bindings table))
- (setq mode (get-mode-local-parent mode)))))
+ (mode-local-print-bindings table)))))
(defun mode-local-describe-bindings-1 (buffer-or-mode &optional interactive-p)
"Display mode local bindings active in BUFFER-OR-MODE.
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 7c7ee749249..0c78493542f 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -799,7 +799,7 @@ local variable."
(null (oref table major-mode))
;; nil means the same as major-mode
(and (not semantic-equivalent-major-modes)
- (mode-local-use-bindings-p major-mode (oref table major-mode)))
+ (provided-mode-derived-p major-mode (oref table major-mode)))
(and semantic-equivalent-major-modes
(member (oref table major-mode) semantic-equivalent-major-modes))
)
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index 60c57210b8f..15ad18ad886 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -644,7 +644,7 @@ The symbols in the list are local variables in
(cond
(x (cdr x))
((symbolp S) (symbol-value S))))))
- template ""))
+ template))
(defun semantic-grammar-header ()
"Return text of a generated standard header."
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index 6a16845ecf2..35f09e7a784 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -434,8 +434,7 @@ continue processing recursively."
(symbolp (car (car val))))
(mapconcat (lambda (subtok)
(semantic-lex-spp-one-token-to-txt subtok))
- val
- ""))
+ val))
;; If val is nil, that's probably wrong.
;; Found a system header case where this was true.
((null val) "")
@@ -699,8 +698,7 @@ be merged recursively."
(message "Invalid merge macro encountered; \
will return empty string instead.")
"")))
- txt
- ""))
+ txt))
(defun semantic-lex-spp-find-closing-macro ()
"Find next macro which closes a scope through a close-paren.
diff --git a/lisp/cedet/semantic/wisent/python.el
b/lisp/cedet/semantic/wisent/python.el
index c6a8a35d8df..6b274df614c 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -262,18 +262,19 @@ the indentation of the current line."
;; Loop lexer to handle tokens in current line.
t)
;; Indentation decreased
- ((progn
- ;; Pop items from indentation stack
- (while (< curr-indent last-indent)
- (pop wisent-python-indent-stack)
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth)
- last-indent (car wisent-python-indent-stack))
- (semantic-lex-push-token
- (semantic-lex-token 'DEDENT last-pos (point))))
- (= last-pos (point)))
- ;; If pos did not change, then we must return nil so that
- ;; other lexical analyzers can be run.
- nil))))
+ (t
+ ;; Pop items from indentation stack
+ (while (< curr-indent last-indent)
+ (pop wisent-python-indent-stack)
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth)
+ last-indent (car wisent-python-indent-stack))
+ (semantic-lex-push-token
+ (semantic-lex-token 'DEDENT last-pos (point))))
+ ;; (if (= last-pos (point))
+ ;; ;; If pos did not change, then we must return nil so that
+ ;; ;; other lexical analyzers can be run.
+ ;; nil)
+ ))))
;; All the work was done in the above analyzer matching condition.
)
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index cfd64edfc98..6d64a26e46c 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -34,12 +34,12 @@
(defun srecode-table (&optional mode)
"Return the currently active Semantic Recoder table for this buffer.
Optional argument MODE specifies the mode table to use."
- (let* ((modeq (or mode major-mode))
- (table (srecode-get-mode-table modeq)))
+ (let ((modes (derived-mode-all-parents (or mode major-mode)))
+ (table nil))
;; If there isn't one, keep searching backwards for a table.
- (while (and (not table) (setq modeq (get-mode-local-parent modeq)))
- (setq table (srecode-get-mode-table modeq)))
+ (while (and modes (not (setq table (srecode-get-mode-table (car modes)))))
+ (setq modes (cdr modes)))
;; Last ditch effort.
(when (not table)
@@ -57,35 +57,23 @@ Templates are found in the SRecode Template Map.
See `srecode-get-maps' for more.
APPNAME is the name of an application. In this case,
all template files for that application will be loaded."
- (let ((files
- (apply #'append
- (mapcar
- (if appname
+ (dolist (mmode (cons 'default (reverse (derived-mode-all-parents mmode))))
+ (let ((files
+ (apply #'append
+ (mapcar
+ (if appname
+ (lambda (map)
+ (srecode-map-entries-for-app-and-mode map appname
mmode))
(lambda (map)
- (srecode-map-entries-for-app-and-mode map appname mmode))
- (lambda (map)
- (srecode-map-entries-for-mode map mmode)))
- (srecode-get-maps))))
- )
- ;; Don't recurse if we are already the 'default state.
- (when (not (eq mmode 'default))
- ;; Are we a derived mode? If so, get the parent mode's
- ;; templates loaded too.
- (if (get-mode-local-parent mmode)
- (srecode-load-tables-for-mode (get-mode-local-parent mmode)
- appname)
- ;; No parent mode, all templates depend on the defaults being
- ;; loaded in, so get that in instead.
- (srecode-load-tables-for-mode 'default appname)))
+ (srecode-map-entries-for-mode map mmode)))
+ (srecode-get-maps)))))
- ;; Load in templates for our major mode.
- (dolist (f files)
- (let ((mt (srecode-get-mode-table mmode))
- )
- (when (or (not mt) (not (srecode-mode-table-find mt (car f))))
- (srecode-compile-file (car f)))
- ))
- ))
+ ;; Load in templates for our major mode.
+ (when files
+ (let ((mt (srecode-get-mode-table mmode)))
+ (dolist (f files)
+ (when (not (and mt (srecode-mode-table-find mt (car f))))
+ (srecode-compile-file (car f)))))))))
;;; PROJECT
;;
@@ -227,12 +215,12 @@ Optional argument MODE is the major mode to look for.
Optional argument HASH is the hash table to fill in.
Optional argument PREDICATE can be used to filter the returned
templates."
- (let* ((mhash (or hash (make-hash-table :test 'equal)))
- (mmode (or mode major-mode))
- (parent-mode (get-mode-local-parent mmode)))
- ;; Get the parent hash table filled into our current hash.
- (unless (eq mode 'default)
- (srecode-all-template-hash (or parent-mode 'default) mhash))
+ (let* ((mhash (or hash (make-hash-table :test 'equal))))
+ (dolist (mmode (cons 'default
+ ;; Get the parent hash table filled into our
+ ;; current hash.
+ (reverse (derived-mode-all-parents
+ (or mode major-mode)))))
;; Load up the hash table for our current mode.
(let* ((mt (srecode-get-mode-table mmode))
@@ -246,7 +234,7 @@ templates."
(funcall predicate temp))
(puthash key temp mhash)))
(oref tab namehash))))
- mhash)))
+ mhash))))
(defun srecode-calculate-default-template-string (hash)
"Calculate the name of the template to use as a DEFAULT.
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 004bb7adddb..44e465c69b1 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -76,7 +76,7 @@ Each app keys to an alist of files and modes (as above.)")
"Return the entries in MAP for major MODE."
(let ((ans nil))
(dolist (f (oref map files))
- (when (mode-local-use-bindings-p mode (cdr f))
+ (when (provided-mode-derived-p mode (cdr f))
(setq ans (cons f ans))))
ans))
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index de151049f7f..e5ab53dd253 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -137,41 +137,36 @@ Tracks all the template-tables for a specific major
mode.")
"Get the SRecoder mode table for the major mode MODE.
This will find the mode table specific to MODE, and then
calculate all inherited templates from parent modes."
- (let ((table nil)
- (tmptable nil))
- (while mode
- (setq tmptable (eieio-instance-tracker-find
- mode 'major-mode 'srecode-mode-table-list)
- mode (get-mode-local-parent mode))
- (when tmptable
- (if (not table)
- (progn
- ;; If this is the first, update tables to have
- ;; all the mode specific tables in it.
- (setq table tmptable)
- (oset table tables (oref table modetables)))
- ;; If there already is a table, then reset the tables
- ;; slot to include all the tables belonging to this new child node.
- (oset table tables (append (oref table modetables)
- (oref tmptable modetables)))))
- )
+ (let ((table nil))
+ (dolist (mode (derived-mode-all-parents mode))
+ (let ((tmptable (eieio-instance-tracker-find
+ mode 'major-mode 'srecode-mode-table-list)))
+ (when tmptable
+ (if (not table)
+ (progn
+ ;; If this is the first, update tables to have
+ ;; all the mode specific tables in it.
+ (setq table tmptable)
+ (oset table tables (oref table modetables)))
+ ;; If there already is a table, then reset the tables
+ ;; slot to include all the tables belonging to this new child node.
+ (oset table tables (append (oref table modetables)
+ (oref tmptable modetables)))))
+ ))
table))
(defun srecode-make-mode-table (mode)
"Get the SRecoder mode table for the major mode MODE."
(let ((old (eieio-instance-tracker-find
mode 'major-mode 'srecode-mode-table-list)))
- (if old
- old
- (let* ((ms (if (stringp mode) mode (symbol-name mode)))
- (new (srecode-mode-table ms
- :major-mode mode
- :modetables nil
- :tables nil)))
- ;; Save this new mode table in that mode's variable.
- (eval `(setq-mode-local ,mode srecode-table ,new) t)
+ (or old
+ (let* ((new (srecode-mode-table :major-mode mode
+ :modetables nil
+ :tables nil)))
+ ;; Save this new mode table in that mode's variable.
+ (eval `(setq-mode-local ,mode srecode-table ,new) t)
- new))))
+ new))))
(cl-defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
"Look in the mode table MT for a template table from FILE.
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
new file mode 100644
index 00000000000..6048d5be272
--- /dev/null
+++ b/lisp/completion-preview.el
@@ -0,0 +1,337 @@
+;;; completion-preview.el --- Preview completion with inline overlay -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Maintainer: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: abbrev convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides the Completion Preview mode. This minor mode
+;; displays the top completion candidate 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 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
+;; suggestion as you type according to the text around point.
+;;
+;; The commands `completion-preview-next-candidate' and
+;; `completion-preview-prev-candidate' allow you to cycle the
+;; completion candidate that the preview suggests. These commands
+;; don't have a default keybinding, but you can bind them, for
+;; example, to M-n and M-p in `completion-preview-active-mode-map' to
+;; have them handy whenever the preview is visible.
+;;
+;; If you set the user option `completion-preview-exact-match-only' to
+;; non-nil, Completion Preview mode only suggests a completion
+;; candidate when its the only possible completion for the (partial)
+;; symbol at point. The user option `completion-preview-commands'
+;; says which commands should trigger the completion preview. The
+;; user option `completion-preview-minimum-symbol-length' specifies a
+;; minimum number of consecutive characters with word or symbol syntax
+;; 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:
+
+(defgroup completion-preview nil
+ "In-buffer completion preview."
+ :group 'completion)
+
+(defcustom completion-preview-exact-match-only nil
+ "Whether to show completion preview only when there is an exact match.
+
+If this option is non-nil, Completion Preview mode only shows the
+preview when there is exactly one completion candidate that
+matches the symbol at point. Otherwise, if this option is nil,
+when there are multiple matching candidates the preview shows the
+first candidate, and you can cycle between the candidates with
+\\[completion-preview-next-candidate] and
+\\[completion-preview-prev-candidate]."
+ :type 'boolean
+ :version "30.1")
+
+(defcustom completion-preview-commands '(self-insert-command
+ insert-char
+ delete-backward-char
+ backward-delete-char-untabify
+ analyze-text-conversion)
+ "List of commands that should trigger completion preview."
+ :type '(repeat (function :tag "Command" :value self-insert-command))
+ :version "30.1")
+
+(defcustom completion-preview-minimum-symbol-length 3
+ "Minimum length of the symbol at point for showing completion preview."
+ :type 'natnum
+ :version "30.1")
+
+(defcustom completion-preview-insert-on-completion nil
+ "Whether \\[completion-at-point] inserts the previewed suggestion."
+ :type 'boolean
+ :version "30.1")
+
+(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha
+ "Sort function to use for choosing a completion candidate to preview.")
+
+(defface completion-preview
+ '((t :inherit shadow))
+ "Face for completion preview overlay."
+ :version "30.1")
+
+(defface completion-preview-exact
+ '((((supports :underline t))
+ :underline t :inherit completion-preview)
+ (((supports :weight bold))
+ :weight bold :inherit completion-preview)
+ (t :background "gray"))
+ "Face for exact completion preview overlay."
+ :version "30.1")
+
+(defvar-keymap completion-preview-active-mode-map
+ :doc "Keymap for Completion Preview Active mode."
+ "C-i" #'completion-preview-insert
+ ;; "M-n" #'completion-preview-next-candidate
+ ;; "M-p" #'completion-preview-prev-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.")
+
+(defsubst completion-preview--internal-command-p ()
+ "Return non-nil if `this-command' manipulates the completion preview."
+ (memq this-command completion-preview--internal-commands))
+
+(defsubst completion-preview-require-certain-commands ()
+ "Check if `this-command' is one of `completion-preview-commands'."
+ (or (completion-preview--internal-command-p)
+ (memq this-command completion-preview-commands)))
+
+(defun completion-preview-require-minimum-symbol-length ()
+ "Check if the length of symbol at point is at least above a certain
threshold.
+`completion-preview-minimum-symbol-length' determines that threshold."
+ (let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (and bounds (<= completion-preview-minimum-symbol-length
+ (- (cdr bounds) (car bounds))))))
+
+(defun completion-preview-hide ()
+ "Hide the completion preview."
+ (when completion-preview--overlay
+ (delete-overlay completion-preview--overlay)
+ (setq completion-preview--overlay nil)))
+
+(defun completion-preview--make-overlay (pos string)
+ "Make a new completion preview overlay at POS showing STRING."
+ (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))
+ (add-text-properties 0 1 '(cursor 1) string)
+ (overlay-put completion-preview--overlay 'after-string string))
+ completion-preview--overlay))
+
+(defun 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))))
+
+(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)))))))))
+
+(defun completion-preview--show ()
+ "Show a new completion preview.
+
+Call `completion-at-point-functions' in order to obtain and
+display a completion candidate for the text around point.
+
+If the preview is already shown, first check whether the
+suggested candidate remains a valid completion for the text at
+point. If so, update the preview according the new text at
+point, otherwise hide it."
+ (when completion-preview-active-mode
+ ;; We were already showing a preview before this command, so we
+ ;; check if the text before point is still a prefix of the
+ ;; candidate that the preview suggested, and if so we first update
+ ;; existing preview according to the changes made by this command,
+ ;; and only then try to get a new candidate. This ensures that we
+ ;; never display a stale preview and that the preview doesn't
+ ;; flicker, even with slow completion backends.
+ (let* ((beg (completion-preview--get 'completion-preview-beg))
+ (cands (completion-preview--get 'completion-preview-cands))
+ (index (completion-preview--get 'completion-preview-index))
+ (cand (nth index cands))
+ (len (length cand))
+ (end (+ beg len))
+ (cur (point))
+ (face (get-text-property 0 'face (completion-preview--get
'after-string))))
+ (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur)
cand))
+ ;; The previous preview is still applicable, update it.
+ (overlay-put (completion-preview--make-overlay
+ cur (propertize (substring cand (- cur beg))
+ 'face face))
+ 'completion-preview-end cur)
+ ;; The previous preview is no longer applicable, hide it.
+ (completion-preview-active-mode -1))))
+ ;; Run `completion-at-point-functions' to get a new candidate.
+ (while-no-input (completion-preview--update)))
+
+(defun completion-preview--post-command ()
+ "Create, update or delete completion preview post last command."
+ (if (and (completion-preview-require-certain-commands)
+ (completion-preview-require-minimum-symbol-length))
+ ;; We should show the preview.
+ (or
+ ;; If we're called after a command that itself updates the
+ ;; preview, don't do anything.
+ (completion-preview--internal-command-p)
+ ;; Otherwise, show the preview.
+ (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."
+ (interactive)
+ (let ((completion-preview-insert-on-completion t))
+ (completion-at-point)))
+
+(defun completion-preview-prev-candidate ()
+ "Cycle the candidate that the preview shows 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.
+
+DIRECTION should be either 1 which means cycle forward, or -1
+which means cycle backward. Interactively, DIRECTION is the
+prefix argument and defaults to 1."
+ (interactive "p")
+ (when completion-preview-active-mode
+ (let* ((beg (completion-preview--get 'completion-preview-beg))
+ (all (completion-preview--get 'completion-preview-cands))
+ (cur (completion-preview--get 'completion-preview-index))
+ (len (length all))
+ (new (mod (+ cur direction) len))
+ (str (nth new all))
+ (pos (point)))
+ (while (or (<= (+ beg (length str)) pos)
+ (not (string-prefix-p (buffer-substring beg pos) str)))
+ (setq new (mod (+ new direction) len) str (nth new all)))
+ (let ((aft (propertize (substring str (- pos beg))
+ 'face (if (< 1 len)
+ 'completion-preview
+ 'completion-preview-exact))))
+ (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)))))
+
+;;;###autoload
+(define-minor-mode completion-preview-mode
+ "Show in-buffer completion preview as you type."
+ :lighter " CP"
+ (if completion-preview-mode
+ (add-hook 'post-command-hook #'completion-preview--post-command nil t)
+ (remove-hook 'post-command-hook #'completion-preview--post-command t)
+ (completion-preview-active-mode -1)))
+
+(provide 'completion-preview)
+;;; completion-preview.el ends here
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index e0bcae6b005..02194e6ff45 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -264,7 +264,8 @@ the string of command switches used as the third argument
of `diff'."
(read-string "Options for diff: "
(if (stringp diff-switches)
diff-switches
- (mapconcat #'identity diff-switches " ")))))))
+ (mapconcat #'identity diff-switches " "))))))
+ dired-mode)
(let ((current (dired-get-filename t)))
(when (or (equal (expand-file-name file)
(expand-file-name current))
@@ -290,7 +291,8 @@ With prefix arg, prompt for argument SWITCHES which is
options for `diff'."
(if (stringp diff-switches)
diff-switches
(mapconcat #'identity diff-switches " "))))
- nil))
+ nil)
+ dired-mode)
(diff-backup (dired-get-filename) switches))
;;;###autoload
@@ -336,7 +338,8 @@ only in the active region if `dired-mark-region' is
non-nil."
(read-directory-name (format "Compare %s with: "
(dired-current-directory))
target-dir target-dir t)))
- (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil")))
+ (read-from-minibuffer "Mark if (lisp expr or RET): " nil nil t nil "nil"))
+ dired-mode)
(let* ((dir1 (dired-current-directory))
(file-alist1 (dired-files-attributes dir1))
(file-alist2 (dired-files-attributes dir2))
@@ -497,7 +500,7 @@ Alternatively, see the man page for \"chmod(1)\".
Note that on MS-Windows only the `w' (write) bit is meaningful:
resetting it makes the file read-only. Changing any other bit
has no effect on MS-Windows."
- (interactive "P")
+ (interactive "P" dired-mode)
(let* ((files (dired-get-marked-files t arg nil nil t))
;; The source of default file attributes is the file at point.
(default-file (dired-get-filename t t))
@@ -541,7 +544,7 @@ has no effect on MS-Windows."
Type \\<minibuffer-local-completion-map>\\[next-history-element] \
to pull the file attributes of the file at point
into the minibuffer."
- (interactive "P")
+ (interactive "P" dired-mode)
(if (and (memq system-type '(ms-dos windows-nt))
(not (file-remote-p default-directory)))
(error "chgrp not supported on this system"))
@@ -553,7 +556,7 @@ into the minibuffer."
Type \\<minibuffer-local-completion-map>\\[next-history-element] \
to pull the file attributes of the file at point
into the minibuffer."
- (interactive "P")
+ (interactive "P" dired-mode)
(if (and (memq system-type '(ms-dos windows-nt))
(not (file-remote-p default-directory)))
(error "chown not supported on this system"))
@@ -566,7 +569,7 @@ This calls touch.
Type Type \\<minibuffer-local-completion-map>\\[next-history-element] \
to pull the file attributes of the file at point
into the minibuffer."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-do-chxxx "Timestamp" dired-touch-program 'touch arg))
;; Process all the files in FILES in batches of a convenient size,
@@ -618,7 +621,7 @@ into the minibuffer."
"Print the marked (or next ARG) files.
Uses the shell command coming from variables `lpr-command' and
`lpr-switches' as default."
- (interactive "P")
+ (interactive "P" dired-mode)
(require 'lpr)
(let* ((file-list (dired-get-marked-files t arg nil nil t))
(lpr-switches
@@ -674,7 +677,7 @@ Negative prefix arg KEEP overrides `kept-old-versions' with
KEEP made positive.
To clear the flags on these files, you can use \\[dired-flag-backup-files]
with a prefix argument."
- (interactive "P")
+ (interactive "P" dired-mode)
(setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
(let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
(late-retention (if (<= keep 0) dired-kept-versions keep))
@@ -828,7 +831,8 @@ Commands that are run asynchronously do not accept user
input."
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command "& on %s: " current-prefix-arg files)
current-prefix-arg
- files)))
+ files))
+ dired-mode)
(unless (string-match-p "&[ \t]*\\'" command)
(setq command (concat command " &")))
(dired-do-shell-command command arg file-list))
@@ -895,7 +899,8 @@ Also see the `dired-confirm-shell-command' variable."
;; Want to give feedback whether this file or marked files are used:
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
- files)))
+ files))
+ dired-mode)
(let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
(no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
(confirmations nil)
@@ -1342,7 +1347,7 @@ See `dired-guess-shell-alist-user'."
"Kill the current line (not the files).
With a prefix argument, kill that many lines starting with the current line.
(A negative argument kills backward.)"
- (interactive "P")
+ (interactive "P" dired-mode)
(setq arg (prefix-numeric-value arg))
(let (buffer-read-only file)
(while (/= 0 arg)
@@ -1383,7 +1388,7 @@ lines removed by this invocation, for the reporting
message.
A FMT of \"\" will suppress the messaging."
;; Returns count of killed lines.
- (interactive "P")
+ (interactive "P" dired-mode)
(if arg
(if (dired-get-subdir)
(dired-kill-subdir)
@@ -1520,7 +1525,7 @@ output file. %i path(s) are relative, while %o is
absolute.")
Prompt for the archive file name.
Choose the archiving command based on the archive file-name extension
and `dired-compress-files-alist'."
- (interactive)
+ (interactive nil dired-mode)
(let* ((in-files (dired-get-marked-files nil nil nil nil t))
(out-file (expand-file-name (read-file-name "Compress to: ")))
(rule (cl-find-if
@@ -1758,7 +1763,7 @@ the directory and all of its subdirectories, recursively,
into a .tar.gz archive.
If invoked on a .tar.gz or a .tgz or a .zip or a .7z archive,
uncompress and unpack all the files in the archive."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-map-over-marks-check #'dired-compress arg 'compress t))
@@ -1787,7 +1792,7 @@ uncompress and unpack all the files in the archive."
;;;###autoload
(defun dired-do-byte-compile (&optional arg)
"Byte compile marked (or next ARG) Emacs Lisp files."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t))
(defun dired-load ()
@@ -1804,7 +1809,7 @@ uncompress and unpack all the files in the archive."
;;;###autoload
(defun dired-do-load (&optional arg)
"Load the marked (or next ARG) Emacs Lisp files."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-map-over-marks-check #'dired-load arg 'load t))
;;;###autoload
@@ -1821,7 +1826,7 @@ You can reset all subdirectory switches to the default
using
\\<dired-mode-map>\\[dired-reset-subdir-switches].
See Info node `(emacs)Subdir switches' for more details."
;; Moves point if the next ARG files are redisplayed.
- (interactive "P\np")
+ (interactive "P\np" dired-mode)
(if (and test-for-subdir (dired-get-subdir))
(let* ((dir (dired-get-subdir))
(switches (cdr (assoc-string dir dired-switches-alist))))
@@ -1851,7 +1856,7 @@ See Info node `(emacs)Subdir switches' for more details."
(defun dired-reset-subdir-switches ()
"Set `dired-switches-alist' to nil and revert Dired buffer."
- (interactive)
+ (interactive nil dired-mode)
(setq dired-switches-alist nil)
(revert-buffer))
@@ -2691,7 +2696,8 @@ FILENAME is a full file name."
Parent directories of DIRECTORY are created as needed.
If DIRECTORY already exists, signal an error."
(interactive
- (list (read-file-name "Create directory: " (dired-current-directory))))
+ (list (read-file-name "Create directory: " (dired-current-directory)))
+ dired-mode)
(let* ((expanded (directory-file-name (expand-file-name directory)))
new)
(if (file-exists-p expanded)
@@ -2708,7 +2714,7 @@ If DIRECTORY already exists, signal an error."
Add a new entry for the new file in the Dired buffer.
Parent directories of FILE are created as needed.
If FILE already exists, signal an error."
- (interactive (list (read-file-name "Create empty file: ")))
+ (interactive (list (read-file-name "Create empty file: ")) dired-mode)
(let* ((expanded (expand-file-name file))
new)
(if (file-exists-p expanded)
@@ -2771,7 +2777,7 @@ element 4 (`\\[universal-argument]'), the inverted value
of
`dired-copy-dereference' will be used.
Also see `dired-do-revert-buffer'."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-recursive-copies dired-recursive-copies)
(dired-copy-dereference (if (equal arg '(4))
(not dired-copy-dereference)
@@ -2794,7 +2800,7 @@ suggested for the target directory depends on the value of
For relative symlinks, use \\[dired-do-relsymlink].
Also see `dired-do-revert-buffer'."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-do-create-files 'symlink #'make-symbolic-link
"Symlink" arg dired-keep-marker-symlink))
@@ -2811,7 +2817,7 @@ not absolute ones like
foo -> /ugly/file/name/that/may/change/any/day/bar/foo
For absolute symlinks, use \\[dired-do-symlink]."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-do-create-files 'relsymlink #'dired-make-relative-symlink
"RelSymLink" arg dired-keep-marker-relsymlink))
@@ -2876,7 +2882,7 @@ suggested for the target directory depends on the value of
`dired-dwim-target', which see.
Also see `dired-do-revert-buffer'."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-do-create-files 'hardlink #'dired-hardlink
"Hardlink" arg dired-keep-marker-hardlink))
@@ -2897,7 +2903,7 @@ The default suggested for the target directory depends on
the value
of `dired-dwim-target', which see.
Also see `dired-do-revert-buffer'."
- (interactive "P")
+ (interactive "P" dired-mode)
(when (seq-find (lambda (file)
(member (file-name-nondirectory file) '("." "..")))
(dired-get-marked-files nil arg))
@@ -2996,7 +3002,7 @@ REGEXP defaults to the last regexp used.
With a zero prefix arg, renaming by regexp affects the absolute file name.
Normally, only the non-directory part of the file name is used and changed."
- (interactive (dired-mark-read-regexp "Rename"))
+ (interactive (dired-mark-read-regexp "Rename") dired-mode)
(dired-do-create-files-regexp
#'dired-rename-file
"Rename" arg regexp newname whole-name dired-keep-marker-rename))
@@ -3005,7 +3011,7 @@ Normally, only the non-directory part of the file name is
used and changed."
(defun dired-do-copy-regexp (regexp newname &optional arg whole-name)
"Copy selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
- (interactive (dired-mark-read-regexp "Copy"))
+ (interactive (dired-mark-read-regexp "Copy") dired-mode)
(let ((dired-recursive-copies nil)) ; No recursive copies.
(dired-do-create-files-regexp
#'dired-copy-file
@@ -3016,7 +3022,7 @@ See function `dired-do-rename-regexp' for more info."
(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-name)
"Hardlink selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
- (interactive (dired-mark-read-regexp "HardLink"))
+ (interactive (dired-mark-read-regexp "HardLink") dired-mode)
(dired-do-create-files-regexp
#'add-name-to-file
"HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
@@ -3025,7 +3031,7 @@ See function `dired-do-rename-regexp' for more info."
(defun dired-do-symlink-regexp (regexp newname &optional arg whole-name)
"Symlink selected files whose names match REGEXP to NEWNAME.
See function `dired-do-rename-regexp' for more info."
- (interactive (dired-mark-read-regexp "SymLink"))
+ (interactive (dired-mark-read-regexp "SymLink") dired-mode)
(dired-do-create-files-regexp
#'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
@@ -3035,7 +3041,7 @@ See function `dired-do-rename-regexp' for more info."
"RelSymlink all marked files containing REGEXP to NEWNAME.
See functions `dired-do-rename-regexp' and `dired-do-relsymlink'
for more info."
- (interactive (dired-mark-read-regexp "RelSymLink"))
+ (interactive (dired-mark-read-regexp "RelSymLink") dired-mode)
(dired-do-create-files-regexp
#'dired-make-relative-symlink
"RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink))
@@ -3080,13 +3086,13 @@ Type \\`SPC' or \\`y' to %s one file, \\`DEL' or \\`n'
to skip to next,
;;;###autoload
(defun dired-upcase (&optional arg)
"Rename all marked (or next ARG) files to upper case."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-rename-non-directory #'upcase "Rename upcase" arg))
;;;###autoload
(defun dired-downcase (&optional arg)
"Rename all marked (or next ARG) files to lower case."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-rename-non-directory #'downcase "Rename downcase" arg))
@@ -3114,7 +3120,8 @@ See Info node `(emacs)Subdir switches' for more details."
(list (dired-get-filename)
(if current-prefix-arg
(read-string "Switches for listing: "
- (or dired-subdir-switches dired-actual-switches)))))
+ (or dired-subdir-switches dired-actual-switches))))
+ dired-mode)
(let ((opoint (point)))
;; We don't need a marker for opoint as the subdir is always
;; inserted *after* opoint.
@@ -3146,7 +3153,8 @@ This function takes some pains to conform to `ls -lR'
output."
(list (dired-get-filename)
(if current-prefix-arg
(read-string "Switches for listing: "
- (or dired-subdir-switches dired-actual-switches)))))
+ (or dired-subdir-switches dired-actual-switches))))
+ dired-mode)
(setq dirname (file-name-as-directory (expand-file-name dirname)))
(or no-error-if-not-dir-p
(file-directory-p dirname)
@@ -3223,7 +3231,7 @@ In interactive use, the command prompts for DIRNAME.
When called from Lisp, if REMEMBER-MARKS is non-nil, return an alist
of marked files. If KILL-ROOT is non-nil, kill DIRNAME as well."
- (interactive "DKill tree below directory: \ni\nP")
+ (interactive "DKill tree below directory: \ni\nP" dired-mode)
(setq dirname (file-name-as-directory (expand-file-name dirname)))
(let ((s-alist dired-subdir-alist) dir m-alist)
(while s-alist
@@ -3377,7 +3385,8 @@ When called interactively and not on a subdir line, go to
this subdir's line."
(list (if current-prefix-arg
(prefix-numeric-value current-prefix-arg)
;; if on subdir start already, don't stay there!
- (if (dired-get-subdir) 1 0))))
+ (if (dired-get-subdir) 1 0)))
+ dired-mode)
(dired-next-subdir (- arg) no-error-if-not-found no-skip))
;;;###autoload
@@ -3410,7 +3419,7 @@ The next char is \\n."
"Mark all files except `.' and `..' in current subdirectory.
If the Dired buffer shows multiple directories, this command
marks the files listed in the subdirectory that point is in."
- (interactive)
+ (interactive nil dired-mode)
(let ((p-min (dired-subdir-min)))
(dired-mark-files-in-region p-min (dired-subdir-max))))
@@ -3419,7 +3428,7 @@ marks the files listed in the subdirectory that point is
in."
"Remove all lines of current subdirectory.
Lower levels are unaffected."
;; With optional REMEMBER-MARKS, return a mark-alist.
- (interactive)
+ (interactive nil dired-mode)
(let* ((beg (dired-subdir-min))
(end (dired-subdir-max))
(modflag (buffer-modified-p))
@@ -3446,7 +3455,7 @@ Lower levels are unaffected."
;;;###autoload
(defun dired-tree-up (arg)
"Go up ARG levels in the Dired tree."
- (interactive "p")
+ (interactive "p" dired-mode)
(let ((dir (dired-current-directory)))
(while (>= arg 1)
(setq arg (1- arg)
@@ -3458,7 +3467,7 @@ Lower levels are unaffected."
;;;###autoload
(defun dired-tree-down ()
"Go down in the Dired tree."
- (interactive)
+ (interactive nil dired-mode)
(let ((dir (dired-current-directory)) ; has slash
pos case-fold-search) ; filenames are case sensitive
(let ((rest (reverse dired-subdir-alist)) elt)
@@ -3480,7 +3489,7 @@ Lower levels are unaffected."
"Hide or unhide the current subdirectory and move to next directory.
Optional prefix arg is a repeat factor.
Use \\[dired-hide-all] to (un)hide all directories."
- (interactive "p")
+ (interactive "p" dired-mode)
(with-silent-modifications
(while (>= (setq arg (1- arg)) 0)
(let* ((cur-dir (dired-current-directory))
@@ -3501,7 +3510,7 @@ Use \\[dired-hide-all] to (un)hide all directories."
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
- (interactive "P")
+ (interactive "P" dired-mode)
(with-silent-modifications
(if (text-property-any (point-min) (point-max) 'invisible 'dired)
(dired--unhide (point-min) (point-max))
@@ -3577,14 +3586,14 @@ It's intended to override the default search function."
;;;###autoload
(defun dired-isearch-filenames ()
"Search for a string using Isearch only in file names in the Dired buffer."
- (interactive)
+ (interactive nil dired-mode)
(setq-local dired-isearch-filenames t)
(isearch-forward nil t))
;;;###autoload
(defun dired-isearch-filenames-regexp ()
"Search for a regexp using Isearch only in file names in the Dired buffer."
- (interactive)
+ (interactive nil dired-mode)
(setq-local dired-isearch-filenames t)
(isearch-forward-regexp nil t))
@@ -3594,7 +3603,7 @@ It's intended to override the default search function."
;;;###autoload
(defun dired-do-isearch ()
"Search for a string through all marked files using Isearch."
- (interactive)
+ (interactive nil dired-mode)
(multi-isearch-files
(prog1 (dired-get-marked-files nil nil
#'dired-nondirectory-p nil t)
@@ -3603,7 +3612,7 @@ It's intended to override the default search function."
;;;###autoload
(defun dired-do-isearch-regexp ()
"Search for a regexp through all marked files using Isearch."
- (interactive)
+ (interactive nil dired-mode)
(prog1 (multi-isearch-files-regexp
(dired-get-marked-files nil nil
'dired-nondirectory-p nil t))
@@ -3619,7 +3628,7 @@ If no files are marked, search through the file under
point.
Stops when a match is found.
To continue searching for next match, use command \\[fileloop-continue]."
- (interactive "sSearch marked files (regexp): ")
+ (interactive "sSearch marked files (regexp): " dired-mode)
(fileloop-initialize-search
regexp
(dired-get-marked-files nil nil #'dired-nondirectory-p)
@@ -3642,7 +3651,8 @@ resume the query replace with the command
\\[fileloop-continue]."
(let ((common
(query-replace-read-args
"Query replace regexp in marked files" t t)))
- (list (nth 0 common) (nth 1 common) (nth 2 common))))
+ (list (nth 0 common) (nth 1 common) (nth 2 common)))
+ dired-mode)
(dolist (file (dired-get-marked-files nil nil #'dired-nondirectory-p nil t))
(let ((buffer (get-file-buffer file)))
(if (and buffer (with-current-buffer buffer
@@ -3686,7 +3696,7 @@ matching `grep-find-ignored-directories' are skipped in
the marked
directories.
REGEXP should use constructs supported by your local `grep' command."
- (interactive "sSearch marked files (regexp): ")
+ (interactive "sSearch marked files (regexp): " dired-mode)
(require 'grep)
(require 'xref)
(defvar grep-find-ignored-files)
@@ -3741,7 +3751,8 @@ function works."
(let ((common
(query-replace-read-args
"Query replace regexp in marked files" t t)))
- (list (nth 0 common) (nth 1 common))))
+ (list (nth 0 common) (nth 1 common)))
+ dired-mode)
(require 'xref)
(defvar xref-show-xrefs-function)
(defvar xref-auto-jump-to-first-xref)
@@ -3763,7 +3774,7 @@ function works."
If you give a prefix argument \\[universal-argument] to this command, and
FILE is a symbolic link, then the command will print the type
of the target of the link instead."
- (interactive (list (dired-get-filename t) current-prefix-arg))
+ (interactive (list (dired-get-filename t) current-prefix-arg) dired-mode)
(let (process-file-side-effects)
(with-temp-buffer
(if deref-symlinks
@@ -3796,7 +3807,7 @@ the same files/directories marked in the VC-Directory
buffer that were
marked in the original Dired buffer. If the current directory doesn't
belong to a VCS repository, prompt for a repository directory. In this
case, the VERBOSE argument is ignored."
- (interactive "P")
+ (interactive "P" dired-mode)
(let* ((marked-files
(dired-get-marked-files nil nil nil nil t))
(mark-files
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index b7824fa81bd..04b3c783084 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -299,7 +299,7 @@ Optional MARKER-CHAR is marker to use.
Interactively, ask for EXTENSION.
Prefixed with one \\[universal-argument], unmark files instead.
Prefixed with two \\[universal-argument]'s, prompt for MARKER-CHAR and mark
files with it."
- (interactive (dired--mark-suffix-interactive-spec))
+ (interactive (dired--mark-suffix-interactive-spec) dired-mode)
(setq extension (ensure-list extension))
(dired-mark-files-regexp
(concat ".";; don't match names with nothing but an extension
@@ -323,7 +323,7 @@ Optional MARKER-CHAR is marker to use.
Interactively, ask for SUFFIX.
Prefixed with one \\[universal-argument], unmark files instead.
Prefixed with two \\[universal-argument]'s, prompt for MARKER-CHAR and mark
files with it."
- (interactive (dired--mark-suffix-interactive-spec))
+ (interactive (dired--mark-suffix-interactive-spec) dired-mode)
(setq suffix (ensure-list suffix))
(dired-mark-files-regexp
(concat ".";; don't match names with nothing but an extension
@@ -335,7 +335,7 @@ Prefixed with two \\[universal-argument]'s, prompt for
MARKER-CHAR and mark file
(defun dired-flag-extension (extension)
"In Dired, flag all files with a certain EXTENSION for deletion.
A `.' is *not* automatically prepended to the string entered."
- (interactive "sFlagging extension: ")
+ (interactive "sFlagging extension: " dired-mode)
(dired-mark-extension extension dired-del-marker))
;; Define some unpopular file extensions. Used for cleaning and omitting.
@@ -364,7 +364,7 @@ A `.' is *not* automatically prepended to the string
entered."
(defun dired-clean-patch ()
"Flag dispensable files created by patch for deletion.
See variable `dired-patch-unclean-extensions'."
- (interactive)
+ (interactive nil dired-mode)
(dired-flag-extension dired-patch-unclean-extensions))
(defun dired-clean-tex ()
@@ -372,7 +372,7 @@ See variable `dired-patch-unclean-extensions'."
See variables `dired-tex-unclean-extensions',
`dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and
`dired-texinfo-unclean-extensions'."
- (interactive)
+ (interactive nil dired-mode)
(dired-flag-extension (append dired-texinfo-unclean-extensions
dired-latex-unclean-extensions
dired-bibtex-unclean-extensions
@@ -383,7 +383,7 @@ See variables `dired-tex-unclean-extensions',
See variables `dired-texinfo-unclean-extensions',
`dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and
`dired-texinfo-unclean-extensions'."
- (interactive)
+ (interactive nil dired-mode)
(dired-flag-extension (append dired-texinfo-unclean-extensions
dired-latex-unclean-extensions
dired-bibtex-unclean-extensions
@@ -419,7 +419,7 @@ Should never be used as marker by the user or other
packages.")
(defun dired-mark-omitted ()
"Mark files matching `dired-omit-files' and `dired-omit-extensions'."
- (interactive)
+ (interactive nil dired-mode)
(let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files
(dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp
(dired-omit-case-fold-p (if (stringp
dired-directory)
@@ -455,7 +455,7 @@ if called from Lisp and buffer is bigger than
`dired-omit-size-limit'.
Optional arg INIT-COUNT is an initial count tha'is added to the number
of lines omitted by this invocation of `dired-omit-expunge', in the
status message."
- (interactive "sOmit files (regexp): \nP")
+ (interactive "sOmit files (regexp): \nP" dired-mode)
;; Bind `dired-marker-char' to `dired-omit-marker-char',
;; then call `dired-do-kill-lines'.
(if (and dired-omit-mode
@@ -531,7 +531,8 @@ files in the active region if `dired-mark-region' is
non-nil."
(list (read-regexp
(format-prompt "Mark unmarked files matching regexp" "all")
nil 'dired-regexp-history)
- nil current-prefix-arg nil))
+ nil current-prefix-arg nil)
+ dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if
(and
@@ -736,7 +737,7 @@ displayed this way is restricted by the height of the
current window and
To keep Dired buffer displayed, type \\[split-window-below] first.
To display just marked files, type \\[delete-other-windows] first."
- (interactive "P")
+ (interactive "P" dired-mode)
(dired-simultaneous-find-file (dired-get-marked-files nil nil nil nil t)
noselect))
@@ -780,7 +781,7 @@ NOSELECT the files are merely found but not selected."
"Run VM on this file.
With optional prefix argument, visits the folder read-only.
Otherwise obeys the value of `dired-vm-read-only-folders'."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dir (dired-current-directory))
(fil (dired-get-filename)))
(vm-visit-folder fil (or read-only
@@ -792,7 +793,7 @@ Otherwise obeys the value of `dired-vm-read-only-folders'."
(defun dired-rmail ()
"Run RMAIL on this file."
- (interactive)
+ (interactive nil dired-mode)
(rmail (dired-get-filename)))
(defun dired-do-run-mail ()
@@ -800,7 +801,7 @@ Otherwise obeys the value of `dired-vm-read-only-folders'."
Prompt for confirmation first; if the user says yes, call
`dired-vm' if `dired-bind-vm' is non-nil, `dired-rmail'
otherwise."
- (interactive)
+ (interactive nil dired-mode)
(let ((file (dired-get-filename t)))
(if dired-bind-vm
(if (y-or-n-p (format-message
@@ -886,7 +887,8 @@ only in the active region if `dired-mark-region' is
non-nil."
(if current-prefix-arg
"UNmark"
"Mark")))
- current-prefix-arg))
+ current-prefix-arg)
+ dired-mode)
(message "%s" predicate)
(let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
inode s mode nlink uid gid size time name sym)
@@ -1012,7 +1014,7 @@ is loaded then call \\[dired-x-bind-find-file]."
"Bind `dired-x-find-file' in place of `find-file' (or vice-versa).
Similarly for `dired-x-find-file-other-window' and `find-file-other-window'.
Binding direction based on `dired-x-hands-off-my-keys'."
- (interactive)
+ (interactive nil)
(if (called-interactively-p 'interactive)
(setq dired-x-hands-off-my-keys
(not (y-or-n-p (format-message
diff --git a/lisp/dired.el b/lisp/dired.el
index c710e06722f..a3d7c636d29 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -122,7 +122,9 @@ If nil, don't pass \"--dired\" to \"ls\".
The special value of `unspecified' means to check whether \"ls\"
supports the \"--dired\" option, and save the result in this
variable. This is performed the first time `dired-insert-directory'
-is invoked.
+is invoked. (If `ls-lisp' is used by default, the test is performed
+only if `ls-lisp-use-insert-directory-program' is non-nil, i.e., if
+Dired actually uses \"ls\".)
Note that if you set this option to nil, either through choice or
because your \"ls\" program does not support \"--dired\", Dired
@@ -497,7 +499,8 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
(defcustom dired-movement-style nil
"Non-nil means point skips empty lines when moving in Dired buffers.
-This affects only `dired-next-line' and `dired-previous-line'.
+This affects only `dired-next-line', `dired-previous-line',
+`dired-next-dirline', `dired-prev-dirline'.
Possible non-nil values:
* `cycle': when moving from the last/first visible line, cycle back
@@ -1821,7 +1824,7 @@ see `dired-use-ls-dired' for more details.")
"Begin a drag-and-drop operation for the file at EVENT.
If there are marked files and that file is marked, drag every
other marked file as well. Otherwise, unmark all files."
- (interactive "e")
+ (interactive "e" dired-mode)
(when mark-active
(deactivate-mark))
(let* ((modifiers (event-modifiers event))
@@ -2660,7 +2663,7 @@ Keybindings:
"Undo in a Dired buffer.
This doesn't recover lost files, it just undoes changes in the buffer itself.
You can use it to recover marks, killed lines or subdirs."
- (interactive)
+ (interactive nil dired-mode)
(let ((inhibit-read-only t))
(undo))
(dired-build-subdir-alist)
@@ -2672,7 +2675,7 @@ Actual changes in files cannot be undone by Emacs."))
If the current buffer can be edited with Wdired, (i.e. the major
mode is `dired-mode'), call `wdired-change-to-wdired-mode'.
Otherwise, toggle `read-only-mode'."
- (interactive)
+ (interactive nil dired-mode)
(unless (file-exists-p default-directory)
(user-error "The current directory no longer exists"))
(when (and (not (file-writable-p default-directory))
@@ -2686,11 +2689,11 @@ Otherwise, toggle `read-only-mode'."
(defun dired--trivial-next-line (arg)
"Move down ARG lines, then position at filename."
(let ((line-move-visual)
- (goal-column))
+ (goal-column))
(line-move arg t))
;; We never want to move point into an invisible line.
(while (and (invisible-p (point))
- (not (if (and arg (< arg 0)) (bobp) (eobp))))
+ (not (if (and arg (< arg 0)) (bobp) (eobp))))
(forward-char (if (and arg (< arg 0)) -1 1)))
(dired-move-to-filename))
@@ -2701,46 +2704,43 @@ to move; the default is one line.
Whether to skip empty lines and how to move from last line
is controlled by `dired-movement-style'."
- (interactive "^p")
+ (interactive "^p" dired-mode)
(if dired-movement-style
- (let ((old-position (progn
- ;; It's always true that we should move
- ;; to the filename when possible.
- (dired-move-to-filename)
- (point)))
- ;; Up/Down indicates the direction.
- (moving-down (if (cl-plusp arg)
- 1 ; means Down.
- -1))) ; means Up.
- ;; Line by line in case we forget to skip empty lines.
- (while (not (zerop arg))
- (dired--trivial-next-line moving-down)
- (when (= old-position (point))
- ;; Now point is at beginning/end of movable area,
- ;; but it still wants to move farther.
- (if (eq dired-movement-style 'cycle)
- ;; `cycle': go to the other end.
- (goto-char (if (cl-plusp moving-down)
- (point-min)
- (point-max)))
- ;; `bounded': go back to the last non-empty line.
- (while (string-match-p "\\`[[:blank:]]*\\'"
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))
- (dired--trivial-next-line (- moving-down)))
- ;; Encountered a boundary, so let's stop movement.
- (setq arg moving-down)))
- (when (not (string-match-p "\\`[[:blank:]]*\\'"
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position))))
- ;; Has moved to a non-empty line. This movement does
- ;; make sense.
- (cl-decf arg moving-down))
- (setq old-position (point))))
+ (dired--move-to-next-line arg #'dired--trivial-next-line)
(dired--trivial-next-line arg)))
+(defun dired--move-to-next-line (arg jumpfun)
+ (let ((old-position (progn
+ ;; It's always true that we should move
+ ;; to the filename when possible.
+ (dired-move-to-filename)
+ (point)))
+ ;; Up/Down indicates the direction.
+ (moving-down (if (cl-plusp arg)
+ 1 ; means Down.
+ -1))) ; means Up.
+ ;; Line by line in case we forget to skip empty lines.
+ (while (not (zerop arg))
+ (funcall jumpfun moving-down)
+ (when (= old-position (point))
+ ;; Now point is at beginning/end of movable area,
+ ;; but it still wants to move farther.
+ (if (eq dired-movement-style 'cycle)
+ ;; `cycle': go to the other end.
+ (goto-char (if (cl-plusp moving-down)
+ (point-min)
+ (point-max)))
+ ;; `bounded': go back to the last non-empty line.
+ (while (dired-between-files)
+ (funcall jumpfun (- moving-down)))
+ ;; Encountered a boundary, so let's stop movement.
+ (setq arg moving-down)))
+ (unless (dired-between-files)
+ ;; Has moved to a non-empty line. This movement does
+ ;; make sense.
+ (cl-decf arg moving-down))
+ (setq old-position (point)))))
+
(defun dired-previous-line (arg)
"Move up ARG lines, then position at filename.
The argument ARG (interactively, prefix argument) says how many lines
@@ -2748,12 +2748,11 @@ to move; the default is one line.
Whether to skip empty lines and how to move from first line
is controlled by `dired-movement-style'."
- (interactive "^p")
+ (interactive "^p" dired-mode)
(dired-next-line (- (or arg 1))))
-(defun dired-next-dirline (arg &optional opoint)
+(defun dired--trivial-next-dirline (arg &optional opoint)
"Goto ARGth next directory file line."
- (interactive "p")
(or opoint (setq opoint (point)))
(if (if (> arg 0)
(re-search-forward dired-re-dir nil t arg)
@@ -2761,11 +2760,25 @@ is controlled by `dired-movement-style'."
(re-search-backward dired-re-dir nil t (- arg)))
(dired-move-to-filename) ; user may type `i' or `f'
(goto-char opoint)
- (error "No more subdirectories")))
+ (unless dired-movement-style
+ (error "No more subdirectories"))))
+
+(defun dired-next-dirline (arg &optional _opoint)
+ "Goto ARGth next directory file line.
+
+Whether to skip empty lines and how to move from last line
+is controlled by `dired-movement-style'."
+ (interactive "p" dired-mode)
+ (if dired-movement-style
+ (dired--move-to-next-line arg #'dired--trivial-next-dirline)
+ (dired--trivial-next-dirline arg)))
(defun dired-prev-dirline (arg)
- "Goto ARGth previous directory file line."
- (interactive "p")
+ "Goto ARGth previous directory file line.
+
+Whether to skip empty lines and how to move from last line
+is controlled by `dired-movement-style'."
+ (interactive "p" dired-mode)
(dired-next-dirline (- arg)))
(defun dired-up-directory (&optional other-window)
@@ -2774,7 +2787,7 @@ Find the parent directory either in this buffer or
another buffer.
Creates a buffer if necessary.
If OTHER-WINDOW (the optional prefix arg), display the parent
directory in another window."
- (interactive "P")
+ (interactive "P" dired-mode)
(let* ((dir (dired-current-directory))
(up (file-name-directory (directory-file-name dir))))
(or (dired-goto-file (directory-file-name dir))
@@ -2789,7 +2802,7 @@ directory in another window."
(defun dired-get-file-for-visit ()
"Get the current line's file name, with an error if file does not exist."
- (interactive)
+ (interactive nil dired-mode)
;; We pass t for second arg so that we don't get error for `.' and `..'.
(let ((raw (dired-get-filename nil t))
file-name)
@@ -2809,7 +2822,7 @@ directory in another window."
#'dired-find-file "23.2")
(defun dired-find-file ()
"In Dired, visit the file or directory named on this line."
- (interactive)
+ (interactive nil dired-mode)
(dired--find-possibly-alternative-file (dired-get-file-for-visit)))
(defun dired--find-possibly-alternative-file (file)
@@ -2841,7 +2854,7 @@ directory in another window."
(defun dired-find-alternate-file ()
"In Dired, visit file or directory on current line via `find-alternate-file'.
This kills the Dired buffer, then visits the current line's file or directory."
- (interactive)
+ (interactive nil dired-mode)
(set-buffer-modified-p nil)
(find-alternate-file (dired-get-file-for-visit)))
;; Don't override the setting from .emacs.
@@ -2855,7 +2868,7 @@ omitted or nil, these arguments default to `find-file'
and `dired',
respectively. If `dired-kill-when-opening-new-dired-buffer' is
non-nil, FIND-DIR-FUNC defaults to `find-alternate-file' instead,
so that the original Dired buffer is not kept."
- (interactive "e")
+ (interactive "e" dired-mode)
(or find-file-func (setq find-file-func 'find-file))
(let (window pos file)
(save-excursion
@@ -2883,19 +2896,19 @@ so that the original Dired buffer is not kept."
(defun dired-mouse-find-file-other-window (event)
"In Dired, visit the file or directory name you click on in another window."
- (interactive "e")
+ (interactive "e" dired-mode)
(dired-mouse-find-file event 'find-file-other-window 'dired-other-window))
(defun dired-mouse-find-file-other-frame (event)
"In Dired, visit the file or directory name you click on in another frame."
- (interactive "e")
+ (interactive "e" dired-mode)
(dired-mouse-find-file event 'find-file-other-frame 'dired-other-frame))
(defun dired-view-file ()
"In Dired, examine a file in view mode, returning to Dired when done.
When file is a directory, show it in this buffer if it is inserted.
Otherwise, display it in another buffer."
- (interactive)
+ (interactive nil dired-mode)
(let ((file (dired-get-file-for-visit)))
(if (file-directory-p file)
(or (and (cdr dired-subdir-alist)
@@ -2905,12 +2918,12 @@ Otherwise, display it in another buffer."
(defun dired-find-file-other-window ()
"In Dired, visit this file or directory in another window."
- (interactive)
+ (interactive nil dired-mode)
(dired--find-file #'find-file-other-window (dired-get-file-for-visit)))
(defun dired-display-file ()
"In Dired, display this file or directory in another window."
- (interactive)
+ (interactive nil dired-mode)
(display-buffer (find-file-noselect (dired-get-file-for-visit))
t))
@@ -3072,7 +3085,7 @@ permissions are hidden from view.
See options: `dired-hide-details-hide-symlink-targets' and
`dired-hide-details-hide-information-lines'."
:group 'dired
- (unless (derived-mode-p 'dired-mode 'wdired-mode)
+ (unless (derived-mode-p '(dired-mode wdired-mode))
(error "Not a Dired buffer"))
(dired-hide-details-update-invisibility-spec)
(if dired-hide-details-mode
@@ -3247,7 +3260,7 @@ If on a subdir headerline, use absolute subdirname
instead;
prefix arg and marked files are ignored in this case.
You can then feed the file name(s) to other commands with \\[yank]."
- (interactive "P")
+ (interactive "P" dired-mode)
(let* ((files
(or (ensure-list (dired-get-subdir))
(if arg
@@ -3433,7 +3446,7 @@ As a side effect, killed dired buffers for DIR are
removed from
;; Use 0 arg to go to this directory's header line.
;; NO-SKIP prevents moving to end of header line, returning whatever
;; position was found in dired-subdir-alist.
- (interactive "p")
+ (interactive "p" dired-mode)
(let ((this-dir (dired-current-directory))
pos index)
;; nth with negative arg does not return nil but the first element
@@ -3454,7 +3467,7 @@ As a side effect, killed dired buffers for DIR are
removed from
Returns the new value of the alist.
If optional arg SWITCHES is non-nil, use its value
instead of `dired-actual-switches'."
- (interactive)
+ (interactive nil dired-mode)
(dired-clear-alist)
(save-excursion
(let* ((count 0)
@@ -3558,7 +3571,8 @@ instead of `dired-actual-switches'."
(list (expand-file-name
(read-file-name "Goto file: "
(dired-current-directory))))
- (push-mark)))
+ (push-mark))
+ dired-mode)
(unless (file-name-absolute-p file)
(error "File name `%s' is not absolute" file))
(setq file (directory-file-name file)) ; does no harm if not a directory
@@ -3757,7 +3771,7 @@ If NOMESSAGE is non-nil, we don't display any message
if there are no flagged files.
`dired-recursive-deletes' controls whether deletion of
non-empty directories is allowed."
- (interactive)
+ (interactive nil dired-mode)
(let* ((dired-marker-char dired-del-marker)
(regexp (dired-marker-regexp))
case-fold-search markers)
@@ -3787,7 +3801,7 @@ non-empty directories is allowed."
non-empty directories is allowed."
;; This is more consistent with the file marking feature than
;; dired-do-flagged-delete.
- (interactive "P")
+ (interactive "P" dired-mode)
(let (markers)
(dired-internal-do-deletions
(nreverse
@@ -4091,7 +4105,7 @@ marked file is found after this line.
Optional argument OPOINT specifies the buffer position to
return to if no ARGth marked file is found; it defaults to
the position where this command was invoked."
- (interactive "p\np")
+ (interactive "p\np" dired-mode)
(or opoint (setq opoint (point)));; return to where interactively started
(if (if (> arg 0)
(re-search-forward dired-re-mark nil t arg)
@@ -4112,7 +4126,7 @@ ARG is the numeric prefix argument and defaults to 1.
If WRAP is non-nil, which happens interactively, wrap around
to the end of the buffer and search backwards from there, if
no ARGth marked file is found before this line."
- (interactive "p\np")
+ (interactive "p\np" dired-mode)
(dired-next-marked-file (- arg) wrap))
(defun dired-file-marker (file)
@@ -4151,7 +4165,7 @@ If on a subdir headerline, mark all its files except `.'
and `..'.
Use \\[dired-unmark-all-files] to remove all marks
and \\[dired-unmark] on a subdir to remove the marks in
this subdir."
- (interactive (list current-prefix-arg t))
+ (interactive (list current-prefix-arg t) dired-mode)
(cond
;; Mark files in the active region.
((and interactive dired-mark-region
@@ -4190,7 +4204,7 @@ Otherwise, with a prefix arg, unmark files on the next
ARG lines.
If looking at a subdir, unmark all its files except `.' and `..'.
If the region is active in Transient Mark mode, unmark all files
in the active region."
- (interactive (list current-prefix-arg t))
+ (interactive (list current-prefix-arg t) dired-mode)
(let ((dired-marker-char ?\s))
(dired-mark arg interactive)))
@@ -4202,7 +4216,7 @@ Otherwise, with a prefix arg, flag files on the next ARG
lines.
If on a subdir headerline, flag all its files except `.' and `..'.
If the region is active in Transient Mark mode, flag all files
in the active region."
- (interactive (list current-prefix-arg t))
+ (interactive (list current-prefix-arg t) dired-mode)
(let ((dired-marker-char dired-del-marker))
(dired-mark arg interactive)))
@@ -4212,7 +4226,7 @@ Optional prefix ARG says how many lines to unmark/unflag;
default
is one line.
If the region is active in Transient Mark mode, unmark all files
in the active region."
- (interactive "p")
+ (interactive "p" dired-mode)
(dired-unmark (- arg) t))
(defun dired-toggle-marks ()
@@ -4224,7 +4238,7 @@ As always, hidden subdirs are not affected.
In Transient Mark mode, if the mark is active, operate on the contents
of the region if `dired-mark-region' is non-nil. Otherwise, operate
on the whole buffer."
- (interactive)
+ (interactive nil dired-mode)
(save-excursion
(let ((inhibit-read-only t)
(beg (dired-mark--region-beginning))
@@ -4275,7 +4289,8 @@ object files--just `.o' will mark more than you might
think."
(dired-get-filename nil
t) t))
"\\'"))))
'dired-regexp-history)
- (if current-prefix-arg ?\s)))
+ (if current-prefix-arg ?\s))
+ dired-mode)
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
(and (not (looking-at-p dired-re-dot))
@@ -4286,7 +4301,7 @@ object files--just `.o' will mark more than you might
think."
(defun dired-number-of-marked-files ()
"Display the number and total size of the marked files."
- (interactive)
+ (interactive nil dired-mode)
(let* ((files (dired-get-marked-files nil nil nil t))
(nmarked
(cond ((null (cdr files))
@@ -4325,7 +4340,8 @@ since it was last visited."
(list (read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
" files containing (regexp): ")
nil 'dired-regexp-history)
- (if current-prefix-arg ?\s)))
+ (if current-prefix-arg ?\s))
+ dired-mode)
(let ((dired-marker-char (or marker-char dired-marker-char)))
(dired-mark-if
(and (not (looking-at-p dired-re-dot))
@@ -4354,7 +4370,8 @@ The match is against the non-directory part of the
filename. Use `^'
and `$' to anchor matches. Exclude subdirs by hiding them.
`.' and `..' are never flagged."
(interactive (list (read-regexp "Flag for deletion (regexp): "
- nil 'dired-regexp-history)))
+ nil 'dired-regexp-history))
+ dired-mode)
(dired-mark-files-regexp regexp dired-del-marker))
(defun dired-mark-symlinks (unflag-p)
@@ -4362,7 +4379,7 @@ The match is against the non-directory part of the
filename. Use `^'
With prefix argument, unmark or unflag all those files.
If the region is active in Transient Mark mode, mark files
only in the active region if `dired-mark-region' is non-nil."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-sym) "symbolic link")))
@@ -4371,7 +4388,7 @@ only in the active region if `dired-mark-region' is
non-nil."
With prefix argument, unmark or unflag all those files.
If the region is active in Transient Mark mode, mark files
only in the active region if `dired-mark-region' is non-nil."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (and (looking-at-p dired-re-dir)
(not (looking-at-p dired-re-dot)))
@@ -4382,7 +4399,7 @@ only in the active region if `dired-mark-region' is
non-nil."
With prefix argument, unmark or unflag all those files.
If the region is active in Transient Mark mode, mark files
only in the active region if `dired-mark-region' is non-nil."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-marker-char)))
(dired-mark-if (looking-at-p dired-re-exe) "executable file")))
@@ -4394,7 +4411,7 @@ only in the active region if `dired-mark-region' is
non-nil."
A prefix argument says to unmark or unflag those files instead.
If the region is active in Transient Mark mode, flag files
only in the active region if `dired-mark-region' is non-nil."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
;; It is less than general to check for # here,
@@ -4428,7 +4445,7 @@ only in the active region if `dired-mark-region' is
non-nil."
(defun dired-flag-garbage-files ()
"Flag for deletion all files that match `dired-garbage-files-regexp'."
- (interactive)
+ (interactive nil dired-mode)
(dired-flag-files-regexp dired-garbage-files-regexp))
(defun dired-flag-backup-files (&optional unflag-p)
@@ -4436,7 +4453,7 @@ only in the active region if `dired-mark-region' is
non-nil."
With prefix argument, unmark or unflag these files.
If the region is active in Transient Mark mode, flag files
only in the active region if `dired-mark-region' is non-nil."
- (interactive "P")
+ (interactive "P" dired-mode)
(let ((dired-marker-char (if unflag-p ?\s dired-del-marker)))
(dired-mark-if
;; Don't call backup-file-name-p unless the last character looks like
@@ -4464,7 +4481,8 @@ OLD and NEW are both characters used to mark files."
(old (progn (message "Change (old mark): ") (read-char)))
(new (progn (message "Change %c marks to (new mark): " old)
(read-char))))
- (list old new)))
+ (list old new))
+ dired-mode)
(dolist (c (list new old))
(if (or (not (char-displayable-p c))
(eq c ?\r))
@@ -4483,7 +4501,7 @@ OLD and NEW are both characters used to mark files."
(defun dired-unmark-all-marks ()
"Remove all marks from all files in the Dired buffer."
- (interactive)
+ (interactive nil dired-mode)
(dired-unmark-all-files ?\r))
;; Bound in dired-unmark-all-files
@@ -4495,7 +4513,7 @@ After this command, type the mark character to remove,
or type RET to remove all marks.
With prefix arg, query for each marked file.
Type \\[help-command] at that time for help."
- (interactive "cRemove marks (RET means all): \nP")
+ (interactive "cRemove marks (RET means all): \nP" dired-mode)
(save-excursion
(let* ((count 0)
(inhibit-read-only t) case-fold-search
@@ -4672,7 +4690,7 @@ Possible values:
(defun dired-sort-toggle-or-edit (&optional arg)
"Toggle sorting by date, and refresh the Dired buffer.
With a prefix argument, edit the current listing switches instead."
- (interactive "P")
+ (interactive "P" dired-mode)
(when dired-sort-inhibit
(error "Cannot sort this Dired buffer"))
(if arg
@@ -5042,7 +5060,7 @@ Interactively with prefix argument, read FILE-NAME."
(defun dired-mark-for-click (event)
"Mark or unmark the file underneath the mouse click at EVENT.
See `dired-click-to-select-mode' for more details."
- (interactive "e")
+ (interactive "e" dired-mode)
(let ((posn (event-start event))
(inhibit-read-only t))
(with-selected-window (posn-window posn)
@@ -5065,7 +5083,7 @@ See `dired-click-to-select-mode' for more details."
"Enable `dired-click-to-select-mode' and mark the file under EVENT.
If there is no file under EVENT, call `touch-screen-hold' with
EVENT instead."
- (interactive "e")
+ (interactive "e" dired-mode)
(let* ((posn (event-start event))
(window (posn-window posn))
(point (posn-point posn)))
@@ -5094,7 +5112,7 @@ Dired operation (command whose name starts with
`dired-do')
completes."
:group 'dired
:lighter " Click-To-Select"
- (unless (derived-mode-p 'dired-mode 'wdired-mode)
+ (unless (derived-mode-p '(dired-mode wdired-mode))
(error "Not a Dired buffer"))
(if dired-click-to-select-mode
(setq-local tool-bar-map
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index fb51661caac..2fdb49f3e42 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -2133,7 +2133,7 @@ GOTO-PAGE-FN other than `doc-view-goto-page'."
;; zip-archives, so that this same association is used for
;; cbz files. This is fine, as cbz files should be handled
;; like epub anyway.
- ((looking-at "PK") '(epub odf))))))
+ ((looking-at "PK") '(epub odf cbz))))))
(setq-local
doc-view-doc-type
(car (or (nreverse (seq-intersection name-types content-types #'eq))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 232ef767b45..28d210f7780 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -252,14 +252,14 @@ With a prefix argument, format the macro in a more
concise way."
;;;###autoload
(defun read-kbd-macro (start &optional end)
"Read the region as a keyboard macro definition.
-The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
-See documentation for `edmacro-mode' for details.
+The region between START and END is interpreted as spelled-out keystrokes,
+e.g., \"M-x abc RET\". See documentation for `edmacro-mode' for details.
Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored.
The resulting macro is installed as the \"current\" keyboard macro.
In Lisp, may also be called with a single STRING argument in which case
the result is returned rather than being installed as the current macro.
-The result will be a string if possible, otherwise an event vector.
+The result is a vector of input events.
Second argument NEED-VECTOR means to return an event vector always."
(interactive "r")
(if (stringp start)
@@ -763,6 +763,13 @@ This function assumes that the events can be stored in a
string."
(defun edmacro-parse-keys (string &optional _need-vector)
(let ((result (kbd string)))
+ ;; Always return a vector. Stefan Monnier <monnier@iro.umontreal.ca>
+ ;; writes: "I want to eliminate the use of strings that stand for a
+ ;; sequence of events because it does nothing more than leave latent
+ ;; bugs and create confusion (between the strings used as input to
+ ;; `read-kbd-macro' and the strings that used to be output by
+ ;; `read-kbd-macro'), while increasing the complexity of the rest of
+ ;; the code which has to handle both vectors and strings."
(if (stringp result)
(seq-into result 'vector)
result)))
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 2a668f6ce0e..a6974e07cb2 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2067,9 +2067,6 @@ mapped to the closest extremal position).
If FUNCTION was not advised already, its advice info will be
initialized. Redefining a piece of advice whose name is part of
the cache-id will clear the cache."
- (when (and (featurep 'native-compile)
- (subr-primitive-p (symbol-function function)))
- (comp-subr-trampoline-install function))
(cond ((not (ad-is-advised function))
(ad-initialize-advice-info function)
(ad-set-advice-info-field
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index ecc5fff3b67..2caaadc9f9e 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -217,10 +217,10 @@ This indicates the loop discovery phase.")
(defvar byte-optimize--aliased-vars nil
"List of variables which may be aliased by other lexical variables.
-If an entry in `byte-optimize--lexvars' has another variable as its VALUE,
-then that other variable must be in this list.
-This variable thus carries no essential information but is maintained
-for speeding up processing.")
+Each element is (NAME . ALIAS) where NAME is the aliased variable
+and ALIAS the variable record (in the format described for
+`byte-optimize--lexvars') for an alias, which may have NAME as its VALUE.
+There can be multiple entries for the same NAME if it has several aliases.")
(defun byte-optimize--substitutable-p (expr)
"Whether EXPR is a constant that can be propagated."
@@ -462,13 +462,17 @@ for speeding up processing.")
(setcar (cdr lexvar) t) ; Mark variable to be kept.
(setcdr (cdr lexvar) nil) ; Inhibit further substitution.
- (when (memq var byte-optimize--aliased-vars)
- ;; Cancel aliasing of variables aliased to this one.
- (dolist (v byte-optimize--lexvars)
- (when (eq (nth 2 v) var)
- ;; V is bound to VAR but VAR is now mutated:
- ;; cancel aliasing.
- (setcdr (cdr v) nil)))))
+ ;; Cancel substitution of variables aliasing this one.
+ (let ((aliased-vars byte-optimize--aliased-vars))
+ (while
+ (let ((alias (assq var aliased-vars)))
+ (and alias
+ (progn
+ ;; Found a variable bound to VAR but VAR is
+ ;; now mutated; cancel aliasing.
+ (setcdr (cddr alias) nil)
+ (setq aliased-vars (cdr (memq alias aliased-vars)))
+ t))))))
`(,fn ,var ,value)))
(`(defvar ,(and (pred symbolp) name) . ,rest)
@@ -587,7 +591,6 @@ for speeding up processing.")
(let* ((byte-optimize--lexvars byte-optimize--lexvars)
(byte-optimize--aliased-vars byte-optimize--aliased-vars)
(new-lexvars nil)
- (new-aliased-vars nil)
(let-vars nil)
(body (cdr form))
(bindings (car form)))
@@ -597,7 +600,7 @@ for speeding up processing.")
(expr (byte-optimize-form (cadr binding) nil)))
(setq bindings (cdr bindings))
(when (and (eq head 'let*)
- (memq name byte-optimize--aliased-vars))
+ (assq name byte-optimize--aliased-vars))
;; New variable shadows an aliased variable -- α-rename
;; it in this and all subsequent bindings.
(let ((new-name (make-symbol (symbol-name name))))
@@ -610,14 +613,12 @@ for speeding up processing.")
bindings))
(setq body (byte-optimize--rename-var-body name new-name body))
(setq name new-name)))
- (let* ((aliased nil)
- (value (and
- (or (byte-optimize--substitutable-p expr)
- ;; Aliasing another lexvar.
- (setq aliased
- (and (symbolp expr)
- (assq expr byte-optimize--lexvars))))
- (list expr)))
+ (let* ((aliased
+ ;; Aliasing another lexvar.
+ (and (symbolp expr) (assq expr byte-optimize--lexvars)))
+ (value (and (or aliased
+ (byte-optimize--substitutable-p expr))
+ (list expr)))
(lexical (not (or (special-variable-p name)
(memq name byte-compile-bound-variables)
(memq name byte-optimize--dynamic-vars))))
@@ -626,20 +627,16 @@ for speeding up processing.")
(when lexinfo
(push lexinfo (if (eq head 'let*)
byte-optimize--lexvars
- new-lexvars)))
- (when aliased
- (push expr (if (eq head 'let*)
- byte-optimize--aliased-vars
- new-aliased-vars))))))
-
- (setq byte-optimize--aliased-vars
- (append new-aliased-vars byte-optimize--aliased-vars))
+ new-lexvars))
+ (when aliased
+ (push (cons expr lexinfo) byte-optimize--aliased-vars))))))
+
(when (and (eq head 'let) byte-optimize--aliased-vars)
;; Find new variables that shadow aliased variables.
(let ((shadowing-vars nil))
(dolist (lexvar new-lexvars)
(let ((name (car lexvar)))
- (when (and (memq name byte-optimize--aliased-vars)
+ (when (and (assq name byte-optimize--aliased-vars)
(not (memq name shadowing-vars)))
(push name shadowing-vars))))
;; α-rename them
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 2ca2d03170a..454076eb3f0 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -441,7 +441,10 @@ as an integer unless JUNK-ALLOWED is non-nil."
;; Random numbers.
(defun cl--random-time ()
- (car (time-convert nil t)))
+ "Return high-precision timestamp from `time-convert'.
+
+For example, suitable for use as seed by `cl-make-random-state'."
+ (car (time-convert nil t)))
;;;###autoload (autoload 'cl-random-state-p "cl-extra")
(cl-defstruct (cl--random-state
@@ -734,7 +737,11 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(declare-function help-fns-short-filename "help-fns" (filename))
;;;###autoload
-(defun cl-find-class (type) (cl--find-class type))
+(defun cl-find-class (type)
+ "Return CL class of TYPE.
+
+Call `cl--find-class' to get TYPE's propname `cl--class'"
+ (cl--find-class type))
;;;###autoload
(defun cl-describe-type (type)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5346678dab0..56eb83e6f75 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1391,11 +1391,8 @@ See the full list and their hierarchy in
`cl--typeof-types'."
(defun cl--generic-derived-specializers (mode &rest _)
;; FIXME: Handle (derived-mode <mode1> ... <modeN>)
- (let ((specializers ()))
- (while mode
- (push `(derived-mode ,mode) specializers)
- (setq mode (get mode 'derived-mode-parent)))
- (nreverse specializers)))
+ (mapcar (lambda (mode) `(derived-mode ,mode))
+ (derived-mode-all-parents mode)))
(cl-generic-define-generalizer cl--generic-derived-generalizer
90 (lambda (name) `(and (symbolp ,name) (functionp ,name) ,name))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e2c13534054..2431e658368 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3337,19 +3337,6 @@ To see the documentation for a defined struct type, use
;;; Add cl-struct support to pcase
-;;In use by comp.el
-(defun cl--struct-all-parents (class) ;FIXME: Merge with `cl--class-allparents'
- (when (cl--struct-class-p class)
- (let ((res ())
- (classes (list class)))
- ;; BFS precedence.
- (while (let ((class (pop classes)))
- (push class res)
- (setq classes
- (append classes
- (cl--class-parents class)))))
- (nreverse res))))
-
;;;###autoload
(pcase-defmacro cl-struct (type &rest fields)
"Pcase patterns that match cl-struct EXPVAL of type TYPE.
@@ -3395,8 +3382,8 @@ the form NAME which is a shorthand for (NAME NAME)."
(let ((c1 (cl--find-class t1))
(c2 (cl--find-class t2)))
(and c1 c2
- (not (or (memq c1 (cl--struct-all-parents c2))
- (memq c2 (cl--struct-all-parents c1)))))))
+ (not (or (memq t1 (cl--class-allparents c2))
+ (memq t2 (cl--class-allparents c1)))))))
(let ((c1 (and (symbolp t1) (cl--find-class t1))))
(and c1 (cl--struct-class-p c1)
(funcall orig (cl--defstruct-predicate t1)
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 03068639575..3d0c2b54785 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -323,15 +323,9 @@ supertypes from the most specific to least specific.")
(cl-assert (cl--class-p (cl--find-class 'cl-structure-object)))
(defun cl--class-allparents (class)
- (let ((parents ())
- (classes (list class)))
- ;; BFS precedence. FIXME: Use a topological sort.
- (while (let ((class (pop classes)))
- (cl-pushnew (cl--class-name class) parents)
- (setq classes
- (append classes
- (cl--class-parents class)))))
- (nreverse parents)))
+ (cons (cl--class-name class)
+ (merge-ordered-lists (mapcar #'cl--class-allparents
+ (cl--class-parents class)))))
(eval-and-compile
(cl-assert (null (cl--class-parents (cl--find-class 'cl-structure-object)))))
diff --git a/lisp/emacs-lisp/comp-common.el b/lisp/emacs-lisp/comp-common.el
index 6318f2a22e5..6d94d1bd82e 100644
--- a/lisp/emacs-lisp/comp-common.el
+++ b/lisp/emacs-lisp/comp-common.el
@@ -49,7 +49,8 @@ This is intended for debugging the compiler itself.
:version "28.1")
(defcustom native-comp-never-optimize-functions
- '(;; The following two are mandatory for Emacs to be working
+ '(eval
+ ;; The following two are mandatory for Emacs to be working
;; correctly (see comment in `advice--add-function'). DO NOT
;; REMOVE.
macroexpand rename-buffer)
@@ -59,7 +60,7 @@ Primitive functions included in this list will not be called
directly by the natively-compiled code, which makes trampolines for
those primitives unnecessary in case of function redefinition/advice."
:type '(repeat symbol)
- :version "28.1")
+ :version "30.1")
(defcustom native-comp-async-env-modifier-form nil
"Form evaluated before compilation by each asynchronous compilation
subprocess.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index dc23b071f0d..5411088189d 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -158,6 +158,13 @@ where CAUSE can be:
;;;###autoload
(defun debug (&rest args)
"Enter debugger. \\<debugger-mode-map>`\\[debugger-continue]' returns from
the debugger.
+
+In interactive sessions, this switches to a backtrace buffer and shows
+the Lisp backtrace of function calls there. In batch mode (more accurately,
+when `noninteractive' is non-nil), it shows the Lisp backtrace on the
+standard error stream (unless `backtrace-on-error-noninteractive' is nil),
+and then kills Emacs, causing it to exit with a negative exit code.
+
Arguments are mainly for use when this is called from the internals
of the evaluator.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index b35994364a7..dec5883767d 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -240,7 +240,9 @@ No problems result if this variable is not bound.
(unless (get ',abbrev 'variable-documentation)
(put ',abbrev 'variable-documentation
(purecopy ,(format "Abbrev table for `%s'." child))))))
- (put ',child 'derived-mode-parent ',parent)
+ (if (fboundp 'derived-mode-set-parent) ;; Emacs≥30.1
+ (derived-mode-set-parent ',child ',parent)
+ (put ',child 'derived-mode-parent ',parent))
,(if group `(put ',child 'custom-mode-group ,group))
(defun ,child ()
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 529f6e90e88..c9e7b3a4dfe 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -661,7 +661,7 @@ list."
(throw 'found nil))
((and (consp elem)
(eq (car elem) 'not))
- (when (apply #'derived-mode-p (cdr elem))
+ (when (derived-mode-p (cdr elem))
(throw 'found nil)))
((symbolp elem)
(when (derived-mode-p elem)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index f5ff04ff372..a394156c93a 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -964,49 +964,6 @@ need be... May remove that later...)"
(cdr tuple)
nil)))
-;;;
-;; Method Invocation order: C3
-(defun eieio--c3-candidate (class remaining-inputs)
- "Return CLASS if it can go in the result now, otherwise nil."
- ;; Ensure CLASS is not in any position but the first in any of the
- ;; element lists of REMAINING-INPUTS.
- (and (not (let ((found nil))
- (while (and remaining-inputs (not found))
- (setq found (member class (cdr (car remaining-inputs)))
- remaining-inputs (cdr remaining-inputs)))
- found))
- class))
-
-(defun eieio--c3-merge-lists (reversed-partial-result remaining-inputs)
- "Try to merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order.
-If a consistent order does not exist, signal an error."
- (setq remaining-inputs (delq nil remaining-inputs))
- (if (null remaining-inputs)
- ;; If all remaining inputs are empty lists, we are done.
- (nreverse reversed-partial-result)
- ;; Otherwise, we try to find the next element of the result. This
- ;; is achieved by considering the first element of each
- ;; (non-empty) input list and accepting a candidate if it is
- ;; consistent with the rests of the input lists.
- (let* ((found nil)
- (tail remaining-inputs)
- (next (progn
- (while (and tail (not found))
- (setq found (eieio--c3-candidate (caar tail)
- remaining-inputs)
- tail (cdr tail)))
- found)))
- (if next
- ;; The graph is consistent so far, add NEXT to result and
- ;; merge input lists, dropping NEXT from their heads where
- ;; applicable.
- (eieio--c3-merge-lists
- (cons next reversed-partial-result)
- (mapcar (lambda (l) (if (eq (cl-first l) next) (cl-rest l) l))
- remaining-inputs))
- ;; The graph is inconsistent, give up
- (signal 'inconsistent-class-hierarchy (list remaining-inputs))))))
-
(defsubst eieio--class/struct-parents (class)
(or (eieio--class-parents class)
`(,eieio-default-superclass)))
@@ -1014,14 +971,16 @@ If a consistent order does not exist, signal an error."
(defun eieio--class-precedence-c3 (class)
"Return all parents of CLASS in c3 order."
(let ((parents (eieio--class-parents class)))
- (eieio--c3-merge-lists
- (list class)
- (append
- (or
- (mapcar #'eieio--class-precedence-c3 parents)
- `((,eieio-default-superclass)))
- (list parents))))
- )
+ (cons class
+ (merge-ordered-lists
+ (append
+ (or
+ (mapcar #'eieio--class-precedence-c3 parents)
+ `((,eieio-default-superclass)))
+ (list parents))
+ (lambda (remaining-inputs)
+ (signal 'inconsistent-class-hierarchy
+ (list remaining-inputs)))))))
;;;
;; Method Invocation Order: Depth First
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index d393ccc759a..24d31fefd7d 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -42,8 +42,6 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
-
;;; User variables:
(defgroup find-function nil
@@ -247,13 +245,19 @@ LIBRARY should be a string (the name of the library)."
;; LIBRARY may be "foo.el" or "foo".
(let ((load-re
(concat "\\(" (regexp-quote (file-name-sans-extension library)) "\\)"
- (regexp-opt (get-load-suffixes)) "\\'")))
- (cl-loop
- for (file . _) in load-history thereis
- (and (stringp file) (string-match load-re file)
- (let ((dir (substring file 0 (match-beginning 1)))
- (basename (match-string 1 file)))
- (locate-file basename (list dir) (find-library-suffixes)))))))
+ (regexp-opt (get-load-suffixes)) "\\'"))
+ (alist load-history)
+ elt file found)
+ (while (and alist (null found))
+ (setq elt (car alist)
+ alist (cdr alist)
+ file (car elt)
+ found (and (stringp file) (string-match load-re file)
+ (let ((dir (substring file 0 (match-beginning 1)))
+ (basename (match-string 1 file)))
+ (locate-file basename (list dir)
+ (find-library-suffixes))))))
+ found))
(defvar find-function-C-source-directory
(let ((dir (expand-file-name "src" source-directory)))
@@ -469,7 +473,8 @@ Return t if any PRED returns t."
((not (consp form)) nil)
((funcall pred form) t)
(t
- (cl-destructuring-bind (left-child . right-child) form
+ (let ((left-child (car form))
+ (right-child (cdr form)))
(or
(find-function--any-subform-p left-child pred)
(find-function--any-subform-p right-child pred))))))
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index cb1cc88e78f..fffb199e2ea 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -168,16 +168,14 @@ The function's value is the number of actions taken."
(key-description (vector help-char)))
(if minibuffer-auto-raise
(raise-frame (window-frame (minibuffer-window))))
- (while (progn
- (setq char (read-event))
- ;; If we get -1, from end of keyboard
- ;; macro, try again.
- (equal char -1)))
+ (setq char (read-event))
;; Show the answer to the question.
(message "%s(y, n, !, ., q, %sor %s) %s"
prompt user-keys
(key-description (vector help-char))
- (single-key-description char)))
+ (if (equal char -1)
+ "[end-of-keyboard-macro]"
+ (single-key-description char))))
(setq def (lookup-key map (vector char))))
(cond ((eq def 'exit)
(setq next (lambda () nil)))
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 98efb4c9c28..42027c01491 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -389,26 +389,8 @@ is also interactive. There are 3 cases:
`(advice--add-function ,how (gv-ref ,(advice--normalize-place place))
,function ,props))
-(declare-function comp-subr-trampoline-install "comp-run")
-
;;;###autoload
(defun advice--add-function (how ref function props)
- (when (and (featurep 'native-compile)
- (subr-primitive-p (gv-deref ref)))
- (let ((subr-name (intern (subr-name (gv-deref ref)))))
- ;; Requiring the native compiler to advice `macroexpand' cause a
- ;; circular dependency in eager macro expansion. uniquify is
- ;; advising `rename-buffer' while being loaded in loadup.el.
- ;; This would require the whole native compiler machinery but we
- ;; don't want to include it in the dump. Because these two
- ;; functions are already handled in
- ;; `native-comp-never-optimize-functions' we hack the problem
- ;; this way for now :/
- (unless (memq subr-name '(macroexpand rename-buffer))
- ;; Must require explicitly as during bootstrap we have no
- ;; autoloads.
- (require 'comp-run)
- (comp-subr-trampoline-install subr-name))))
(let* ((name (cdr (assq 'name props)))
(a (advice--member-p (or name function) (if name t) (gv-deref ref))))
(when a
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index e23a61c58a4..d4bb6710283 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -4612,8 +4612,8 @@ activations need to be changed, such as when
`package-load-list' is modified."
(let ((load-suffixes '(".el" ".elc")))
(locate-library (package--autoloads-file-name pkg))))
(pfile (prin1-to-string file)))
- (insert "(let ((load-true-file-name " pfile ")\
-\(load-file-name " pfile "))\n")
+ (insert "(let* ((load-file-name " pfile ")\
+\(load-true-file-name load-file-name))\n")
(insert-file-contents file)
;; Fixup the special #$ reader form and throw away comments.
(while (re-search-forward "#\\$\\|^;\\(.*\n\\)" nil 'move)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 1c5ce5169ab..d5f7249e527 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -609,6 +609,16 @@ recording whether the var has been referenced by earlier
parts of the match."
(symbolp . byte-code-function-p)
(symbolp . compiled-function-p)
(symbolp . recordp)
+ (null . integerp)
+ (null . numberp)
+ (null . numberp)
+ (null . consp)
+ (null . arrayp)
+ (null . vectorp)
+ (null . stringp)
+ (null . byte-code-function-p)
+ (null . compiled-function-p)
+ (null . recordp)
(integerp . consp)
(integerp . arrayp)
(integerp . vectorp)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index dbc061d8a70..1fa798beae1 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1388,7 +1388,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(set-text-properties
:no-eval (set-text-properties (point) (1+ (point)) '(face error)))
(add-face-text-property
- (add-face-text-property START END '(:foreground "green")))
+ :no-eval (add-face-text-property START END '(:foreground "green")))
(propertize
:eval (propertize "foo" 'face 'italic 'mouse-face 'bold-italic))
"Searching for Text Properties"
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 572822351b1..fec0a0301a7 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -341,10 +341,9 @@ This construct can only be used with lexical binding."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-current-buffer (get-buffer-create " *string-pixel-width*")
- ;; If `display-line-numbers-mode' is enabled in internal
- ;; buffers, it breaks width calculation, so disable it (bug#59311)
- (when (bound-and-true-p display-line-numbers-mode)
- (display-line-numbers-mode -1))
+ ;; If `display-line-numbers' is enabled in internal buffers
+ ;; (e.g. globally), it breaks width calculation (bug#59311)
+ (setq-local display-line-numbers nil)
(delete-region (point-min) (point-max))
;; Disable line-prefix and wrap-prefix, for the same reason.
(setq line-prefix nil
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 96da914275b..767ad57c471 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -593,8 +593,8 @@ This startup message appears whenever you load Viper,
unless you type \\`y' now.
))
(viper-set-expert-level 'dont-change-unless)))
- (or (apply #'derived-mode-p viper-emacs-state-mode-list) ; don't switch
to Vi
- (apply #'derived-mode-p viper-insert-state-mode-list) ; don't switch
+ (or (derived-mode-p viper-emacs-state-mode-list) ; don't switch to Vi
+ (derived-mode-p viper-insert-state-mode-list) ; don't switch
(viper-change-state-to-vi))
))
@@ -607,9 +607,9 @@ This startup message appears whenever you load Viper,
unless you type \\`y' now.
;; that are not listed in viper-vi-state-mode-list
(defun viper-this-major-mode-requires-vi-state (mode)
(let ((major-mode mode))
- (cond ((apply #'derived-mode-p viper-vi-state-mode-list) t)
- ((apply #'derived-mode-p viper-emacs-state-mode-list) nil)
- ((apply #'derived-mode-p viper-insert-state-mode-list) nil)
+ (cond ((derived-mode-p viper-vi-state-mode-list) t)
+ ((derived-mode-p viper-emacs-state-mode-list) nil)
+ ((derived-mode-p viper-insert-state-mode-list) nil)
(t (and (eq (key-binding "a") 'self-insert-command)
(eq (key-binding " ") 'self-insert-command))))))
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 4b5edaa77d2..7ff55de0d0c 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -132,8 +132,10 @@
(defvar erc-verbose-server-ping)
(defvar erc-whowas-on-nosuchnick)
+(declare-function erc--init-channel-modes "erc" (channel raw-args))
(declare-function erc--open-target "erc" (target))
(declare-function erc--target-from-string "erc" (string))
+(declare-function erc--update-modes "erc" (raw-args))
(declare-function erc-active-buffer "erc" nil)
(declare-function erc-add-default-channel "erc" (channel))
(declare-function erc-banlist-update "erc" (proc parsed))
@@ -179,7 +181,6 @@
(declare-function erc-server-buffer "erc" nil)
(declare-function erc-set-active-buffer "erc" (buffer))
(declare-function erc-set-current-nick "erc" (nick))
-(declare-function erc-set-modes "erc" (tgt mode-string))
(declare-function erc-time-diff "erc" (t1 t2))
(declare-function erc-trim-string "erc" (s))
(declare-function erc-update-mode-line "erc" (&optional buffer))
@@ -194,8 +195,6 @@
(proc parsed nick login host msg))
(declare-function erc-update-channel-topic "erc"
(channel topic &optional modify))
-(declare-function erc-update-modes "erc"
- (tgt mode-string &optional _nick _host _login))
(declare-function erc-update-user-nick "erc"
(nick &optional new-nick host login full-name info))
(declare-function erc-open "erc"
@@ -728,7 +727,7 @@ error data is something ERC recognizes. Print an
explanation to
the server buffer in any case."
(when (eq (process-status process) 'failed)
(erc-display-message
- nil 'error (process-buffer process)
+ nil '(notice error) (process-buffer process)
(format "Process exit status: %S" (process-exit-status process)))
(pcase (process-exit-status process)
(111
@@ -995,7 +994,7 @@ When `erc-server-reconnect-attempts' is a number, increment
(- erc-server-reconnect-attempts
(cl-incf erc-server-reconnect-count (or incr 1)))))
(proc (buffer-local-value 'erc-server-process buffer)))
- (erc-display-message nil 'error buffer 'reconnecting
+ (erc-display-message nil '(notice error) buffer 'reconnecting
?m erc-server-reconnect-timeout
?i (if count erc-server-reconnect-count "N")
?n (if count erc-server-reconnect-attempts "A"))
@@ -1044,13 +1043,20 @@ Conditionally try to reconnect and take appropriate
action."
;; unexpected disconnect
(erc-process-sentinel-2 event buffer))))
+(defvar-local erc--hidden-prompt-overlay nil
+ "Overlay for hiding the prompt when disconnected.")
+
(cl-defmethod erc--reveal-prompt ()
- (remove-text-properties erc-insert-marker erc-input-marker
- '(display nil)))
+ (when erc--hidden-prompt-overlay
+ (delete-overlay erc--hidden-prompt-overlay)
+ (setq erc--hidden-prompt-overlay nil)))
(cl-defmethod erc--conceal-prompt ()
- (add-text-properties erc-insert-marker (1- erc-input-marker)
- `(display ,erc-prompt-hidden)))
+ (when-let (((null erc--hidden-prompt-overlay))
+ (ov (make-overlay erc-insert-marker (1- erc-input-marker)
+ nil 'front-advance)))
+ (overlay-put ov 'display erc-prompt-hidden)
+ (setq erc--hidden-prompt-overlay ov)))
(defun erc--prompt-hidden-p ()
(and (marker-position erc-insert-marker)
@@ -1062,7 +1068,8 @@ Conditionally try to reconnect and take appropriate
action."
(marker-position erc-input-marker))
(with-silent-modifications
(put-text-property erc-insert-marker (1- erc-input-marker) 'erc-prompt t)
- (erc--reveal-prompt))))
+ (erc--reveal-prompt)
+ (run-hooks 'erc--refresh-prompt-hook))))
(defun erc--unhide-prompt-on-self-insert ()
(when (and (eq this-command #'self-insert-command)
@@ -1087,7 +1094,8 @@ Change value of property `erc-prompt' from t to `hidden'."
(with-silent-modifications
(put-text-property erc-insert-marker (1- erc-input-marker)
'erc-prompt 'hidden)
- (erc--conceal-prompt))
+ (erc--conceal-prompt)
+ (run-hooks 'erc--refresh-prompt-hook))
(add-hook 'pre-command-hook #'erc--unhide-prompt-on-self-insert 80 t))))
(defun erc-process-sentinel (cproc event)
@@ -1171,7 +1179,7 @@ Use DISPLAY-FN to show the results."
When FORCE is non-nil, bypass flood protection so that STRING is
sent directly without modifying the queue. When FORCE is the
symbol `no-penalty', exempt this round from accumulating a
-timeout penalty.
+timeout penalty and schedule it to run ASAP instead of blocking.
If TARGET is specified, look up encoding information for that
channel in `erc-encoding-coding-alist' or
@@ -1179,6 +1187,11 @@ channel in `erc-encoding-coding-alist' or
See `erc-server-flood-margin' for an explanation of the flood
protection algorithm."
+ (erc--server-send string force target))
+
+(cl-defmethod erc--server-send (string force target)
+ "Encode and send STRING to `erc-server-process'.
+Expect STRING, FORCE, and TARGET to originate from `erc-server-send'."
(erc-log (concat "erc-server-send: " string "(" (buffer-name) ")"))
(setq erc-server-last-sent-time (erc-current-time))
(let ((encoding (erc-coding-system-for-target target)))
@@ -1199,14 +1212,17 @@ protection algorithm."
(when (fboundp 'set-process-coding-system)
(set-process-coding-system erc-server-process
'raw-text encoding))
- (process-send-string erc-server-process str))
+ (if (and (eq force 'no-penalty))
+ (run-at-time nil nil #'process-send-string
+ erc-server-process str)
+ (process-send-string erc-server-process str)))
;; See `erc-server-send-queue' for full
;; explanation of why we need this condition-case
(error nil)))
(setq erc-server-flood-queue
(append erc-server-flood-queue
(list (cons str encoding))))
- (erc-server-send-queue (current-buffer))))
+ (run-at-time nil nil #'erc-server-send-queue (current-buffer))))
t)
(message "ERC: No process running")
nil)))
@@ -1276,8 +1292,10 @@ protection algorithm."
nil #'erc-server-send-queue buffer)))))))
(defun erc-message (message-command line &optional force)
- "Send LINE to the server as a privmsg or a notice.
-MESSAGE-COMMAND should be either \"PRIVMSG\" or \"NOTICE\".
+ "Send LINE, possibly expanding a target specifier beforehand.
+Expect MESSAGE-COMMAND to be an IRC command with a single
+positional target parameter followed by a trailing parameter.
+
If the target is \",\", the last person you've got a message from will
be used. If the target is \".\", the last person you've sent a message
to will be used."
@@ -1794,7 +1812,7 @@ add things to `%s' instead."
(t (erc-get-buffer tgt)))))
(with-current-buffer (or buf
(current-buffer))
- (erc-update-modes tgt mode nick host login))
+ (erc--update-modes (cdr (erc-response.command-args parsed))))
(if (or (string= login "") (string= host ""))
(erc-display-message parsed 'notice buf
'MODE-nick ?n nick
@@ -2088,7 +2106,9 @@ primitive value."
(erc-with-server-buffer erc--isupport-params)))
(value (with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
- erc-server-parameters)))
+ (or erc-server-parameters
+ (erc-with-server-buffer
+ erc-server-parameters)))))
(if (cdr v)
(erc--parse-isupport-value (cdr v))
'--empty--)))))
@@ -2098,6 +2118,22 @@ primitive value."
(when table
(remhash key table))))
+;; While it's better to depend on interfaces than specific types,
+;; using `cl-struct-slot-value' or similar to extract a known slot at
+;; runtime would incur a small "ducktyping" tax, which should probably
+;; be avoided when running dozens of times per incoming message.
+(defmacro erc--with-isupport-data (param var &rest body)
+ "Return structured data stored in VAR for \"ISUPPORT\" PARAM.
+Expect VAR's value to be an instance of `erc--isupport-data'. If
+VAR is uninitialized or stale, evaluate BODY and assign the
+result to VAR."
+ (declare (indent defun))
+ `(erc-with-server-buffer
+ (pcase-let (((,@(list '\` (list param '\, 'key)))
+ (erc--get-isupport-entry ',param)))
+ (or (and ,var (eq key (erc--isupport-data-key ,var)) ,var)
+ (setq ,var (progn ,@body))))))
+
(define-erc-response-handler (005)
"Set the variable `erc-server-parameters' and display the received message.
@@ -2118,8 +2154,11 @@ A server may send more than one 005 message."
key
value
negated)
- (when (string-match "^\\([A-Z]+\\)=\\(.*\\)$\\|^\\(-\\)?\\([A-Z]+\\)$"
- section)
+ (when (string-match
+ (rx bot (| (: (group (+ (any "A-Z"))) "=" (group (* nonl)))
+ (: (? (group "-")) (group (+ (any "A-Z")))))
+ eot)
+ section)
(setq key (or (match-string 1 section) (match-string 4 section))
value (match-string 2 section)
negated (and (match-string 3 section) '-))
@@ -2134,7 +2173,7 @@ A server may send more than one 005 message."
(let* ((nick (car (erc-response.command-args parsed)))
(modes (mapconcat #'identity
(cdr (erc-response.command-args parsed)) " ")))
- (erc-set-modes nick modes)
+ (erc--update-modes (cdr (erc-response.command-args parsed)))
(erc-display-message parsed 'notice 'active 's221 ?n nick ?m modes)))
(define-erc-response-handler (252)
@@ -2300,7 +2339,7 @@ See `erc-display-server-message'." nil
(let ((channel (cadr (erc-response.command-args parsed)))
(modes (mapconcat #'identity (cddr (erc-response.command-args parsed))
" ")))
- (erc-set-modes channel modes)
+ (erc--init-channel-modes channel (cddr (erc-response.command-args parsed)))
(erc-display-message
parsed 'notice (erc-get-buffer channel proc)
's324 ?c channel ?m modes)))
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index 596f896d9c5..e1c10be53f6 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -189,7 +189,7 @@ CALLBACK is the function to call when the user push this
button.
PAR is a number of a regexp grouping whose text will be passed to
CALLBACK. There can be several PAR arguments."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(repeat
(list :tag "Button"
(choice :tag "Matches"
@@ -713,7 +713,7 @@ Examples:
(format
\"ldapsearch -x -P 2 -h db.debian.org -b dc=debian,dc=org ircnick=%s\"
nick)))"
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(repeat (cons (string :tag "Op")
(choice function sexp))))
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 930e8032f6d..8daedf9b019 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -101,6 +101,24 @@
(contents "" :type string)
(tags '() :type list))
+(cl-defstruct erc--isupport-data
+ "Abstract \"class\" for parsed ISUPPORT data.
+For use with the macro `erc--with-isupport-data'."
+ (key nil :type (or null cons)))
+
+(cl-defstruct (erc--parsed-prefix (:include erc--isupport-data))
+ "Server-local data for recognized membership-status prefixes.
+Derived from the advertised \"PREFIX\" ISUPPORT parameter."
+ (letters "qaohv" :type string)
+ (statuses "~&@%+" :type string)
+ (alist nil :type (list-of cons)))
+
+(cl-defstruct (erc--channel-mode-types (:include erc--isupport-data))
+ "Server-local \"CHANMODES\" data."
+ (fallbackp nil :type boolean)
+ (table (make-char-table 'erc--channel-mode-types) :type char-table)
+ (shortargs (make-hash-table :test #'equal)))
+
;; After dropping 28, we can use prefixed "erc-autoload" cookies.
(defun erc--normalize-module-symbol (symbol)
"Return preferred SYMBOL for `erc--modules'."
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 4c376cfbc22..e0f6e9b5134 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -459,6 +459,26 @@ If START or END is negative, it counts from the end."
'(let (current-time-list) (current-time))
'(current-time)))
+(defmacro erc-compat--defer-format-spec-in-buffer (&rest spec)
+ "Transform SPEC forms into functions that run in the current buffer.
+For convenience, ensure function wrappers return \"\" as a
+fallback."
+ (cl-check-type (car spec) cons)
+ (let ((buffer (make-symbol "buffer")))
+ `(let ((,buffer (current-buffer)))
+ ,(list '\`
+ (mapcar
+ (pcase-lambda (`(,k . ,v))
+ (cons k
+ (list '\,(if (>= emacs-major-version 29)
+ `(lambda ()
+ (or (if (eq ,buffer (current-buffer))
+ ,v
+ (with-current-buffer ,buffer
+ ,v))
+ ""))
+ `(or ,v "")))))
+ spec)))))
(provide 'erc-compat)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index e8f3f624ff1..83f60fd3162 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -127,7 +127,7 @@ However, when `erc-fill-wrap-margin-side' is `left' or
\"resolves\" to `left', ERC uses the width of the prompt if it's
wider on MOTD's end, which really only matters when `erc-prompt'
is a function."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const nil) integer))
(defcustom erc-fill-wrap-margin-side nil
@@ -135,14 +135,19 @@ is a function."
A value of nil means ERC should decide based on the value of
`erc-insert-timestamp-function', which does not work for
user-defined functions."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const nil) (const left) (const right)))
+(defcustom erc-fill-wrap-align-prompt nil
+ "Whether to align the prompt at the common `wrap-prefix'."
+ :package-version '(ERC . "5.6")
+ :type 'boolean)
+
(defcustom erc-fill-line-spacing nil
"Extra space between messages on graphical displays.
Its value should be larger than that of the variable
`line-spacing', if set. When unsure, start with 0.5."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const nil) number))
(defvar-local erc-fill--function nil
@@ -168,8 +173,8 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(save-restriction
(narrow-to-region (point) (point-max))
(funcall (or erc-fill--function erc-fill-function))
- (when-let* ((erc-fill-line-spacing)
- (p (point-min)))
+ (when-let ((erc-fill-line-spacing)
+ (p (point-min)))
(widen)
(when (or (erc--check-msg-prop 'erc-msg 'msg)
(and-let* ((m (save-excursion
@@ -223,13 +228,11 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(defvar-local erc-fill--wrap-value nil)
(defvar-local erc-fill--wrap-visual-keys nil)
-(defcustom erc-fill-wrap-use-pixels t
+(defvar erc-fill-wrap-use-pixels t
"Whether to calculate padding in pixels when possible.
A value of nil means ERC should use columns, which may happen
regardless, depending on the Emacs version. This option only
-matters when `erc-fill-wrap-mode' is enabled."
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type 'boolean)
+matters when `erc-fill-wrap-mode' is enabled.")
(defcustom erc-fill-wrap-visual-keys 'non-input
"Whether to retain keys defined by `visual-line-mode'.
@@ -240,7 +243,7 @@ never do so. A value of `non-input' tells ERC to act like
the
value is nil in the input area and t elsewhere. See related
option `erc-fill-wrap-force-screen-line-movement' for behavior
involving `next-line' and `previous-line'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const nil) (const t) (const non-input)))
(defcustom erc-fill-wrap-force-screen-line-movement '(non-input)
@@ -251,16 +254,45 @@ screen line even if the current
`erc-fill-wrap-visual-keys' value
would normally do otherwise. For example, setting this to
\\='(nil non-input) disables logical-line movement regardless of
the value of `erc-fill-wrap-visual-keys'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(set (const nil) (const non-input)))
(defcustom erc-fill-wrap-merge t
- "Whether to consolidate messages from the same speaker.
-This tells ERC to omit redundant speaker labels for subsequent
-messages less than a day apart."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ "Whether to consolidate consecutive messages from the same speaker.
+When non-nil, ERC omits redundant speaker labels for subsequent
+messages less than a day apart. To help distinguish between
+merged messages, see related options `erc-fill-line-spacing', for
+graphical displays, and `erc-fill-wrap-merge-indicator' for text
+terminals."
+ :package-version '(ERC . "5.6")
:type 'boolean)
+(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.
+If the first element is the symbol `pre', ERC uses this option to
+generate a replacement for the speaker's name tag. If the first
+element is `post', ERC affixes a short string to the end of the
+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."
+ :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)))
+
(defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args)
(apply (pcase erc-fill--wrap-visual-keys
('non-input
@@ -414,7 +446,8 @@ cycling between logical- and screen-line oriented command
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' and `erc-fill-wrap-merge'.
+`erc-fill-line-spacing', `erc-fill-wrap-merge', and
+`erc-fill-wrap-merge-indicator'.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
@@ -448,6 +481,13 @@ is not recommended."
(or (eq erc-fill-wrap-margin-side 'left)
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
+ (when erc-fill-wrap-align-prompt
+ (add-hook 'erc--refresh-prompt-hook
+ #'erc-fill--wrap-indent-prompt nil t))
+ (when erc-stamp--margin-left-p
+ (if erc-fill-wrap-align-prompt
+ (setq erc-stamp--skip-left-margin-prompt-p t)
+ (setq erc--inhibit-prompt-display-property-p t)))
(setq erc-fill--function #'erc-fill-wrap)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
@@ -460,6 +500,11 @@ is not recommended."
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(kill-local-variable 'erc-fill--wrap-last-msg)
+ (kill-local-variable 'erc--inhibit-prompt-display-property-p)
+ (kill-local-variable 'erc-fill--wrap-merge-indicator-pre)
+ (kill-local-variable 'erc-fill--wrap-merge-indicator-post)
+ (remove-hook 'erc--refresh-prompt-hook
+ #'erc-fill--wrap-indent-prompt)
(remove-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p t))
'local)
@@ -515,15 +560,20 @@ sender as that of the previous \"PRIVMSG\"."
(defun erc-fill--wrap-measure (beg end)
"Return display spec width for inserted region between BEG and END.
-Ignore any `invisible' props that may be present when figuring."
- (if (and erc-fill-wrap-use-pixels (fboundp 'buffer-text-pixel-size))
+Ignore any `invisible' props that may be present when figuring.
+Expect the target region to be free of `line-prefix' and
+`wrap-prefix' properties, and expect `display-line-numbers-mode'
+to be disabled."
+ (if (fboundp 'buffer-text-pixel-size)
;; `buffer-text-pixel-size' can move point!
(save-excursion
(save-restriction
(narrow-to-region beg end)
(let* ((buffer-invisibility-spec)
(rv (car (buffer-text-pixel-size))))
- (if (zerop rv) 0 (list rv)))))
+ (if erc-fill-wrap-use-pixels
+ (if (zerop rv) 0 (list rv))
+ (/ rv (frame-char-width))))))
(- end beg)))
;; An escape hatch for third-party code expecting speakers of ACTION
@@ -532,6 +582,49 @@ Ignore any `invisible' props that may be present when
figuring."
(defvar erc-fill--wrap-action-dedent-p t
"Whether to dedent speakers in CTCP \"ACTION\" lines.")
+(defvar-local erc-fill--wrap-merge-indicator-pre nil)
+(defvar-local erc-fill--wrap-merge-indicator-post nil)
+
+;; To support `erc-fill-line-spacing' with the "post" variant, we'd
+;; need to use a new "replacing" `display' spec value for each
+;; insertion, and add a sentinel property alongside it atop every
+;; affected newline, e.g., (erc-fill-eol-display START-POS), where
+;; START-POS is the position of the newline in the replacing string.
+;; Then, upon spotting this sentinel in `erc-fill' (and maybe
+;; `erc-fill-wrap-refill-buffer'), we'd add `line-spacing' to the
+;; corresponding `display' replacement, starting at START-POS.
+(defun erc-fill--wrap-insert-merged-post ()
+ "Add `display' property at end of previous line."
+ (save-excursion
+ (goto-char (point-min))
+ (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 (eq (field-at-pos (- (point) 2)) 'erc-timestamp)
+ (put-text-property (1- (point)) (point)
+ 'display erc-fill--wrap-merge-indicator-pre)))
+ 0))
+
+(defun erc-fill--wrap-insert-merged-pre ()
+ "Add `display' property in lieu of speaker."
+ (if erc-fill--wrap-merge-indicator-post
+ (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))
+ " ")))
+ (put-text-property (point-min) (point) 'display s)
+ (cdr (setq erc-fill--wrap-merge-indicator-post
+ (cons s (erc-fill--wrap-measure (point-min) (point))))))))
+
(defun erc-fill-wrap ()
"Use text props to mimic the effect of `erc-fill-static'.
See `erc-fill-wrap-mode' for details."
@@ -565,7 +658,11 @@ See `erc-fill-wrap-mode' for details."
(erc-fill--wrap-continued-message-p))
(put-text-property (point-min) (point)
'display "")
- 0)
+ (if erc-fill-wrap-merge-indicator
+ (pcase (car erc-fill-wrap-merge-indicator)
+ ('pre (erc-fill--wrap-insert-merged-pre))
+ ('post (erc-fill--wrap-insert-merged-post)))
+ 0))
(t
(erc-fill--wrap-measure (point-min) (point))))))))
(add-text-properties
@@ -575,6 +672,21 @@ See `erc-fill-wrap-mode' for details."
'erc-fill--wrap-value))
wrap-prefix (space :width erc-fill--wrap-value))))))
+(defun erc-fill--wrap-indent-prompt ()
+ "Recompute the `line-prefix' of the prompt."
+ ;; Clear an existing `line-prefix' before measuring (bug#64971).
+ (remove-text-properties erc-insert-marker erc-input-marker
+ '(line-prefix nil wrap-prefix nil))
+ ;; Restoring window configuration seems to prevent unwanted
+ ;; recentering reminiscent of `scrolltobottom'-related woes.
+ (let ((c (and (get-buffer-window) (current-window-configuration)))
+ (len (erc-fill--wrap-measure erc-insert-marker erc-input-marker)))
+ (when c
+ (set-window-configuration c))
+ (put-text-property erc-insert-marker erc-input-marker
+ 'line-prefix
+ `(space :width (- erc-fill--wrap-value ,len)))))
+
(defvar erc-fill--wrap-rejigger-last-message nil
"Temporary working instance of `erc-fill--wrap-last-msg'.")
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 4cc81dd9378..6c8ec567bd9 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -73,7 +73,7 @@ messages, such as after typing \"/msg NickServ help\".
Note that users should consider this option's non-nil behavior to
be experimental. It currently only works with Emacs 28+."
:group 'erc-display
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice boolean (const relaxed)))
;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t)
@@ -286,7 +286,7 @@ displays an arrow in the left fringe or margin. When it's
`face', ERC adds the face `erc-keep-place-indicator-line' to the
appropriate line. A value of t does both."
:group 'erc
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const :tag "Use arrow" arrow)
(const :tag "Use face" face)
(const :tag "Use both arrow and face" t)))
@@ -295,14 +295,14 @@ appropriate line. A value of t does both."
"ERC buffer type in which to display `keep-place-indicator'.
A value of t means \"all\" ERC buffers."
:group 'erc
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const t) (const server) (const target)))
(defcustom erc-keep-place-indicator-follow nil
"Whether to sync visual kept place to window's top when reading.
For use with `erc-keep-place-indicator-mode'."
:group 'erc
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type 'boolean)
(defface erc-keep-place-indicator-line
@@ -471,21 +471,26 @@ For use with `keep-place-indicator' module."
erc-cmd-COUNTRY
erc-cmd-SV
erc-cmd-SM
- erc-cmd-SMV
+ erc-cmd-SAY
erc-cmd-LASTLOG)
- "List of commands that are aliases for CTCP ACTION or for ERC messages.
-
-If a command's function symbol is in this list, the typed command
-does not appear in the ERC buffer after the user presses ENTER.")
+ "List of client \"slash commands\" that perform their own buffer I/O.
+The `command-indicator' module forgoes echoing these commands,
+most of which aren't actual interactive lisp commands.")
;;;###autoload(autoload 'erc-noncommands-mode "erc-goodies" nil t)
(define-erc-module noncommands nil
- "This mode distinguishes non-commands.
-Commands listed in `erc-insert-this' know how to display
-themselves."
+ "Treat commands that display themselves specially.
+This module has been a no-op since ERC 5.3 and has likely only
+ever made sense in the context of `erc-command-indicator'. It
+was deprecated in ERC 5.6."
((add-hook 'erc--input-review-functions #'erc-send-distinguish-noncommands))
((remove-hook 'erc--input-review-functions
#'erc-send-distinguish-noncommands)))
+(make-obsolete-variable 'erc-noncommand-mode
+ 'erc-command-indicator-mode "30.1")
+(make-obsolete 'erc-noncommand-mode 'erc-command-indicator-mode "30.1")
+(make-obsolete 'erc-noncommand-enable 'erc-command-indicator-enable "30.1")
+(make-obsolete 'erc-noncommand-disable 'erc-command-indicator-disable "30.1")
(defun erc-send-distinguish-noncommands (state)
"If STR is an ERC non-command, set `insertp' in STATE to nil."
@@ -499,6 +504,106 @@ themselves."
;; Inhibit sending this string.
(setf (erc-input-insertp state) nil))))
+
+;;; Command-indicator
+
+(defface erc-command-indicator-face
+ '((t :inherit (erc-input-face fixed-pitch-serif)))
+ "Face for echoed command lines, including the prompt.
+See option `erc-command-indicator'."
+ :package-version '(ERC . "5.6") ; standard value, from bold
+ :group 'erc-faces)
+
+(defcustom erc-command-indicator 'erc-prompt
+ "Pseudo prompt for echoed command lines.
+An analog of the option `erc-prompt' that replaces the \"speaker
+label\" for echoed \"slash\" commands submitted at the prompt. A
+value of nil means ERC only inserts the command-line portion
+alone, without the prompt, which may trick certain modules, like
+`fill', into treating the leading slash command itself as the
+message's speaker."
+ :package-version '(ERC . "5.6")
+ :group 'erc-display
+ :type '(choice (const :tag "Defer to `erc-prompt'" erc-prompt)
+ (const :tag "Print command lines without a prompt" nil)
+ (string :tag "User-provided string")
+ (function :tag "User-provided function")))
+
+;;;###autoload(autoload 'erc-command-indicator-mode "erc-goodies" nil t)
+(define-erc-module command-indicator nil
+ "Echo command lines for \"slash commands,\" like /JOIN, /HELP, etc.
+Skip those appearing in `erc-noncommands-list'.
+
+Users can run \\[erc-command-indicator-toggle-hidden] to hide and
+reveal echoed command lines after they've been inserted."
+ ((add-hook 'erc--input-review-functions
+ #'erc--command-indicator-permit-insertion 80 t)
+ (erc-command-indicator-toggle-hidden -1))
+ ((remove-hook 'erc--input-review-functions
+ #'erc--command-indicator-permit-insertion t)
+ (erc-command-indicator-toggle-hidden +1))
+ 'local)
+
+(defun erc-command-indicator ()
+ "Return the command-indicator prompt as a string.
+Do nothing if the variable `erc-command-indicator' is nil."
+ (and erc-command-indicator
+ (let ((prompt (if (functionp erc-command-indicator)
+ (funcall erc-command-indicator)
+ erc-command-indicator)))
+ (concat prompt (and (not (string-empty-p prompt))
+ (not (string-suffix-p " " prompt))
+ " ")))))
+
+(defun erc-command-indicator-toggle-hidden (arg)
+ "Toggle whether echoed \"slash commands\" are visible."
+ (interactive "P")
+ (erc--toggle-hidden 'command-indicator arg))
+
+(defun erc--command-indicator-permit-insertion (state)
+ "Insert `erc-input' STATE's message if it's an echoed command."
+ (cl-assert erc-command-indicator-mode)
+ (when (erc--input-split-cmdp state)
+ (setf (erc--input-split-insertp state) #'erc--command-indicator-display)
+ (erc-send-distinguish-noncommands state)))
+
+;; This function used to be called `erc-display-command'. It was
+;; neutered in ERC 5.3.x (Emacs 24.5), commented out in 5.4, removed
+;; in 5.5, and restored in 5.6.
+(defun erc--command-indicator-display (line)
+ "Insert command LINE as echoed input resembling that of REPLs and shells."
+ (when erc-insert-this
+ (save-excursion
+ (erc--assert-input-bounds)
+ (let ((insert-position (marker-position (goto-char erc-insert-marker)))
+ (erc--msg-props (or erc--msg-props
+ (let ((ovs erc--msg-prop-overrides))
+ (map-into `((erc-msg . slash-cmd)
+ ,@(reverse ovs))
+ 'hash-table)))))
+ (when-let ((string (erc-command-indicator))
+ (erc-input-marker (copy-marker erc-input-marker)))
+ (erc-display-prompt nil nil string 'erc-command-indicator-face)
+ (remove-text-properties insert-position (point)
+ '(field nil erc-prompt nil))
+ (set-marker erc-input-marker nil))
+ (let ((beg (point)))
+ (insert line)
+ (erc-put-text-property beg (point)
+ 'font-lock-face 'erc-command-indicator-face)
+ (insert "\n"))
+ (save-restriction
+ (narrow-to-region insert-position (point))
+ (run-hooks 'erc-send-modify-hook)
+ (run-hooks 'erc-send-post-hook)
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (erc--hide-message 'command-indicator)
+ (add-text-properties (point-min) (1+ (point-min))
+ (erc--order-text-properties-from-hash
+ erc--msg-props))))
+ (erc--refresh-prompt))))
+
+
;;; IRC control character processing.
(defgroup erc-control-characters nil
"Dealing with control characters."
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 8644e61106f..6fff54d3cf4 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -695,19 +695,7 @@ This function is meant to be called from
`erc-text-matched-hook'."
Expect the function `erc-hide-fools' or similar to be present in
`erc-text-matched-hook'."
(interactive "P")
- (erc-match--toggle-hidden 'match-fools arg))
-
-(defun erc-match--toggle-hidden (prop arg)
- "Toggle invisibility for spec member PROP.
-Treat ARG in a manner similar to mode toggles defined by
-`define-minor-mode'."
- (when arg
- (setq arg (prefix-numeric-value arg)))
- (if (memq prop (ensure-list buffer-invisibility-spec))
- (unless (natnump arg)
- (remove-from-invisibility-spec prop))
- (when (or (not arg) (natnump arg))
- (add-to-invisibility-spec prop))))
+ (erc--toggle-hidden 'match-fools arg))
(provide 'erc-match)
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index dd047243a3c..f168c90df65 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -478,7 +478,7 @@ NET is a symbol indicating to which network from
`erc-networks-alist'
this server corresponds,
HOST is the server's hostname, and (TLS-)PORTS is either a
number, a list of numbers, or a list of port ranges."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(alist :key-type (string :tag "Name")
:value-type
(group symbol (string :tag "Hostname")
diff --git a/lisp/erc/erc-nicks.el b/lisp/erc/erc-nicks.el
index a7d0b0769f2..fcd3afdbbc4 100644
--- a/lisp/erc/erc-nicks.el
+++ b/lisp/erc/erc-nicks.el
@@ -71,7 +71,7 @@
(defgroup erc-nicks nil
"Colorize nicknames in ERC target buffers."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:group 'erc)
(defcustom erc-nicks-ignore-chars ",`'_-"
@@ -102,7 +102,10 @@ should adjust it before connecting."
(frame-parameter (selected-frame) 'background-color)
"Background color for calculating contrast.
Set this explicitly when the background color isn't discoverable,
-which may be the case in terminal Emacs."
+which may be the case in terminal Emacs. Even when automatically
+initialized, this value may need adjustment mid-session, such as
+after loading a new theme. Remember to run \\[erc-nicks-refresh]
+after doing so."
:type 'string)
(defcustom erc-nicks-color-adjustments
@@ -153,9 +156,13 @@ List of colors as strings (hex or named) or,
alternatively, a
single symbol representing a set of colors, like that produced by
the function `defined-colors', which ERC associates with the
symbol `defined'. Similarly, `all' tells ERC to use any 24-bit
-color. When specifying a list, users may want to set the option
-`erc-nicks-color-adjustments' to nil to prevent unwanted culling."
- :type '(choice (const all) (const defined) (repeat string)))
+color. To change the value mid-session, try
+\\[erc-nicks-refresh]."
+ :type `(choice (const :tag "All 24-bit colors" all)
+ (const :tag "Defined terminal colors" defined)
+ (const :tag "Font Lock faces" font-lock)
+ (const :tag "ANSI color faces" ansi-color)
+ (repeat :tag "User-provided list" string)))
(defcustom erc-nicks-key-suffix-format "@%n"
"Template for latter portion of keys to generate colors from.
@@ -227,6 +234,7 @@ If FG or BG are floats, interpret them as luminance values."
;;
https://www.w3.org/TR/UNDERSTANDING-WCAG20/visual-audio-contrast-contrast.html
(defun erc-nicks--adjust-contrast (color target &optional decrease)
+ (cl-assert erc-nicks--fg-rgb)
(let* ((lum-bg (or erc-nicks--bg-luminance
(setq erc-nicks--bg-luminance
(erc-nicks--get-luminance erc-nicks-bg-color))))
@@ -356,7 +364,40 @@ Return a hex string."
erc-nicks-color-adjustments
(if (stringp color) (color-name-to-rgb color) color))))
-(defun erc-nicks--create-pool (adjustments colors)
+(defvar erc-nicks--create-pool-function #'erc-nicks--create-coerced-pool
+ "Filter function for initializing the pool of colors.
+Takes a list of adjustment functions, such as those named in
+`erc-nicks-color-adjustments', and a list of colors. Returns
+another list whose members need not be among the original
+candidates. Users should note that this variable, along with its
+predefined function values, `erc-nicks--create-coerced-pool' and
+`erc-nicks--create-culled-pool', can be made public in a future
+version of this module, perhaps as a single user option, given
+sufficient demand.")
+
+(defun erc-nicks--create-coerced-pool (adjustments colors)
+ "Return COLORS that fall within parameters heeded by ADJUSTMENTS.
+Apply ADJUSTMENTS and dedupe after replacing adjusted values with
+those nearest defined for the terminal. Only perform one pass.
+That is, accept the nearest initially found as \"close enough,\"
+knowing that values may fall outside desired parameters and thus
+yield a larger pool than simple culling might produce. When
+debugging, add candidates to `erc-nicks--colors-rejects' that map
+to the same output color as some prior candidate."
+ (let* ((seen (make-hash-table :test #'equal))
+ (erc-nicks-color-adjustments adjustments)
+ pool)
+ (dolist (color colors)
+ (let ((quantized (car (tty-color-approximate
+ (color-values (erc-nicks--reduce color))))))
+ (if (gethash quantized seen)
+ (when erc-nicks--colors-rejects
+ (push color erc-nicks--colors-rejects))
+ (push quantized pool)
+ (puthash quantized color seen))))
+ (nreverse pool)))
+
+(defun erc-nicks--create-culled-pool (adjustments colors)
"Return COLORS that fall within parameters indicated by ADJUSTMENTS."
(let (addp capp satp pool)
(dolist (adjustment adjustments)
@@ -382,8 +423,12 @@ Return a hex string."
"Initialize colors and optionally display faces or color palette."
(unless (eq erc-nicks-colors 'all)
(let* ((colors (or (and (listp erc-nicks-colors) erc-nicks-colors)
+ (and (memq erc-nicks-colors '(font-lock ansi-color))
+ (erc-nicks--colors-from-faces
+ (format "%s-" erc-nicks-colors)))
(defined-colors)))
- (pool (erc-nicks--create-pool erc-nicks-color-adjustments colors)))
+ (pool (funcall erc-nicks--create-pool-function
+ erc-nicks-color-adjustments colors)))
(setq erc-nicks--colors-pool pool
erc-nicks--colors-len (length pool)))))
@@ -487,7 +532,8 @@ Abandon search after examining LIMIT faces."
" Toggling it in individual target buffers is unsupported.")
(erc-nicks-mode +1))) ; but do it anyway
(setq erc-nicks--downcased-skip-nicks
- (mapcar #'erc-downcase erc-nicks-skip-nicks))
+ (mapcar #'erc-downcase erc-nicks-skip-nicks)
+ erc-nicks--fg-rgb (erc-with-server-buffer erc-nicks--fg-rgb))
(add-function :filter-return (local 'erc-button--modify-nick-function)
#'erc-nicks--highlight-button '((depth . 80)))
(erc-button--phantom-users-mode +1))
@@ -505,14 +551,14 @@ Abandon search after examining LIMIT faces."
"Module `nicks' unable to determine background color. Setting to \""
temp "\" globally. Please see `erc-nicks-bg-color'.")
(custom-set-variables (list 'erc-nicks-bg-color temp))))
+ (setq erc-nicks--fg-rgb
+ (or (color-name-to-rgb
+ (face-foreground 'erc-default-face nil 'default))
+ (color-name-to-rgb
+ (readable-foreground-color erc-nicks-bg-color))))
(erc-nicks--init-pool)
(erc--restore-initialize-priors erc-nicks-mode
erc-nicks--face-table (make-hash-table :test #'equal)))
- (setq erc-nicks--fg-rgb
- (or (color-name-to-rgb
- (face-foreground 'erc-default-face nil 'default))
- (color-name-to-rgb
- (readable-foreground-color erc-nicks-bg-color))))
(setf (alist-get "Edit face" erc-button--nick-popup-alist nil nil #'equal)
#'erc-nicks-customize-face)
(advice-add 'widget-create-child-and-convert :filter-args
@@ -599,8 +645,10 @@ Abandon search after examining LIMIT faces."
(defun erc-nicks-refresh (debug)
"Recompute faces for all nicks on current network.
-With DEBUG, review affected faces or colors. Which one depends
-on the value of `erc-nicks-colors'."
+With DEBUG, review affected faces or colors. Exactly which of
+the two depends on the value of `erc-nicks-colors'. Note that
+the list of rejected faces may include duplicates of accepted
+ones."
(interactive "P")
(unless (derived-mode-p 'erc-mode)
(user-error "Not an ERC buffer"))
@@ -608,6 +656,8 @@ on the value of `erc-nicks-colors'."
(unless erc-nicks-mode (user-error "Module `nicks' disabled"))
(let ((erc-nicks--colors-rejects (and debug (list t))))
(erc-nicks--init-pool)
+ (unless erc-nicks--colors-pool
+ (user-error "Pool empty: all colors rejected"))
(dolist (nick (hash-table-keys erc-nicks--face-table))
;; User-tuned faces do not have an `erc-nicks--key' property.
(when-let ((face (gethash nick erc-nicks--face-table))
@@ -634,6 +684,15 @@ on the value of `erc-nicks-colors'."
(cadr (apply #'color-rgb-to-hsl
(color-name-to-rgb c))))))))))))))
+(defun erc-nicks--colors-from-faces (prefix)
+ "Extract foregrounds from faces with PREFIX
+Expect PREFIX to be something like \"ansi-color-\" or \"font-lock-\"."
+ (let (out)
+ (dolist (face (face-list) (nreverse out))
+ (when-let (((string-prefix-p prefix (symbol-name face)))
+ (color (face-foreground face)))
+ (push color out)))))
+
(provide 'erc-nicks)
;;; erc-nicks.el ends here
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index bb5fad6f52f..93be7b9f074 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -54,7 +54,7 @@ node `(speedbar) Top' for more about the underlying
integration."
(defcustom erc-speedbar-nicknames-window-width 18
"Default width of the nicknames sidebar (in columns)."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type 'integer)
(defcustom erc-speedbar-sort-users-type 'activity
@@ -69,7 +69,7 @@ nil - Do not sort users"
(defcustom erc-speedbar-hide-mode-topic 'headerline
"Hide mode and topic lines."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const :tag "Always show" nil)
(const :tag "Always hide" t)
(const :tag "Omit when headerline visible" headerline)))
@@ -81,7 +81,7 @@ When the value is t, ERC uses `erc-current-nick-face' if
When using the `nicks' module, you can see your nick as it
appears to others by coordinating with the option
`erc-nicks-skip-faces'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice face (const :tag "Current nick or own speaker face" t)))
(defvar erc-speedbar-key-map nil
@@ -135,6 +135,14 @@ This will add a speedbar major display mode."
(erase-buffer)
(let (serverp chanp queryp)
(with-current-buffer buffer
+ ;; The function `dframe-help-echo' checks the default value of
+ ;; `dframe-help-echo-function' when deciding whether to visit
+ ;; the buffer and fire the callback. This works in normal
+ ;; speedbar frames because the event handler runs in the
+ ;; `window-buffer' of the active frame. But in our hacked
+ ;; version, where the frame is hidden, `speedbar-item-info'
+ ;; never runs without this workaround.
+ (setq-local dframe-help-echo-function #'ignore)
(setq serverp (erc--server-buffer-p))
(setq chanp (erc-channel-p (erc-default-target)))
(setq queryp (erc-query-buffer-p)))
@@ -212,6 +220,11 @@ This will add a speedbar major display mode."
(buffer-name buffer) 'erc-speedbar-goto-buffer buffer nil
depth)))
+(defconst erc-speedbar--fmt-sentinel (gensym "erc-speedbar-")
+ "Symbol for identifying a nonstandard `speedbar-token' text property.
+When encountered, ERC assumes the value's tail contains
+`format'-compatible args.")
+
(defun erc-speedbar-expand-channel (text channel indent)
"For the line matching TEXT, in CHANNEL, expand or contract a line.
INDENT is the current indentation level."
@@ -221,35 +234,17 @@ INDENT is the current indentation level."
(speedbar-with-writable
(save-excursion
(end-of-line) (forward-char 1)
- (let ((modes (with-current-buffer channel
- (concat (apply #'concat
- erc-channel-modes)
- (cond
- ((and erc-channel-user-limit
- erc-channel-key)
- (if erc-show-channel-key-p
- (format "lk %.0f %s"
- erc-channel-user-limit
- erc-channel-key)
- (format "kl %.0f" erc-channel-user-limit)))
- (erc-channel-user-limit
- ;; Emacs has no bignums
- (format "l %.0f" erc-channel-user-limit))
- (erc-channel-key
- (if erc-show-channel-key-p
- (format "k %s" erc-channel-key)
- "k"))
- (t "")))))
+ (let ((modes (buffer-local-value 'erc--mode-line-mode-string channel))
(topic (erc-controls-interpret
(with-current-buffer channel erc-channel-topic))))
- (speedbar-make-tag-line
- 'angle ?i nil nil
- (concat "Modes: +" modes) nil nil nil
- (1+ indent))
+ (when modes
+ (speedbar-make-tag-line
+ 'angle ?m nil (list erc-speedbar--fmt-sentinel "Mode: %s" modes)
+ modes nil nil 'erc-notice-face (1+ indent)))
(unless (string= topic "")
(speedbar-make-tag-line
- 'angle ?i nil nil
- (concat "Topic: " topic) nil nil nil
+ 'angle ?t nil (list erc-speedbar--fmt-sentinel "Topic: %s" topic)
+ topic nil nil 'erc-notice-face
(1+ indent)))
(unless (pcase erc-speedbar-hide-mode-topic
('nil 'show)
@@ -428,6 +423,13 @@ The INDENT level is ignored."
(message "%s: %s" txt (car data)))
((bufferp data)
(message "Channel: %s" txt))
+ ;; Print help if line has a non-standard ([-+?=]) button
+ ;; char and a `speedbar-token' property with a known CAR.
+ ((and-let* ((p (text-property-not-all (pos-bol) (pos-eol)
+ 'speedbar-token nil))
+ (v (get-text-property p 'speedbar-token))
+ ((eq erc-speedbar--fmt-sentinel (car v))))
+ (apply #'message (cdr v))))
(t
(message "%s" txt)))))
@@ -469,6 +471,7 @@ The INDENT level is ignored."
(cl-assert (eq speedbar-buffer (current-buffer)))
(cl-assert (eq speedbar-frame (selected-frame)))
(setq erc-speedbar--hidden-speedbar-frame speedbar-frame
+ ;; In Emacs 27, this is not `local-variable-if-set-p'.
dframe-controlled #'erc-speedbar--dframe-controlled)
(add-hook 'window-configuration-change-hook
#'erc-speedbar--emulate-sidebar-set-window-preserve-size nil t)
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index e23380eb936..e6a8f36c332 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -85,7 +85,7 @@ screen when `erc-insert-timestamp-function' is set to
Unlike `erc-timestamp-format' and `erc-timestamp-format-left', if
the value of this option is nil, it falls back to using the value
of `erc-timestamp-format'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const nil)
(string)))
(make-obsolete-variable 'erc-timestamp-format-right
@@ -159,7 +159,7 @@ Also affects the command `erc-echo-timestamp' (singular).
See
the ZONE parameter of `format-time-string' for a description of
acceptable value types."
:type '(choice boolean number (const wall) (list number string))
- :package-version '(ERC . "5.6")) ; FIXME sync on release
+ :package-version '(ERC . "5.6"))
(defcustom erc-timestamp-intangible nil
"Whether the timestamps should be intangible, i.e. prevent the point
@@ -327,7 +327,7 @@ option adds a space after the end of a message if the stamp
doesn't already start with one. And when its value is t, it adds
a single space, unconditionally."
:type '(choice boolean integer)
- :package-version '(ERC . "5.6")) ; FIXME sync on release
+ :package-version '(ERC . "5.6"))
(defvar-local erc-stamp--margin-width nil
"Width in columns of margin for `erc-stamp--display-margin-mode'.
@@ -360,7 +360,18 @@ prompt is wider, use its width instead."
(if resetp
(or (and (not (zerop cols)) cols)
erc-stamp--margin-width
- (max (if leftp (string-width (erc-prompt)) 0)
+ (max (if leftp
+ (cond ((fboundp 'erc-fill--wrap-measure)
+ (let* ((b erc-insert-marker)
+ (e (1- erc-input-marker))
+ (w (erc-fill--wrap-measure b e)))
+ (/ (if (consp w) (car w) w)
+ (frame-char-width))))
+ ((fboundp 'string-pixel-width)
+ (/ (string-pixel-width (erc-prompt))
+ (frame-char-width)))
+ (t (string-width (erc-prompt))))
+ 0)
(1+ (string-width
(or (if leftp
erc-timestamp-last-inserted
@@ -407,6 +418,9 @@ non-nil."
(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
"Extant properties at the start of a message inherited by the stamp.")
+(defvar-local erc-stamp--skip-left-margin-prompt-p nil
+ "Don't display prompt in left margin.")
+
(declare-function erc--remove-text-properties "erc" (string))
;; Currently, `erc-insert-timestamp-right' hard codes its display
@@ -437,7 +451,8 @@ and `erc-stamp--margin-left-p', before activating the mode."
#'erc--remove-text-properties)
(add-hook 'erc--setup-buffer-hook
#'erc-stamp--refresh-left-margin-prompt nil t)
- (when erc-stamp--margin-left-p
+ (when (and erc-stamp--margin-left-p
+ (not erc-stamp--skip-left-margin-prompt-p))
(add-hook 'erc--refresh-prompt-hook
#'erc-stamp--display-prompt-in-left-margin nil t)))
(remove-function (local 'filter-buffer-substring-function)
@@ -451,6 +466,7 @@ and `erc-stamp--margin-left-p', before activating the mode."
(kill-local-variable (if erc-stamp--margin-left-p
'left-margin-width
'right-margin-width))
+ (kill-local-variable 'erc-stamp--skip-left-margin-prompt-p)
(kill-local-variable 'fringes-outside-margins)
(kill-local-variable 'erc-stamp--margin-left-p)
(kill-local-variable 'erc-stamp--margin-width)
@@ -485,18 +501,16 @@ and `erc-stamp--margin-left-p', before activating the
mode."
(setq erc-stamp--last-prompt nil))
(erc--refresh-prompt)))
-(cl-defmethod erc--reveal-prompt
- (&context (erc-stamp--display-margin-mode (eql t))
- (erc-stamp--margin-left-p (eql t)))
- (put-text-property erc-insert-marker (1- erc-input-marker)
- 'display `((margin left-margin) ,erc-stamp--last-prompt)))
-
(cl-defmethod erc--conceal-prompt
(&context (erc-stamp--display-margin-mode (eql t))
- (erc-stamp--margin-left-p (eql t)))
- (let ((prompt (string-pad erc-prompt-hidden left-margin-width nil 'start)))
- (put-text-property erc-insert-marker (1- erc-input-marker)
- 'display `((margin left-margin) ,prompt))))
+ (erc-stamp--margin-left-p (eql t))
+ (erc-stamp--skip-left-margin-prompt-p null))
+ (when-let (((null erc--hidden-prompt-overlay))
+ (prompt (string-pad erc-prompt-hidden left-margin-width nil
'start))
+ (ov (make-overlay erc-insert-marker (1- erc-input-marker)
+ nil 'front-advance)))
+ (overlay-put ov 'display `((margin left-margin) ,prompt))
+ (setq erc--hidden-prompt-overlay ov)))
(defun erc-insert-timestamp-left (string)
"Insert timestamps at the beginning of the line."
diff --git a/lisp/erc/erc-status-sidebar.el b/lisp/erc/erc-status-sidebar.el
index cf3d20aeffa..d2ecce94bcd 100644
--- a/lisp/erc/erc-status-sidebar.el
+++ b/lisp/erc/erc-status-sidebar.el
@@ -102,7 +102,7 @@ Only consulted for certain values of
`erc-status-sidebar-style'."
"Whether to highlight the selected window's buffer in the sidebar.
ERC uses the same instance across all frames. May not be
compatible with all values of `erc-status-sidebar-style'."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type 'boolean)
(defcustom erc-status-sidebar-style 'all-queries-first
@@ -135,7 +135,7 @@ of the above sets aren't really interoperable, we don't
offer
them here as customization choices, but you can still specify
them manually. See doc strings for a description of their
expected arguments and return values."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const channels-only)
(const all-mixed)
(const all-queries-first)
@@ -150,7 +150,7 @@ expected arguments and return values."
"How to display a buffer when clicked.
Values can be anything recognized by `display-buffer' for its
ACTION parameter."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type '(choice (const :tag "Always use/create other window" t)
(const :tag "Let `display-buffer' decide" nil)
(const :tag "Same window" (display-buffer-same-window
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index fd57cb9d6a0..a2f4562d333 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -13,7 +13,7 @@
;; Michael Olson (mwolson@gnu.org)
;; Kelvin White (kwhite@gnu.org)
;; Version: 5.6-git
-;; Package-Requires: ((emacs "27.1") (compat "29.1.4.1"))
+;; Package-Requires: ((emacs "27.1") (compat "29.1.4.3"))
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
@@ -155,31 +155,28 @@ their markers accordingly. The following properties have
meaning
as of ERC 5.6:
- `erc-msg': a symbol, guaranteed present; values include:
-
- - `msg', signifying a `PRIVMSG' or an incoming `NOTICE'
- - `self', a fallback used by `erc-display-msg' for callers
- that don't specify an `erc-msg'
- - `unknown', a similar fallback for `erc-display-message'
- - a catalog key, such as `s401' or `finished'
- - an `erc-display-message' TYPE parameter, like `notice'
+ `msg', signifying a `PRIVMSG' or an incoming `NOTICE';
+ `unknown', a fallback for `erc-display-message'; a catalog
+ key, such as `s401' or `finished'; an `erc-display-message'
+ TYPE parameter, like `notice'
- `erc-cmd': a message's associated IRC command, as read by
`erc--get-eq-comparable-cmd'; currently either a symbol, like
`PRIVMSG', or a number, like 5, which represents the numeric
- \"005\"; absent on \"local\" messages, such as simple warnings
- and help text, and on outgoing messages unless echoed back by
- the server (assuming future support)
+ \"005\"; absent on \"local\" messages, such as simple warnings
+ and help text, and on outgoing messages unless echoed back by
+ the server (assuming future support)
- `erc-ctcp': a CTCP command, like `ACTION'
- `erc-ts': a timestamp, possibly provided by the server; as of
- 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
- type otherwise; managed by the `stamp' module
+ 5.6, a ticks/hertz pair on Emacs 29 and above, and a \"list\"
+ type otherwise; managed by the `stamp' module
- `erc-ephemeral': a symbol prefixed by or matching a module
- name; indicates to other modules and members of modification
- hooks that the current message should not affect stateful
- operations, such as recording a channel's most recent speaker
+ name; indicates to other modules and members of modification
+ hooks that the current message should not affect stateful
+ operations, such as recording a channel's most recent speaker
This is an internal API, and the selection of related helper
utilities is fluid and provisional. As of ERC 5.6, see the
@@ -349,8 +346,13 @@ with a value of 2 and means disallow more than 1 line of
input."
"If non-nil, hide input prompt upon disconnecting.
To unhide, type something in the input area. Once revealed, a
prompt remains unhidden until the next disconnection. Channel
-prompts are unhidden upon rejoining. See
-`erc-unhide-query-prompt' for behavior concerning query prompts."
+prompts are unhidden upon rejoining. For behavior concerning
+query prompts, see `erc-unhide-query-prompt'. Longtime ERC users
+should note that this option was repurposed in ERC 5.5 because it
+had lain dormant for years after being sidelined in 5.3 when its
+only use in the interactive client was removed. Before then, its
+role was controlling whether `erc-command-indicator' would appear
+alongside echoed slash-command lines."
:package-version '(ERC . "5.5")
:group 'erc-display
:type '(choice (const :tag "Always hide prompt" t)
@@ -730,9 +732,9 @@ See also: `erc-get-channel-user-list'."
"A topic string for the channel. Should only be used in channel-buffers.")
(defvar-local erc-channel-modes nil
- "List of strings representing channel modes.
-E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
-\(not sure the ban list will be here, but why not)")
+ "List of letters, as strings, representing channel modes.
+For example, (\"i\" \"m\" \"s\"). Modes that take accompanying
+parameters are not included.")
(defvar-local erc-insert-marker nil
"The place where insertion of new text in erc buffers should happen.")
@@ -749,7 +751,74 @@ E.g. (\"i\" \"m\" \"s\" \"b Quake!*@*\")
(defcustom erc-prompt "ERC>"
"Prompt used by ERC. Trailing whitespace is not required."
:group 'erc-display
- :type '(choice string function))
+ :type '(choice string
+ (function-item :tag "Interpret format specifiers"
+ erc-prompt-format)
+ function))
+
+(defvar erc--prompt-format-face-example
+ #("%p%m%a\u00b7%b>"
+ 0 2 (font-lock-face erc-my-nick-prefix-face)
+ 2 4 (font-lock-face font-lock-keyword-face)
+ 4 6 (font-lock-face erc-error-face)
+ 6 7 (font-lock-face shadow)
+ 7 9 (font-lock-face font-lock-constant-face)
+ 9 10 (font-lock-face shadow))
+ "An example value for option `erc-prompt-format' with faces.")
+
+(defcustom erc-prompt-format erc--prompt-format-face-example
+ "Format string when `erc-prompt' is `erc-prompt-format'.
+ERC recognizes these substitution specifiers:
+
+ %a - away indicator
+ %b - buffer name
+ %t - channel or query target, server domain, or dialed address
+ %S - target@network or buffer name
+ %s - target@server or server
+ %N - current network, like Libera.Chat
+ %p - channel membership prefix, like @ or +
+ %n - current nickname
+ %c - channel modes with args for select modes
+ %C - channel modes with all args
+ %u - user modes
+ %m - channel modes sans args in channels, user modes elsewhere
+ %M - like %m but show nothing in query buffers
+
+To pick your own colors, do something like:
+
+ (setopt erc-prompt-format
+ (concat
+ (propertize \"%b\" \\='font-lock-face \\='erc-input-face)
+ (propertize \"%a\" \\='font-lock-face \\='erc-error-face)))
+
+Please remember that ERC ignores this option completely unless
+the \"parent\" option `erc-prompt' is set to `erc-prompt-format'."
+ :package-version '(ERC . "5.6")
+ :group 'erc-display
+ :type `(choice (const :tag "{Prefix}{Mode}{Away}{MIDDLE DOT}{Buffer}>"
+ ,erc--prompt-format-face-example)
+ string))
+
+(defun erc-prompt-format ()
+ "Make predefined `format-spec' substitutions.
+
+See option `erc-prompt-format' and option `erc-prompt'."
+ (format-spec erc-prompt-format
+ (erc-compat--defer-format-spec-in-buffer
+ (?C erc--channel-modes 3 ",")
+ (?M erc--format-modes 'no-query-p)
+ (?N erc-format-network)
+ (?S erc-format-target-and/or-network)
+ (?a erc--format-away-indicator)
+ (?b buffer-name)
+ (?c erc-format-channel-modes)
+ (?m erc--format-modes)
+ (?n erc-current-nick)
+ (?p erc--format-channel-status-prefix)
+ (?s erc-format-target-and/or-server)
+ (?t erc-format-target)
+ (?u erc--format-user-modes))
+ 'ignore-missing)) ; formerly `only-present'
(defun erc-prompt ()
"Return the input prompt as a string.
@@ -762,28 +831,6 @@ See also the variable `erc-prompt'."
(concat prompt " ")
prompt)))
-(defcustom erc-command-indicator nil
- "Indicator used by ERC for showing commands.
-
-If non-nil, this will be used in the ERC buffer to indicate
-commands (i.e., input starting with a `/').
-
-If nil, the prompt will be constructed from the variable `erc-prompt'."
- :group 'erc-display
- :type '(choice (const nil) string function))
-
-(defun erc-command-indicator ()
- "Return the command indicator prompt as a string.
-
-This only has any meaning if the variable `erc-command-indicator' is non-nil."
- (and erc-command-indicator
- (let ((prompt (if (functionp erc-command-indicator)
- (funcall erc-command-indicator)
- erc-command-indicator)))
- (if (> (length prompt) 0)
- (concat prompt " ")
- prompt))))
-
(defcustom erc-notice-prefix "*** "
"Prefix for all notices."
:group 'erc-display
@@ -1367,12 +1414,6 @@ This will only be used if `erc-header-line-face-method'
is non-nil."
"ERC face for the prompt."
:group 'erc-faces)
-(defface erc-command-indicator-face
- '((t :weight bold))
- "ERC face for the command indicator.
-See the variable `erc-command-indicator'."
- :group 'erc-faces)
-
(defface erc-notice-face
'((default :weight bold)
(((class color) (min-colors 88) (supports :weight semi-bold))
@@ -1380,13 +1421,13 @@ See the variable `erc-command-indicator'."
(((class color) (min-colors 88)) :foreground "SlateBlue")
(t :foreground "blue"))
"ERC face for notices."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:group 'erc-faces)
(defface erc-action-face '((((supports :weight semi-bold)) :weight semi-bold)
(t :weight bold))
"ERC face for actions generated by /ME."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:group 'erc-faces)
(defface erc-error-face '((t :foreground "red"))
@@ -1704,7 +1745,7 @@ All are symbols indicating an inciting user action, such
as the
issuance of a slash command, the clicking of a URL hyperlink, or
the invocation of an entry-point command. See Info node `(erc)
display-buffer' for more."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:group 'erc-buffers
:type erc--buffer-display-choices)
@@ -1728,7 +1769,7 @@ of the second, \"action\" argument. The item's key is
the symbol
"Duration `erc-auto-reconnect-display' remains active.
The countdown starts on MOTD and is canceled early by any
\"slash\" command."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type 'integer
:group 'erc-buffers)
@@ -1739,7 +1780,7 @@ for server buffers when automatically reconnecting, nor
does it
consider `erc-interactive-display' when users issue a /RECONNECT.
Enabling this tells ERC to always display server buffers
according to those options."
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:type 'boolean
:group 'erc-buffers)
@@ -2080,7 +2121,7 @@ buffer rather than a server buffer.")
(defcustom erc-modules '( autojoin button completion fill imenu irccontrols
list match menu move-to-prompt netsplit
- networks noncommands readonly ring stamp track)
+ networks readonly ring stamp track)
"A list of modules which ERC should enable.
If you set the value of this without using `customize' remember to call
\(erc-update-modules) after you change it. When using `customize', modules
@@ -2130,6 +2171,7 @@ removed from the list will be disabled."
(const :tag "button: Buttonize URLs, nicknames, and other text" button)
(const :tag "capab: Mark unidentified users on servers supporting CAPAB"
capab-identify)
+ (const :tag "command-indicator: Echo command lines." command-indicator)
(const :tag "completion: Complete nicknames and commands (programmable)"
completion)
(const :tag "dcc: Provide Direct Client-to-Client support" dcc)
@@ -2149,7 +2191,7 @@ removed from the list will be disabled."
(const :tag "networks: Provide data about IRC networks" networks)
(const :tag "nickbar: Show nicknames in a dyamic side window" nickbar)
(const :tag "nicks: Uniquely colorize nicknames in target buffers" nicks)
- (const :tag "noncommands: Don't display non-IRC commands after evaluation"
+ (const :tag "noncommands: Deprecated. See module `command-indicator'."
noncommands)
(const :tag "notifications: Desktop alerts on PRIVMSG or mentions"
notifications)
@@ -2175,7 +2217,7 @@ removed from the list will be disabled."
(const :tag "unmorse: Translate morse code in messages" unmorse)
(const :tag "xdcc: Act as an XDCC file-server" xdcc)
(repeat :tag "Others" :inline t symbol))
- :package-version '(ERC . "5.6") ; FIXME sync on release
+ :package-version '(ERC . "5.6")
:group 'erc)
(defun erc-update-modules ()
@@ -2948,17 +2990,40 @@ If ARG is non-nil, show the *erc-protocol* buffer."
;; send interface
+(defvar erc--send-action-function #'erc--send-action
+ "Function to display and send an outgoing CTCP ACTION message.
+Called with three arguments: the submitted input, the current
+target, and an `erc-server-send' FORCE flag.")
+
(defun erc-send-action (tgt str &optional force)
"Send CTCP ACTION information described by STR to TGT."
- (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
- ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
+ (funcall erc--send-action-function tgt str force))
+
+;; Sending and displaying are provided separately to afford modules
+;; more flexibility, e.g., to forgo displaying on the way out when
+;; expecting the server to echo messages back and/or to associate
+;; outgoing messages with IDs generated for `erc-ephemeral'
+;; placeholders.
+(defun erc--send-action-perform-ctcp (target string force)
+ "Send STRING to TARGET, possibly immediately, with FORCE."
+ (erc-send-ctcp-message target (format "ACTION %s" string) force))
+
+(defun erc--send-action-display (string)
+ "Display STRING as an outgoing \"CTCP ACTION\" message."
+ ;; Allow hooks acting on inserted PRIVMSG and NOTICES to process us.
(let ((erc--msg-prop-overrides `((erc-msg . msg)
(erc-ctcp . ACTION)
,@erc--msg-prop-overrides))
(nick (erc-current-nick)))
- (setq nick (propertize nick 'erc-speaker nick))
+ (setq nick (propertize nick 'erc-speaker nick
+ 'font-lock-face 'erc-my-nick-face))
(erc-display-message nil '(t action input) (current-buffer)
- 'ACTION ?n nick ?a str ?u "" ?h "")))
+ 'ACTION ?n nick ?a string ?u "" ?h "")))
+
+(defun erc--send-action (target string force)
+ "Display STRING, then send to TARGET as a \"CTCP ACTION\" message."
+ (erc--send-action-display string)
+ (erc--send-action-perform-ctcp target string force))
;; Display interface
@@ -2995,23 +3060,70 @@ debugging purposes, try `erc-debug-irc-protocol'."
(cl-assert (< erc-insert-marker erc-input-marker))
(cl-assert (= (field-end erc-insert-marker) erc-input-marker)))))
-(defvar erc--refresh-prompt-hook nil)
+(defvar erc--merge-prop-behind-p nil
+ "When non-nil, put merged prop(s) behind existing.")
+
+(defvar erc--refresh-prompt-hook nil
+ "Hook called after refreshing the prompt in the affected buffer.")
+
+(defvar-local erc--inhibit-prompt-display-property-p nil
+ "Tell `erc-prompt' related functions to avoid the `display' text prop.
+Modules can enable this when needing to reserve the prompt's
+display property for some other purpose, such as displaying it
+elsewhere, abbreviating it, etc.")
+
+(defconst erc--prompt-properties '( rear-nonsticky t
+ erc-prompt t ; t or `hidden'
+ field erc-prompt
+ front-sticky t
+ read-only t)
+ "Mandatory text properties added to ERC's prompt.")
+
+(defvar erc--refresh-prompt-continue-request nil
+ "State flag for refreshing prompt in all buffers.
+When the value is zero, functions assigned to the variable
+`erc-prompt' can set this to run `erc--refresh-prompt-hook' (1)
+or `erc--refresh-prompt' (2) in all buffers of the server.")
+
+(defun erc--refresh-prompt-continue (&optional hooks-only-p)
+ "Ask ERC to refresh the prompt in all buffers.
+Functions assigned to `erc-prompt' can call this if needing to
+recreate the prompt in other buffers as well. With HOOKS-ONLY-P,
+run `erc--refresh-prompt-hook' in other buffers instead of doing
+a full refresh."
+ (when (and erc--refresh-prompt-continue-request
+ (zerop erc--refresh-prompt-continue-request))
+ (setq erc--refresh-prompt-continue-request (if hooks-only-p 1 2))))
(defun erc--refresh-prompt ()
"Re-render ERC's prompt when the option `erc-prompt' is a function."
(erc--assert-input-bounds)
(unless (erc--prompt-hidden-p)
- (when (functionp erc-prompt)
- (save-excursion
- (goto-char erc-insert-marker)
- (set-marker-insertion-type erc-insert-marker nil)
- ;; Avoid `erc-prompt' (the named function), which appends a
- ;; space, and `erc-display-prompt', which propertizes all but
- ;; that space.
- (insert-and-inherit (funcall erc-prompt))
- (set-marker-insertion-type erc-insert-marker t)
- (delete-region (point) (1- erc-input-marker))))
- (run-hooks 'erc--refresh-prompt-hook)))
+ (let ((erc--refresh-prompt-continue-request
+ (or erc--refresh-prompt-continue-request 0)))
+ (when (functionp erc-prompt)
+ (save-excursion
+ (goto-char (1- erc-input-marker))
+ ;; Avoid `erc-prompt' (the named function), which appends a
+ ;; space, and `erc-display-prompt', which propertizes all
+ ;; but that space.
+ (let ((s (funcall erc-prompt))
+ (p (point))
+ (erc--merge-prop-behind-p t))
+ (erc--merge-prop 0 (length s) 'font-lock-face 'erc-prompt-face s)
+ (add-text-properties 0 (length s) erc--prompt-properties s)
+ (insert s)
+ (delete-region erc-insert-marker p))))
+ (run-hooks 'erc--refresh-prompt-hook)
+ (when-let (((> erc--refresh-prompt-continue-request 0))
+ (n erc--refresh-prompt-continue-request)
+ (erc--refresh-prompt-continue-request -1)
+ (b (current-buffer)))
+ (erc-with-all-buffers-of-server erc-server-process
+ (lambda () (not (eq b (current-buffer))))
+ (if (= n 1)
+ (run-hooks 'erc--refresh-prompt-hook)
+ (erc--refresh-prompt)))))))
(defun erc--check-msg-prop (prop &optional val)
"Return PROP's value in `erc--msg-props' when populated.
@@ -3249,9 +3361,12 @@ value. See also `erc-button-add-face'."
new)
(while (< pos to)
(setq new (if old
- (if (listp val)
- (append val (ensure-list old))
- (cons val (ensure-list old)))
+ ;; Can't `nconc' without more info.
+ (if erc--merge-prop-behind-p
+ `(,@(ensure-list old) ,@(ensure-list val))
+ (if (listp val)
+ (append val (ensure-list old))
+ (cons val (ensure-list old))))
val))
(put-text-property pos end prop new object)
(setq pos end
@@ -3308,6 +3423,18 @@ don't bother including the preceding newline."
(cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defun erc--toggle-hidden (prop arg)
+ "Toggle invisibility for spec member PROP.
+Treat ARG in a manner similar to mode toggles defined by
+`define-minor-mode'."
+ (when arg
+ (setq arg (prefix-numeric-value arg)))
+ (if (memq prop (ensure-list buffer-invisibility-spec))
+ (unless (natnump arg)
+ (remove-from-invisibility-spec prop))
+ (when (or (not arg) (natnump arg))
+ (add-to-invisibility-spec prop))))
+
(defun erc--delete-inserted-message (beg-or-point &optional end)
"Remove message between BEG and END.
Expect BEG and END to match bounds as returned by the macro
@@ -3655,6 +3782,17 @@ present."
"Non-nil when a user types a \"/slash\" command.
Remains bound until `erc-cmd-SLASH' returns.")
+(defvar erc--current-line-input-split nil
+ "Current `erc--input-split' instance when processing user input.
+This is for special cases in which a \"slash\" command needs
+details about the input it's handling or needs to detect whether
+it's been dispatched by `erc-send-current-line'.")
+
+(defvar erc--allow-empty-outgoing-lines-p nil
+ "Flag to opt out of last-minute padding of empty lines.
+Useful to extensions, like `multiline', and for interop with
+IRC-adjacent protocols.")
+
(defvar-local erc-send-input-line-function #'erc-send-input-line
"Function for sending lines lacking a leading \"slash\" command.
When prompt input starts with a \"slash\" command, like \"/MSG\",
@@ -3668,7 +3806,7 @@ for other purposes.")
(defun erc-send-input-line (target line &optional force)
"Send LINE to TARGET."
- (when (string= line "\n")
+ (when (and (not erc--allow-empty-outgoing-lines-p) (string= line "\n"))
(setq line " \n"))
(erc-message "PRIVMSG" (concat target " " line) force))
@@ -3729,7 +3867,7 @@ this function from interpreting the line as a command."
(let ((r (erc-default-target)))
(if r
(funcall erc-send-input-line-function r line force)
- (erc-display-message nil 'error (current-buffer) 'no-target)
+ (erc-display-message nil '(notice error) (current-buffer) 'no-target)
nil)))))
(defconst erc--shell-parse-regexp
@@ -3791,9 +3929,7 @@ need this when pasting multiple lines of text."
(if (string-match "^\\s-*$" line)
nil
(string-match "^ ?\\(.*\\)" line)
- (let ((msg (match-string 1 line)))
- (erc-display-msg msg)
- (erc-process-input-line msg nil t))))
+ (erc-send-message (match-string 1 line) nil)))
(put 'erc-cmd-SAY 'do-not-parse-args t)
(defun erc-cmd-SET (line)
@@ -4489,10 +4625,25 @@ the matching is case-sensitive."
(put 'erc-cmd-LASTLOG 'do-not-parse-args t)
(put 'erc-cmd-LASTLOG 'process-not-needed t)
+(defvar erc--send-message-nested-function #'erc--send-message-nested
+ "Function for inserting and sending slash-command generated text.
+When a command like /SV or /SAY modifies or replaces command-line
+input originally submitted at the prompt, `erc-send-message'
+performs additional processing to ensure said input is fit for
+inserting and sending given this \"nested\" meta context. This
+interface variable exists because modules extending fundamental
+insertion and sending operations need a say in this processing as
+well.")
+
(defun erc-send-message (line &optional force)
"Send LINE to the current channel or user and display it.
See also `erc-message' and `erc-display-line'."
+ (if (erc--input-split-p erc--current-line-input-split)
+ (funcall erc--send-message-nested-function line force)
+ (erc--send-message-external line force)))
+
+(defun erc--send-message-external (line force)
(erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
(erc-display-line
(concat (erc-format-my-nick) line)
@@ -4500,6 +4651,28 @@ See also `erc-message' and `erc-display-line'."
;; FIXME - treat multiline, run hooks, or remove me?
t)
+(defun erc--send-message-nested (input-line force)
+ "Process string INPUT-LINE almost as if it's normal chat input.
+Expect INPUT-LINE to differ from the `string' slot of the calling
+context's `erc--current-line-input-split' object because the
+latter is likely a slash command invocation whose handler
+generated INPUT-LINE. Before inserting INPUT-LINE, split it and
+run `erc-send-modify-hook' and `erc-send-post-hook' on each
+actual outgoing line. Forgo input validation because this isn't
+interactive input, and skip `erc-send-completed-hook' because it
+will run just before the outer `erc-send-current-line' call
+returns."
+ (let* ((erc-flood-protect (not force))
+ (lines-obj (erc--make-input-split input-line)))
+ (setf (erc--input-split-refoldp lines-obj) t
+ (erc--input-split-cmdp lines-obj) nil)
+ (erc--send-input-lines (erc--run-send-hooks lines-obj)))
+ t)
+
+;; FIXME if the user types /MODE<RET>, LINE becomes "\n", which
+;; matches the pattern, so "\n" is sent to the server. Perhaps
+;; instead of `do-not-parse-args', this should just join &rest
+;; arguments.
(defun erc-cmd-MODE (line)
"Change or display the mode value of a channel or user.
The first word specifies the target. The rest is the mode string
@@ -4539,6 +4712,7 @@ The rest of LINE is the message to send."
The rest of LINE is the message to send."
(erc-message "SQUERY" line))
+(put 'erc-cmd-SQUERY 'do-not-parse-args t)
(defun erc-cmd-NICK (nick)
"Change current nickname to NICK."
@@ -4581,7 +4755,7 @@ Otherwise leave the channel indicated by LINE."
(format "PART %s" ch)
(format "PART %s :%s" ch reason))
nil ch))
- (erc-display-message nil 'error (current-buffer) 'no-target)))
+ (erc-display-message nil '(notice error) (current-buffer) 'no-target)))
t)
(t nil)))
(put 'erc-cmd-PART 'do-not-parse-args t)
@@ -4921,7 +5095,7 @@ be displayed."
(progn
(erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
(erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
- (erc-display-message nil 'error (current-buffer) 'no-target)))
+ (erc-display-message nil '(notice error) (current-buffer) 'no-target)))
t)
(t nil)))
(defalias 'erc-cmd-T #'erc-cmd-TOPIC)
@@ -5152,12 +5326,7 @@ If FACE is non-nil, it will be used to propertize the
prompt. If it is nil,
;; Do not extend the text properties when typing at the end
;; of the prompt, but stuff typed in front of the prompt
;; shall remain part of the prompt.
- (setq prompt (propertize prompt
- 'rear-nonsticky t
- 'erc-prompt t ; t or `hidden'
- 'field 'erc-prompt
- 'front-sticky t
- 'read-only t))
+ (setq prompt (apply #'propertize prompt erc--prompt-properties))
(erc-put-text-property 0 (1- (length prompt))
'font-lock-face (or face 'erc-prompt-face)
prompt)
@@ -5862,9 +6031,19 @@ See also: `erc-echo-notice-in-user-buffers',
The server buffer is given by BUFFER."
(with-current-buffer buffer
(when erc-user-mode
- (let ((mode (if (functionp erc-user-mode)
- (funcall erc-user-mode)
- erc-user-mode)))
+ (let* ((mode (if (functionp erc-user-mode)
+ (funcall erc-user-mode)
+ erc-user-mode))
+ (groups (erc--parse-user-modes mode (erc--user-modes) t))
+ (superfluous (last groups 2))
+ (redundant-want (car superfluous))
+ (redundant-drop (cadr superfluous)))
+ (when redundant-want
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-add
+ ?m (apply #'string redundant-want)))
+ (when redundant-drop
+ (erc-display-message nil 'notice buffer 'user-mode-redundant-drop
+ ?m (apply #'string redundant-drop)))
(when (stringp mode)
(erc-log (format "changing mode for %s to %s" nick mode))
(erc-server-send (format "MODE %s %s" nick mode)))))))
@@ -6140,22 +6319,38 @@ See also `erc-channel-begin-receiving-names'."
(defun erc-parse-prefix ()
"Return an alist of valid prefix character types and their representations.
-Example: (operator) o => @, (voiced) v => +."
- (let ((str (or (erc-with-server-buffer (erc--get-isupport-entry 'PREFIX t))
- ;; provide a sane default
- "(qaohv)~&@%+"))
- types chars)
- (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
- (setq types (match-string 1 str)
- chars (match-string 2 str))
- (let ((len (min (length types) (length chars)))
- (i 0)
- (alist nil))
- (while (< i len)
- (setq alist (cons (cons (elt types i) (elt chars i))
- alist))
- (setq i (1+ i)))
- alist))))
+For example, if the current ISUPPORT \"PREFIX\" is \"(ov)@+\",
+return an alist `equal' to ((?v . ?+) (?o . ?@)). For historical
+reasons, ensure the ordering of the returned alist is opposite
+that of the advertised parameter."
+ (let* ((str (or (erc--get-isupport-entry 'PREFIX t) "(qaohv)~&@%+"))
+ (i 0)
+ (j (string-search ")" str))
+ collected)
+ (when j
+ (while-let ((u (aref str (cl-incf i)))
+ ((not (= ?\) u))))
+ (push (cons u (aref str (cl-incf j))) collected)))
+ collected))
+
+(defvar-local erc--parsed-prefix nil
+ "Possibly stale `erc--parsed-prefix' struct instance for the server.
+Use the \"getter\" function of the same name to obtain the current
+value.")
+
+(defun erc--parsed-prefix ()
+ "Return possibly cached `erc--parsed-prefix' object for the server.
+Ensure the returned value describes the most recent \"PREFIX\"
+parameter advertised by the current server, with the original
+ordering intact. If no such parameter has yet arrived, return a
+stand-in from the fallback value \"(qaohv)~&@%+\"."
+ (erc--with-isupport-data PREFIX erc--parsed-prefix
+ (let ((alist (nreverse (erc-parse-prefix))))
+ (make-erc--parsed-prefix
+ :key key
+ :letters (apply #'string (map-keys alist))
+ :statuses (apply #'string (map-values alist))
+ :alist alist))))
(defcustom erc-channel-members-changed-hook nil
"This hook is called every time the variable `channel-members' changes.
@@ -6169,7 +6364,7 @@ The buffer where the change happened is current while
this hook is called."
Update `erc-channel-users' according to NAMES-STRING.
NAMES-STRING is a string listing some of the names on the
channel."
- (let* ((prefix (erc-parse-prefix))
+ (let* ((prefix (erc--parsed-prefix-alist (erc--parsed-prefix)))
(voice-ch (cdr (assq ?v prefix)))
(op-ch (cdr (assq ?o prefix)))
(hop-ch (cdr (assq ?h prefix)))
@@ -6405,7 +6600,9 @@ TOPIC string to the current topic."
(defun erc-set-modes (tgt mode-string)
"Set the modes for the TGT provided as MODE-STRING."
- (let* ((modes (erc-parse-modes mode-string))
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
;; list of triples: (mode-char 'on/'off argument)
(arg-modes (nth 2 modes)))
@@ -6451,6 +6648,7 @@ for modes without parameters to add and remove
respectively. The
arg-modes is a list of triples of the form:
(MODE-CHAR ON/OFF ARGUMENT)."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
(if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
(let ((chars (mapcar #'char-to-string (match-string 1 mode-string)))
;; arguments in channel modes
@@ -6495,8 +6693,10 @@ arg-modes is a list of triples of the form:
"Update the mode information for TGT, provided as MODE-STRING.
Optional arguments: NICK, HOST and LOGIN - the attributes of the
person who changed the modes."
+ (declare (obsolete "see comment atop `erc--update-modes'" "30.1"))
;; FIXME: neither of nick, host, and login are used!
- (let* ((modes (erc-parse-modes mode-string))
+ (let* ((modes (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (erc-parse-modes mode-string)))
(add-modes (nth 0 modes))
(remove-modes (nth 1 modes))
;; list of triples: (mode-char 'on/'off argument)
@@ -6545,9 +6745,268 @@ person who changed the modes."
;; nick modes - ignored at this point
(t nil))))
+(defun erc--update-membership-prefix (nick letter state)
+ "Update status prefixes for NICK in current channel buffer.
+Expect LETTER to be a status char and STATE to be a boolean."
+ (erc-update-current-channel-member nick nil nil
+ (and (= letter ?v) state)
+ (and (= letter ?h) state)
+ (and (= letter ?o) state)
+ (and (= letter ?a) state)
+ (and (= letter ?q) state)))
+
+(defvar-local erc--channel-modes nil
+ "When non-nil, a hash table of current channel modes.
+Keys are characters. Values are either a string, for types A-C,
+or t, for type D.")
+
+(defvar-local erc--channel-mode-types nil
+ "Possibly stale `erc--channel-mode-types' instance for the server.
+Use the getter of the same name to retrieve the current value.")
+
+(defvar-local erc--mode-line-mode-string nil
+ "Computed mode-line or header-line component for user/channel modes.")
+
+(defvar erc--mode-line-chanmodes-arg-len 10
+ "Max length at which to truncate channel-mode args in header line.")
+
+(defun erc--channel-mode-types ()
+ "Return variable `erc--channel-mode-types', possibly initializing it."
+ (erc--with-isupport-data CHANMODES erc--channel-mode-types
+ (let ((types (or key '(nil "Kk" "Ll" nil)))
+ (ct (make-char-table 'erc--channel-mode-types))
+ (type ?a))
+ (dolist (cs types)
+ (dolist (c (append cs nil))
+ (aset ct c type))
+ (cl-incf type))
+ (make-erc--channel-mode-types :key key
+ :fallbackp (null key)
+ :table ct))))
+
+(defun erc--process-channel-modes (string args &optional status-letters)
+ "Parse channel \"MODE\" changes and call unary letter handlers.
+Update `erc-channel-modes' and `erc--channel-modes'. With
+STATUS-LETTERS, also update channel membership prefixes. Expect
+STRING to be the second argument from an incoming \"MODE\"
+command and ARGS to be the remaining arguments, which should
+complement relevant letters in STRING."
+ (cl-assert (erc--target-channel-p erc--target))
+ (let* ((obj (erc--channel-mode-types))
+ (table (erc--channel-mode-types-table obj))
+ (fallbackp (erc--channel-mode-types-fallbackp obj))
+ (+p t))
+ (dolist (c (append string nil))
+ (let ((letter (char-to-string c)))
+ (cond ((= ?+ c) (setq +p t))
+ ((= ?- c) (setq +p nil))
+ ((and status-letters (string-search letter status-letters))
+ (erc--update-membership-prefix (pop args) c (if +p 'on 'off)))
+ ((and-let* ((group (or (aref table c) (and fallbackp ?d))))
+ (erc--handle-channel-mode group c +p
+ (and (/= group ?d)
+ (or (/= group ?c) +p)
+ (pop args)))
+ t))
+ ((not fallbackp)
+ (erc-display-message nil '(notice error) (erc-server-buffer)
+ (format "Unknown channel mode: %S" c))))))
+ (setq erc-channel-modes (sort erc-channel-modes #'string<))
+ (setq erc--mode-line-mode-string
+ (concat "+" (erc--channel-modes erc--mode-line-chanmodes-arg-len)))
+ (erc-update-mode-line (current-buffer))))
+
+(defvar-local erc--user-modes nil
+ "Sorted list of current user \"MODE\" letters.
+Analogous to `erc-channel-modes' but chars rather than strings.")
+
+(defun erc--user-modes (&optional as-type)
+ "Return user \"MODE\" letters in a form described by AS-TYPE.
+When AS-TYPE is the symbol `strings' (plural), return a list of
+strings. When it's `string' (singular), return the same list
+concatenated into a single string. When AS-TYPE is nil, return a
+list of chars."
+ (let ((modes (or erc--user-modes (erc-with-server-buffer erc--user-modes))))
+ (pcase as-type
+ ('strings (mapcar #'char-to-string modes))
+ ('string (apply #'string modes))
+ (_ modes))))
+
+(defun erc--channel-modes (&optional as-type sep)
+ "Return channel \"MODE\" settings in a form described by AS-TYPE.
+When AS-TYPE is the symbol `strings' (plural), return letter keys
+as a list of sorted string. When it's `string' (singular),
+return keys as a single string. When it's a number N, return a
+single string consisting of the concatenated and sorted keys
+followed by a space and then their corresponding args, each
+truncated to N chars max. ERC joins these args together with
+SEP, which defaults to a single space. Otherwise, return a
+sorted alist of letter and arg pairs. In all cases that include
+values, respect `erc-show-channel-key-p' and optionally omit the
+secret key associated with the letter k."
+ (and-let* ((modes erc--channel-modes)
+ (tobj (erc--channel-mode-types))
+ (types (erc--channel-mode-types-table tobj)))
+ (let (out)
+ (maphash (lambda (k v)
+ (unless (eq ?a (aref types k))
+ (push (cons k
+ (and (not (eq t v))
+ (not (and (eq k ?k)
+ (not (bound-and-true-p
+ erc-show-channel-key-p))))
+ v))
+ out)))
+ modes)
+ (setq out (cl-sort out #'< :key #'car))
+ (pcase as-type
+ ('strings (mapcar (lambda (o) (char-to-string (car o))) out))
+ ('string (apply #'string (mapcar #'car out)))
+ ((and (pred natnump) c)
+ (let (keys vals)
+ (pcase-dolist (`(,k . ,v) out)
+ (when v
+ (push (if (> (length v) c)
+ (with-memoization
+ (gethash (list c k v)
+ (erc--channel-mode-types-shortargs tobj))
+ (truncate-string-to-width v c 0 nil t))
+ v)
+ vals))
+ (push k keys))
+ (concat (apply #'string (nreverse keys)) (and vals " ")
+ (string-join (nreverse vals) (or sep " ")))))
+ (_ out)))))
+
+(defun erc--parse-user-modes (string &optional current extrap)
+ "Return lists of chars from STRING to add to and drop from CURRENT.
+Expect STRING to be a so-called \"modestring\", the second
+parameter of a \"MODE\" command, here containing only valid
+user-mode letters. Expect CURRENT to be a list of chars
+resembling those found in `erc--user-modes'. With EXTRAP, return
+two additional lists of chars: those that would be added were
+they not already present in CURRENT and those that would be
+dropped were they not already absent."
+ (let ((addp t)
+ ;;
+ redundant-add redundant-drop adding dropping)
+ ;; For short strings, `append' appears to be no slower than
+ ;; iteration var + `aref' or `mapc' + closure.
+ (dolist (c (append string nil))
+ (pcase c
+ (?+ (setq addp t))
+ (?- (setq addp nil))
+ (_ (push c (let ((hasp (and current (memq c current))))
+ (if addp
+ (if hasp redundant-add adding)
+ (if hasp dropping redundant-drop)))))))
+ (if extrap
+ (list (nreverse adding) (nreverse dropping)
+ (nreverse redundant-add) (nreverse redundant-drop))
+ (list (nreverse adding) (nreverse dropping)))))
+
+(defun erc--update-user-modes (string)
+ "Update `erc--user-modes' from \"MODE\" STRING.
+Return its value, a list of characters sorted by character code."
+ (prog1
+ (setq erc--user-modes
+ (pcase-let ((`(,adding ,dropping)
+ (erc--parse-user-modes string erc--user-modes)))
+ (sort (seq-difference (nconc erc--user-modes adding) dropping)
+ #'<)))
+ (setq erc--mode-line-mode-string
+ (concat "+" (erc--user-modes 'string)))))
+
+(defun erc--update-channel-modes (string &rest args)
+ "Update `erc-channel-modes' and call individual mode handlers.
+Also update membership prefixes, as needed. Expect STRING to be
+a \"modestring\" and ARGS to match mode-specific parameters."
+ (let ((status-letters (or (erc-with-server-buffer
+ (erc--parsed-prefix-letters
+ (erc--parsed-prefix)))
+ "qaovhbQAOVHB")))
+ (erc--process-channel-modes string args status-letters)))
+
+;; XXX this comment is referenced elsewhere (grep before deleting).
+;;
+;; The function `erc-update-modes' was deprecated in ERC 5.6 with no
+;; immediate public replacement. Third parties needing such a thing
+;; are encouraged to write to emacs-erc@gnu.org with ideas for a
+;; mode-handler API, possibly one incorporating letter-specific
+;; handlers, like `erc--handle-channel-mode' (below), which only
+;; handles mode types A-C.
+(defun erc--update-modes (raw-args)
+ "Handle user or channel \"MODE\" update from server.
+Expect RAW-ARGS be a list consisting of a \"modestring\" followed
+by mode-specific arguments."
+ (if (and erc--target (erc--target-channel-p erc--target))
+ (apply #'erc--update-channel-modes raw-args)
+ (erc--update-user-modes (car raw-args))))
+
+(defun erc--init-channel-modes (channel raw-args)
+ "Set CHANNEL modes from RAW-ARGS.
+Expect RAW-ARGS to be a \"modestring\" without any status-prefix
+chars, followed by applicable arguments."
+ (erc-with-buffer (channel)
+ (erc--process-channel-modes (car raw-args) (cdr raw-args))))
+
+(cl-defgeneric erc--handle-channel-mode (type letter state arg)
+ "Handle a STATE change for mode LETTER of TYPE with ARG.
+Expect to be called in the affected target buffer. Expect TYPE
+to be a character, like ?a, representing an advertised
+\"CHANMODES\" group. Expect LETTER to also be a character, and
+expect STATE to be a boolean and ARGUMENT either a string or nil."
+ (erc-log (format "Channel-mode %c (type %s, arg %S) %s"
+ letter type arg (if state 'enabled 'disabled))))
+
+(cl-defmethod erc--handle-channel-mode :before (type c state arg)
+ "Record STATE change for mode letter C.
+When STATE is non-nil, add or update C's mapping in
+`erc--channel-modes', associating it with ARG if C takes a
+parameter and t otherwise. When STATE is nil, forget the
+mapping. For type A, add up update a permanent mapping for C,
+associating it with an integer indicating a running total of
+STATE changes since joining the channel. In most cases, this
+won't match the number known to the server."
+ (unless erc--channel-modes
+ (cl-assert (erc--target-channel-p erc--target))
+ (setq erc--channel-modes (make-hash-table)))
+ (if (= type ?a)
+ (cl-callf (lambda (s) (+ (or s 0) (if state +1 -1)))
+ (gethash c erc--channel-modes))
+ (if state
+ (puthash c (or arg t) erc--channel-modes)
+ (remhash c erc--channel-modes))))
+
+(cl-defmethod erc--handle-channel-mode :before ((_ (eql ?d)) c state _)
+ "Update `erc-channel-modes' for any character C of nullary type D.
+Remember when STATE is non-nil and forget otherwise."
+ (setq erc-channel-modes
+ (if state
+ (cl-pushnew (char-to-string c) erc-channel-modes :test #'equal)
+ (delete (char-to-string c) erc-channel-modes))))
+
+;; We could specialize on type C, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?l)) state arg)
+ "Update channel user limit, remembering ARG when STATE is non-nil."
+ (erc-update-channel-limit (erc--target-string erc--target)
+ (if state 'on 'off)
+ arg))
+
+;; We could specialize on type B, but that may be too brittle.
+(cl-defmethod erc--handle-channel-mode (_ (_ (eql ?k)) state arg)
+ "Update channel key, remembering ARG when state is non-nil."
+ ;; Mimic old parsing behavior in which an ARG of "*" was discarded
+ ;; even though `erc-update-channel-limit' checks STATE first.
+ (erc-update-channel-key (erc--target-string erc--target)
+ (if state 'on 'off)
+ (if (equal arg "*") nil arg)))
+
(defun erc-update-channel-limit (channel onoff n)
- ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
- "Update CHANNEL's user limit to N."
+ "Update CHANNEL's user limit to N.
+Expect ONOFF to be `on' when the mode is being enabled and `off'
+otherwise. And because this mode is of \"type C\", expect N to
+be non-nil only when enabling."
(if (or (not (eq onoff 'on))
(and (stringp n) (string-match "^[0-9]+$" n)))
(erc-with-buffer
@@ -6873,6 +7332,14 @@ ERC prints them as a single message joined by newlines.")
(when (erc--input-split-cmdp state)
(setf (erc--input-split-insertp state) nil)))
+(defun erc--make-input-split (string)
+ (make-erc--input-split
+ :string string
+ :insertp erc-insert-this
+ :sendp erc-send-this
+ :lines (split-string string erc--input-line-delim-regexp)
+ :cmdp (string-match erc-command-regexp string)))
+
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
(interactive)
@@ -6887,19 +7354,13 @@ ERC prints them as a single message joined by
newlines.")
(expand-abbrev))
(widen)
(let* ((str (erc-user-input))
- (state (make-erc--input-split
- :string str
- :insertp erc-insert-this
- :sendp erc-send-this
- :lines (split-string
- str erc--input-line-delim-regexp)
- :cmdp (string-match erc-command-regexp str))))
+ (state (erc--make-input-split str)))
(run-hook-with-args 'erc--input-review-functions state)
(when-let (((not (erc--input-split-abortp state)))
(inhibit-read-only t)
+ (erc--current-line-input-split state)
(old-buf (current-buffer)))
- (let ((erc--msg-prop-overrides `((erc-msg . msg)
- ,@erc--msg-prop-overrides)))
+ (progn ; unprogn this during next major surgery
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
@@ -6962,15 +7423,19 @@ queue. Expect LINES-OBJ to be an `erc--input-split'
object."
(run-hook-with-args 'erc-send-pre-hook str)
(make-erc-input :string str
:insertp erc-insert-this
+ :refoldp (erc--input-split-refoldp
+ lines-obj)
:sendp erc-send-this))))
(run-hook-with-args 'erc-pre-send-functions state)
(setf (erc--input-split-sendp lines-obj) (erc-input-sendp state)
(erc--input-split-insertp lines-obj) (erc-input-insertp state)
;; See note in test of same name re trailing newlines.
(erc--input-split-lines lines-obj)
- (cl-nsubst " " "" (split-string (erc-input-string state)
- erc--input-line-delim-regexp)
- :test #'equal))
+ (let ((lines (split-string (erc-input-string state)
+ erc--input-line-delim-regexp)))
+ (if erc--allow-empty-outgoing-lines-p
+ lines
+ (cl-nsubst " " "" lines :test #'equal))))
(when (erc-input-refoldp state)
(erc--split-lines lines-obj)))))
(when (and (erc--input-split-cmdp lines-obj)
@@ -6978,12 +7443,14 @@ queue. Expect LINES-OBJ to be an `erc--input-split'
object."
(user-error "Multiline command detected" ))
lines-obj)
-(defun erc--send-input-lines (lines-obj)
+(cl-defmethod erc--send-input-lines (lines-obj)
"Send lines in `erc--input-split-lines' object LINES-OBJ."
(when (erc--input-split-sendp lines-obj)
(dolist (line (erc--input-split-lines lines-obj))
(when (erc--input-split-insertp lines-obj)
- (erc-display-msg line))
+ (if (functionp (erc--input-split-insertp lines-obj))
+ (funcall (erc--input-split-insertp lines-obj) line)
+ (erc-display-msg line)))
(erc-process-input-line (concat line "\n")
(null erc-flood-protect)
(not (erc--input-split-cmdp lines-obj))))))
@@ -7042,16 +7509,15 @@ Return non-nil only if we actually send anything."
(defun erc-display-msg (line)
"Insert LINE into current buffer and run \"send\" hooks.
-Expect LINE to originate from input submitted interactively at
-the prompt, such as outgoing chat messages or echoed slash
-commands."
+Treat LINE as input submitted interactively at the prompt, such
+as outgoing chat messages and echoed slash commands."
(when erc-insert-this
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
- (erc--msg-props (or erc--msg-props ; prefer `self' to `unknown'
+ (erc--msg-props (or erc--msg-props
(let ((ovs erc--msg-prop-overrides))
- (map-into `((erc-msg . self) ,@(reverse ovs))
+ (map-into `((erc-msg . msg) ,@(reverse ovs))
'hash-table))))
beg)
(insert (erc-format-my-nick))
@@ -7490,7 +7956,10 @@ sequences, process the lines verbatim. Use this for
multiline
user input."
(let* ((cb (current-buffer))
(s "")
- (sp (or (erc-command-indicator) (erc-prompt)))
+ (sp (or (and (bound-and-true-p erc-command-indicator-mode)
+ (fboundp 'erc-command-indicator)
+ (erc-command-indicator))
+ (erc-prompt)))
(args (and (boundp 'erc-script-args) erc-script-args)))
(if (and args (string-match "^ " args))
(setq args (substring args 1)))
@@ -7909,6 +8378,62 @@ shortened server name instead."
(format-time-string erc-mode-line-away-status-format a)
"")))
+(defvar-local erc--away-indicator nil
+ "Cons containing an away indicator for the connection.")
+
+(defvar erc-away-status-indicator "A"
+ "String shown by various formatting facilities to indicate away status.
+Currently only used by the option `erc-prompt-format'.")
+
+(defun erc--format-away-indicator ()
+ "Return char with `display' property of `erc--away-indicator'."
+ (and-let* ((indicator (erc-with-server-buffer
+ (or erc--away-indicator
+ (setq erc--away-indicator (list "")))))
+ (newcar (if (erc-away-time) erc-away-status-indicator "")))
+ ;; Inform other buffers of the change when necessary.
+ (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+ (unless (eq newcar (car indicator))
+ (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+ (setcar indicator newcar))
+ (if dispp
+ (propertize "(away?)" 'display indicator)
+ newcar))))
+
+(defvar-local erc--user-modes-indicator nil
+ "Cons containing connection-wide indicator for user modes.")
+
+;; If adding more of these functions, should factor out commonalities.
+;; As of ERC 5.6, this is identical to the away variant aside from
+;; the var names and `eq', which isn't important.
+(defun erc--format-user-modes ()
+ "Return server's user modes as a string"
+ (and-let* ((indicator (erc-with-server-buffer
+ (or erc--user-modes-indicator
+ (setq erc--user-modes-indicator (list "")))))
+ (newcar (erc--user-modes 'string)))
+ (let ((dispp (not erc--inhibit-prompt-display-property-p)))
+ (unless (string= newcar (car indicator))
+ (erc--refresh-prompt-continue (and dispp 'hooks-only-p))
+ (setcar indicator newcar))
+ (if dispp
+ (propertize "(user-modes?)" 'display indicator)
+ newcar))))
+
+(defun erc--format-channel-status-prefix ()
+ "Return the current channel membership prefix."
+ (and (erc--target-channel-p erc--target)
+ (erc-get-user-mode-prefix (erc-current-nick))))
+
+(defun erc--format-modes (&optional no-query-p)
+ "Return a string of channel modes in channels and user modes elsewhere.
+With NO-QUERY-P, return nil instead of user modes in query
+buffers. Also return nil when mode information is unavailable."
+ (cond ((erc--target-channel-p erc--target)
+ (erc--channel-modes 'string))
+ ((not (and erc--target no-query-p))
+ (erc--format-user-modes))))
+
(defun erc-format-channel-modes ()
"Return the current channel's modes."
(concat (apply #'concat
@@ -7940,7 +8465,7 @@ shortened server name instead."
(with-current-buffer buffer
(let ((spec `((?a . ,(erc-format-away-status))
(?l . ,(erc-format-lag-time))
- (?m . ,(erc-format-channel-modes))
+ (?m . ,(or erc--mode-line-mode-string ""))
(?n . ,(or (erc-current-nick) ""))
(?N . ,(erc-format-network))
(?o . ,(or (erc-controls-strip erc-channel-topic) ""))
@@ -8103,10 +8628,11 @@ If optional argument HERE is non-nil, insert version
number at point."
(let (modes (case-fold-search nil))
(dolist (var (apropos-internal "^erc-.*mode$"))
(when (and (boundp var)
+ (get var 'erc-module)
(symbol-value var))
- (setq modes (cons (symbol-name var)
+ (setq modes (cons (concat "`" (symbol-name var) "'")
modes))))
- modes)
+ (sort modes #'string<))
", ")))
(if here
(insert string)
@@ -8194,9 +8720,10 @@ All windows are opened in the current frame."
(flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.")
(flood-strict-mode
. "FLOOD PROTECTION: Switched to Strict Flood Control mode.")
- (disconnected . "\n\nConnection failed! Re-establishing connection...\n")
+ (disconnected
+ . "\n\n*** Connection failed! Re-establishing connection...\n")
(disconnected-noreconnect
- . "\n\nConnection failed! Not re-establishing connection.\n")
+ . "\n\n*** Connection failed! Not re-establishing connection.\n")
(reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
(reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
(finished . "\n\n*** ERC finished ***\n")
@@ -8211,6 +8738,10 @@ All windows are opened in the current frame."
(ops . "%i operator%s: %o")
(ops-none . "No operators in this channel.")
(undefined-ctcp . "Undefined CTCP query received. Silently ignored")
+ (user-mode-redundant-add
+ . "Already have user mode(s): %m. Requesting again anyway.")
+ (user-mode-redundant-drop
+ . "Already without user mode(s): %m. Requesting removal anyway.")
(variable-not-bound . "Variable not bound!")
(ACTION . "* %n %a")
(CTCP-CLIENTINFO . "Client info for %n: %m")
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 9d4b72b01df..cf03f8399a6 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -195,6 +195,9 @@ element, regardless of any text on the command line. In
that case,
(defvar eshell-history-index nil)
(defvar eshell-matching-input-from-input-string "")
(defvar eshell-save-history-index nil)
+(defvar eshell-hist--new-items nil
+ "The number of new history items that have not been written to
+file. This variable is local in each eshell buffer.")
(defvar-keymap eshell-isearch-map
:doc "Keymap used in isearch in Eshell."
@@ -283,6 +286,7 @@ Returns nil if INPUT is prepended by blank space, otherwise
non-nil."
(make-local-variable 'eshell-history-index)
(make-local-variable 'eshell-save-history-index)
+ (setq-local eshell-hist--new-items 0)
(if (minibuffer-window-active-p (selected-window))
(setq-local eshell-save-history-on-exit nil)
@@ -323,11 +327,11 @@ Returns nil if INPUT is prepended by blank space,
otherwise non-nil."
(eshell-eval-using-options
"history" args
'((?r "read" nil read-history
- "read from history file to current history list")
+ "clear current history list and read from history file to it")
(?w "write" nil write-history
"write current history list to history file")
(?a "append" nil append-history
- "append current history list to history file")
+ "append new history in current buffer to history file")
(?h "help" nil nil "display this usage message")
:usage "[n] [-rwa [filename]]"
:post-usage
@@ -394,6 +398,8 @@ input."
(_ ; Add if not already the latest entry
(or (ring-empty-p eshell-history-ring)
(not (string-equal (eshell-get-history 0) input))))))
+ (setq eshell-hist--new-items
+ (min eshell-history-size (1+ eshell-hist--new-items)))
(eshell-put-history input))
(setq eshell-save-history-index eshell-history-index)
(setq eshell-history-index nil))
@@ -455,21 +461,30 @@ line, with the most recent command last. See also
(re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
nil t))
(let ((history (match-string 1)))
- (if (or (null ignore-dups)
- (ring-empty-p ring)
- (not (string-equal (ring-ref ring 0) history)))
- (ring-insert-at-beginning
- ring (subst-char-in-string ?\177 ?\n history))))
- (setq count (1+ count))))
+ (when (or (ring-empty-p ring)
+ (null ignore-dups)
+ (and (not (string-equal
+ (ring-ref ring (1- (ring-length ring)))
+ history))
+ (not (and (eq ignore-dups 'erase)
+ (ring-member ring history)))))
+ (ring-insert-at-beginning
+ ring (subst-char-in-string ?\177 ?\n history))
+ (setq count (1+ count))))))
(setq eshell-history-ring ring
- eshell-history-index nil))))))
+ eshell-history-index nil
+ eshell-hist--new-items 0))))))
(defun eshell-write-history (&optional filename append)
"Writes the buffer's `eshell-history-ring' to a history file.
-The name of the file is given by the variable
-`eshell-history-file-name'. The original contents of the file are
-lost if `eshell-history-ring' is not empty. If
-`eshell-history-file-name' is nil this function does nothing.
+If the optional argument FILENAME is nil, the value of
+`eshell-history-file-name' is used. This function does nothing
+if the value resolves to nil.
+
+If the optional argument APPEND is non-nil, then append new
+history items to the history file. Otherwise, overwrite the
+contents of the file with `eshell-history-ring' (so long as it is
+not empty).
Useful within process sentinels.
@@ -480,13 +495,14 @@ See also `eshell-read-history'."
((or (null file)
(equal file "")
(null eshell-history-ring)
- (ring-empty-p eshell-history-ring))
+ (ring-empty-p eshell-history-ring)
+ (and append (= eshell-hist--new-items 0)))
nil)
((not (file-writable-p resolved-file))
(message "Cannot write history file %s" resolved-file))
(t
(let* ((ring eshell-history-ring)
- (index (ring-length ring)))
+ (index (if append eshell-hist--new-items (ring-length ring))))
;; Write it all out into a buffer first. Much faster, but
;; messier, than writing it one line at a time.
(with-temp-buffer
@@ -499,7 +515,8 @@ See also `eshell-read-history'."
(subst-char-in-region start (1- (point)) ?\n ?\177)))
(eshell-with-private-file-modes
(write-region (point-min) (point-max) resolved-file append
- 'no-message))))))))
+ 'no-message)))
+ (setq eshell-hist--new-items 0))))))
(defun eshell-list-history ()
"List in help buffer the buffer's input history."
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 6561561440e..e7e91f08741 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -304,7 +304,7 @@ Used only on systems which do not support async
subprocesses.")
;; future, remember to remove `tramp-remote-path' above, too.)
(when (file-remote-p default-directory)
(push (concat "PATH=" real-path) process-environment)
- (setq tramp-remote-path (eshell-get-path)))
+ (setq tramp-remote-path (eshell-get-path t)))
;; MS-Windows needs special setting of encoding/decoding, because
;; (a) non-ASCII text in command-line arguments needs to be
;; encoded in the system's codepage; and (b) because many Windows
diff --git a/lisp/files.el b/lisp/files.el
index 29f66e27989..5b44f8824d9 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -228,7 +228,7 @@ If non-nil, this directory is used instead of
`temporary-file-directory'
by programs that create small temporary files. This is for systems that
have fast storage with limited space, such as a RAM disk."
:group 'files
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:type '(choice (const nil) directory))
;; The system null device. (Should reference NULL_DEVICE from C.)
@@ -434,7 +434,7 @@ ignored."
,@(mapcar (lambda (algo)
(list 'const algo))
(secure-hash-algorithms)))))
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:version "21.1")
(defvar auto-save--timer nil "Timer for `auto-save-visited-mode'.")
@@ -1296,7 +1296,7 @@ Tip: You can use this expansion of remote identifier
components
(defcustom remote-shell-program (or (executable-find "ssh") "ssh")
"Program to use to execute commands on a remote host (i.e. ssh)."
:version "29.1"
- :initialize 'custom-initialize-delay
+ :initialize #'custom-initialize-delay
:group 'environment
:type 'file)
@@ -3245,8 +3245,16 @@ and `inhibit-local-variables-suffixes'. If
temp))
(defvar auto-mode-interpreter-regexp
- (purecopy "#![ \t]?\\([^ \t\n]*\
-/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
+ (purecopy
+ (concat
+ "#![ \t]*"
+ ;; Optional group 1: env(1) invocation.
+ "\\("
+ "[^ \t\n]*/bin/env[ \t]*"
+ "\\(?:-S[ \t]*\\|--split-string\\(?:=\\|[ \t]*\\)\\)?"
+ "\\)?"
+ ;; Group 2: interpreter.
+ "\\([^ \t\n]+\\)"))
"Regexp matching interpreters, for file mode determination.
This regular expression is matched against the first line of a file
to determine the file's mode in `set-auto-mode'. If it matches, the file
@@ -4587,12 +4595,7 @@ applied in order then that means the more specific modes
will
variables will override modes."
(let ((key (car node)))
(cond ((null key) -1)
- ((symbolp key)
- (let ((mode key)
- (depth 0))
- (while (setq mode (get mode 'derived-mode-parent))
- (setq depth (1+ depth)))
- depth))
+ ((symbolp key) (length (derived-mode-all-parents key)))
((stringp key)
(+ 1000 (length key)))
(t -2))))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..6bf66233101 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -319,20 +319,25 @@ be set in `.emacs' instead."
(not (stringp str))
(not (string-match "^Gnus:" str)))
(list str)
- (let ((load-path (append (mm-image-load-path) load-path)))
+ (let ((load-path (append (mm-image-load-path) load-path))
+ (gnus-emacs-version (gnus-emacs-version)))
;; Add the Gnus logo.
(add-text-properties
0 5
(list 'display
(find-image
- '((:type xpm :file "gnus-pointer.xpm"
+ '((:type svg :file "gnus-pointer.svg"
+ :ascent center)
+ (:type xpm :file "gnus-pointer.xpm"
:ascent center)
(:type xbm :file "gnus-pointer.xbm"
:ascent center))
t)
- 'help-echo (format
- "This is %s, %s."
- gnus-version (gnus-emacs-version)))
+ 'help-echo (if gnus-emacs-version
+ (format
+ "This is %s, %s."
+ gnus-version gnus-emacs-version)
+ (format "This is %s." gnus-version)))
str)
(list str)))))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0f5d253bc96..9e60c21e3d4 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -154,7 +154,7 @@ If this variable is nil, no such courtesy message will be
added."
:type '(radio string (const nil)))
(defcustom message-ignored-bounced-headers
- "^\\(Received\\|Return-Path\\|Delivered-To\\):"
+ "^\\(Received\\|Return-Path\\|Delivered-To\\|DKIM-Signature\\|X-Hashcash\\):"
"Regexp that matches headers to be removed in resent bounced mail."
:group 'message-interface
:type 'regexp)
@@ -9008,7 +9008,7 @@ to the E-mail."
(message-goto-body)
(dolist (body (cdr (assoc "body" args)))
(insert body "\n")))
-
+
(setq need-body t))
(if (assoc "subject" args)
(message-goto-body)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index e93c535bbef..a8c60946121 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -742,6 +742,7 @@ the C sources, too."
(defun help-fns--parent-mode (function)
;; If this is a derived mode, link to the parent.
(let ((parent-mode (and (symbolp function)
+ ;; FIXME: Should we mention other parent modes?
(get function
'derived-mode-parent))))
(when parent-mode
@@ -2239,7 +2240,7 @@ documentation for the major and minor modes of that
buffer."
(not (get sym 'byte-obsolete-info))
;; Ignore everything bound.
(not (where-is-internal sym nil t))
- (apply #'derived-mode-p (command-modes sym)))
+ (derived-mode-p (command-modes sym)))
(push sym functions))))
(with-temp-buffer
(when functions
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 37065f5d41a..70c7516f903 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -400,9 +400,9 @@ format. See `ibuffer-update-saved-filters-format' and
(error "This buffer is not in Ibuffer mode"))
(cond (ibuffer-auto-mode
(frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ;
Initialize state vector
- (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
+ (add-hook 'post-command-hook #'ibuffer-auto-update-changed))
(t
- (remove-hook 'post-command-hook 'ibuffer-auto-update-changed))))
+ (remove-hook 'post-command-hook #'ibuffer-auto-update-changed))))
(defun ibuffer-auto-update-changed ()
(when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
@@ -557,7 +557,7 @@ See `ibuffer-do-view-and-eval' for that."
(list (read--expression "Eval in buffers (form): "))
:opstring "evaluated in"
:modifier-p :maybe)
- (eval form))
+ (eval form t))
;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext")
(define-ibuffer-op view-and-eval (form)
@@ -575,7 +575,7 @@ To evaluate a form without viewing the buffer, see
`ibuffer-do-eval'."
(unwind-protect
(progn
(switch-to-buffer buf)
- (eval form))
+ (eval form t))
(switch-to-buffer ibuffer-buf))))
;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext")
@@ -1185,10 +1185,12 @@ Interactively, prompt for NAME, and use the current
filters."
(concat " [filter: " (cdr qualifier) "]"))
('or
(concat " [OR" (mapconcat #'ibuffer-format-qualifier
- (cdr qualifier) "") "]"))
+ (cdr qualifier))
+ "]"))
('and
(concat " [AND" (mapconcat #'ibuffer-format-qualifier
- (cdr qualifier) "") "]"))
+ (cdr qualifier))
+ "]"))
(_
(let ((type (assq (car qualifier) ibuffer-filtering-alist)))
(unless qualifier
@@ -1202,11 +1204,12 @@ Interactively, prompt for NAME, and use the current
filters."
If INCLUDE-PARENTS is non-nil then include parent modes."
(let ((modes))
(dolist (buf (buffer-list))
- (let ((this-mode (buffer-local-value 'major-mode buf)))
- (while (and this-mode (not (memq this-mode modes)))
- (push this-mode modes)
- (setq this-mode (and include-parents
- (get this-mode 'derived-mode-parent))))))
+ (let ((this-modes (derived-mode-all-parents
+ (buffer-local-value 'major-mode buf))))
+ (while (and this-modes (not (memq (car this-modes) modes)))
+ (push (car this-modes) modes)
+ (setq this-modes (and include-parents
+ (cdr this-modes))))))
(mapcar #'symbol-name modes)))
@@ -1391,7 +1394,7 @@ matches against the value of `default-directory' in that
buffer."
(:description "predicate"
:reader (read-minibuffer "Filter by predicate (form): "))
(with-current-buffer buf
- (eval qualifier)))
+ (eval qualifier t)))
;;;###autoload (autoload 'ibuffer-filter-chosen-by-completion "ibuf-ext")
(defun ibuffer-filter-chosen-by-completion ()
@@ -1508,7 +1511,7 @@ Ordering is lexicographic."
"Emulate `bs-show' from the bs.el package."
(interactive)
(ibuffer t "*Ibuffer-bs*" '((filename . ".*")) nil t)
- (define-key (current-local-map) "a" 'ibuffer-bs-toggle-all))
+ (define-key (current-local-map) "a" #'ibuffer-bs-toggle-all))
(defun ibuffer-bs-toggle-all ()
"Emulate `bs-toggle-show-all' from the bs.el package."
@@ -1746,7 +1749,7 @@ You can then feed the file name(s) to other commands with
\\[yank]."
(t (file-name-nondirectory name))))))
buffers))
(string
- (mapconcat 'identity (delete "" file-names) " ")))
+ (mapconcat #'identity (delete "" file-names) " ")))
(unless (string= string "")
(if (eq last-command 'kill-region)
(kill-append string nil)
diff --git a/lisp/info-look.el b/lisp/info-look.el
index eeb758e5b85..8653a292a16 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -53,13 +53,13 @@ Automatically becomes buffer local when set in any
fashion.")
(make-variable-buffer-local 'info-lookup-mode)
(defcustom info-lookup-other-window-flag t
- "Non-nil means pop up the Info buffer in another window."
- :group 'info-lookup :type 'boolean)
+ "Non-nil means pop up the Info buffer in another window."
+ :type 'boolean)
(defcustom info-lookup-highlight-face 'match
"Face for highlighting looked up help items.
Setting this variable to nil disables highlighting."
- :group 'info-lookup :type 'face)
+ :type 'face)
(defvar info-lookup-highlight-overlay nil
"Overlay object used for highlighting.")
@@ -73,7 +73,7 @@ List elements are cons cells of the form
If a file name matches REGEXP, then use help mode MODE instead of the
buffer's major mode."
- :group 'info-lookup :type '(repeat (cons (regexp :tag "Regexp")
+ :type '(repeat (cons (regexp :tag "Regexp")
(symbol :tag "Mode"))))
(defvar info-lookup-history nil
@@ -167,13 +167,13 @@ the value of `:mode' as HELP-MODE, etc..
If no topic or mode option has been specified, then the help topic defaults
to `symbol', and the help mode defaults to the current major mode."
- (apply 'info-lookup-add-help* nil arg))
+ (apply #'info-lookup-add-help* nil arg))
(defun info-lookup-maybe-add-help (&rest arg)
"Add a help specification if none is defined.
See the documentation of the function `info-lookup-add-help'
for more details."
- (apply 'info-lookup-add-help* t arg))
+ (apply #'info-lookup-add-help* t arg))
(defun info-lookup-add-help* (maybe &rest arg)
(let (topic mode regexp ignore-case doc-spec
@@ -349,18 +349,18 @@ If optional argument QUERY is non-nil, query for the help
mode."
(setq file-name-alist (cdr file-name-alist)))))
;; If major-mode has no setups in info-lookup-alist, under any topic, then
- ;; search up through derived-mode-parent to find a parent mode which does
- ;; have some setups. This means that a `define-derived-mode' with no
+ ;; search up through `derived-mode-all-parents' to find a parent mode which
+ ;; does have some setups. This means that a `define-derived-mode' with no
;; setups of its own will select its parent mode for lookups, if one of
;; its parents has some setups. Good for example on `makefile-gmake-mode'
;; and similar derivatives of `makefile-mode'.
;;
- (let ((mode major-mode)) ;; Look for `mode' with some setups.
- (while (and mode (not info-lookup-mode))
+ (let ((modes (derived-mode-all-parents major-mode))) ;; Look for `mode' with
some setups.
+ (while (and modes (not info-lookup-mode))
(dolist (topic-cell info-lookup-alist) ;; Usually only two topics here.
- (if (info-lookup->mode-value (car topic-cell) mode)
- (setq info-lookup-mode mode)))
- (setq mode (get mode 'derived-mode-parent))))
+ (if (info-lookup->mode-value (car topic-cell) (car modes))
+ (setq info-lookup-mode (car modes))))
+ (setq modes (cdr modes))))
(or info-lookup-mode (setq info-lookup-mode major-mode)))
@@ -526,7 +526,7 @@ different window."
(nconc (condition-case nil
(info-lookup-make-completions topic mode)
(error nil))
- (apply 'append
+ (apply #'append
(mapcar (lambda (arg)
(info-lookup->completions topic arg))
refer-modes))))
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 8bb31e15b61..f2814c7a84b 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -156,11 +156,11 @@ and also consults the `emoji-alternate-names' alist."
;;;###autoload
(defun emoji-list ()
- "List emojis and insert the one that's selected.
+ "List emojis and allow selecting and inserting one of them.
Select the emoji by typing \\<emoji-list-mode-map>\\[emoji-list-select] on its
picture.
The glyph will be inserted into the buffer that was current
when the command was invoked."
- (interactive "*")
+ (interactive)
(let ((buf (current-buffer)))
(emoji--init)
(switch-to-buffer (get-buffer-create "*Emoji*"))
@@ -273,7 +273,9 @@ the name is not known."
(let ((buf emoji--insert-buffer))
(quit-window)
(if (buffer-live-p buf)
- (switch-to-buffer buf)
+ (progn
+ (switch-to-buffer buf)
+ (barf-if-buffer-read-only))
(error "Buffer disappeared")))
(let ((derived (gethash glyph emoji--derived)))
(if derived
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index 459d1ff7f97..cd83d723ece 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -293,6 +293,8 @@
("a<" . [?←])
("a>" . [?→])
("a=" . [?↔])
+ ("ae" . [?æ])
+ ("AE" . [?Æ])
("_-" . [?−])
("~=" . [?≈])
("/=" . [?≠])
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 4d231fba469..4672440bdff 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -4054,6 +4054,7 @@ since they have special meaning in a regexp."
(defvar isearch-lazy-highlight-point-max nil)
(defvar isearch-lazy-highlight-buffer nil)
(defvar isearch-lazy-highlight-case-fold-search nil)
+(defvar isearch-lazy-highlight-invisible nil)
(defvar isearch-lazy-highlight-regexp nil)
(defvar isearch-lazy-highlight-lax-whitespace nil)
(defvar isearch-lazy-highlight-regexp-lax-whitespace nil)
@@ -4099,6 +4100,8 @@ by other Emacs features."
isearch-lazy-highlight-window-group))
(not (eq isearch-lazy-highlight-case-fold-search
isearch-case-fold-search))
+ (not (eq isearch-lazy-highlight-invisible
+ isearch-invisible))
(not (eq isearch-lazy-highlight-regexp
isearch-regexp))
(not (eq isearch-lazy-highlight-regexp-function
@@ -4177,6 +4180,7 @@ by other Emacs features."
isearch-lazy-highlight-wrapped nil
isearch-lazy-highlight-last-string isearch-string
isearch-lazy-highlight-case-fold-search isearch-case-fold-search
+ isearch-lazy-highlight-invisible isearch-invisible
isearch-lazy-highlight-regexp isearch-regexp
isearch-lazy-highlight-lax-whitespace isearch-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace
isearch-regexp-lax-whitespace
@@ -4226,8 +4230,10 @@ Attempt to do the search exactly the way the pending
Isearch would."
(isearch-forward isearch-lazy-highlight-forward)
;; Count all invisible matches, but highlight only
;; matches that can be opened by visiting them later
- (search-invisible (or (not (null isearch-lazy-count))
- 'can-be-opened))
+ (search-invisible
+ (or (not (null isearch-lazy-count))
+ (and (eq isearch-lazy-highlight-invisible 'open)
+ 'can-be-opened)))
(retry t)
(success nil))
;; Use a loop like in `isearch-search'.
@@ -4247,7 +4253,9 @@ Attempt to do the search exactly the way the pending
Isearch would."
(when (or (not isearch-lazy-count)
;; Recheck the match that possibly was intended
;; for counting only, but not for highlighting
- (let ((search-invisible 'can-be-opened))
+ (let ((search-invisible
+ (and (eq isearch-lazy-highlight-invisible 'open)
+ 'can-be-opened)))
(funcall isearch-filter-predicate mb me)))
(let ((ov (make-overlay mb me)))
(push ov isearch-lazy-highlight-overlays)
@@ -4396,9 +4404,9 @@ Attempt to do the search exactly the way the pending
Isearch would."
;; value `open' since then lazy-highlight
;; will open all overlays with matches.
(if (not (let ((search-invisible
- (if (eq search-invisible 'open)
+ (if (eq
isearch-lazy-highlight-invisible 'open)
'can-be-opened
- search-invisible)))
+ isearch-lazy-highlight-invisible)))
(funcall isearch-filter-predicate mb me)))
(setq isearch-lazy-count-invisible
(1+ (or isearch-lazy-count-invisible 0)))
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 46a2e5a6ba2..f399a20a41c 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -146,21 +146,34 @@ Setup `quail-overlay' to the last character."
(progn
(delete-region (region-beginning) (region-end))
(deactivate-mark)))
- (quail-delete-region)
- (let ((first (car queues)))
- (insert
- (hangul-character
- (+ (aref first 0) (hangul-djamo 'cho (aref first 0) (aref first 1)))
- (+ (aref first 2) (hangul-djamo 'jung (aref first 2) (aref first 3)))
- (+ (aref first 4) (hangul-djamo 'jong (aref first 4) (aref first 5))))))
- (move-overlay quail-overlay (overlay-start quail-overlay) (point))
- (dolist (queue (cdr queues))
- (insert
- (hangul-character
- (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref queue 1)))
- (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref queue 3)))
- (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref queue 5)))))
- (move-overlay quail-overlay (1+ (overlay-start quail-overlay)) (point))))
+ (let* ((chars-to-insert
+ (with-temp-buffer
+ (dolist (queue queues (mapcar #'identity (buffer-string)))
+ (insert
+ (hangul-character
+ (+ (aref queue 0) (hangul-djamo 'cho (aref queue 0) (aref
queue 1)))
+ (+ (aref queue 2) (hangul-djamo 'jung (aref queue 2) (aref
queue 3)))
+ (+ (aref queue 4) (hangul-djamo 'jong (aref queue 4) (aref
queue 5))))))))
+ (overwrite-maybe
+ (or
+ ;; If the overlay isn't showing (i.e. it has 0 length) then
+ ;; we may want to insert char overwriting (iff overwrite-mode is
+ ;; non-nil, of course)
+ (= (overlay-start quail-overlay) (overlay-end quail-overlay))
+ ;; Likewise we want to do it if there is more then one
+ ;; character that were combined.
+ (cdr chars-to-insert))))
+ (quail-delete-region) ; this empties the overlay
+ (dolist (c chars-to-insert)
+ (let ((last-command-event c)
+ (overwrite-mode (and overwrite-mode
+ overwrite-maybe
+ overwrite-mode)))
+ (self-insert-command 1)
+ ;; For chars other than fhe first, no more overwrites desired
+ (setq overwrite-maybe nil)))
+ ; this shows the overlay again (TODO: do we really always revive?)
+ (move-overlay quail-overlay (1- (point)) (point))))
(defun hangul-djamo (jamo char1 char2)
"Return the double Jamo index calculated from the arguments.
diff --git a/lisp/leim/quail/pakistan.el b/lisp/leim/quail/pakistan.el
new file mode 100644
index 00000000000..ff9257722e0
--- /dev/null
+++ b/lisp/leim/quail/pakistan.el
@@ -0,0 +1,726 @@
+;;; pakistan.el --- Input methods for some languages from Pakistan -*-
lexical-binding: t; -*-
+;;
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Rahguzar <rahguzar@zohomail.eu>
+;; Keywords: convenience, multilingual, input method, Urdu, Balochi, Pashto,
Sindhi, Hindko, Brahui
+;;
+;; 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:
+;; Provides a semi-phonetic input method for Urdu
+;;
+;;; Code:
+(require 'quail)
+
+;;;; Urdu Input Methods
+;;;;; Keyboard
+;; Layout taken from https://www.branah.com/urdu
+(quail-define-package
+ "urdu-keyboard" "Urdu" "ات" t
+ "Input method for Urdu.
+Uses keyboard layout from https://www.branah.com/urdu";
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?ط)
+ ("w" ?ص)
+ ("e" ?ھ)
+ ("r" ?د)
+ ("t" ?ٹ)
+ ("y" ?پ)
+ ("u" ?ت)
+ ("i" ?ب)
+ ("o" ?ج)
+ ("p" ?ح)
+ ("a" ?م)
+ ("s" ?و)
+ ("d" ?ر)
+ ("f" ?ن)
+ ("g" ?ل)
+ ("h" ?ہ)
+ ("j" ?ا)
+ ("k" ?ک)
+ ("l" ?ی)
+ ("z" ?ق)
+ ("x" ?ف)
+ ("c" ?ے)
+ ("v" ?س)
+ ("b" ?ش)
+ ("n" ?غ)
+ ("m" ?ع)
+ ("Q" ?ظ)
+ ("W" ?ض)
+ ("E" ?ذ)
+ ("R" ?ڈ)
+ ("T" ?ث)
+ ("Y" ?ّ)
+ ("U" ?ۃ)
+ ("I" ?ـ)
+ ("O" ?چ)
+ ("P" ?خ)
+ ("A" ?ژ)
+ ("S" ?ز)
+ ("D" ?ڑ)
+ ("F" ?ں)
+ ("G" ?ۂ)
+ ("H" ?ء)
+ ("J" ?آ)
+ ("K" ?گ)
+ ("L" ?ي)
+ ("C" ?ۓ)
+ ("B" ?ؤ)
+ ("N" ?ئ)
+ ("[" ?\])
+ ("]" ?\[)
+ ("{" ?})
+ ("}" ?{)
+ (";" ?؛)
+ ("." ?۔)
+ ("," ?،)
+ ("?" ?؟))
+
+;;;;; Phonetic Keyboard
+(quail-define-package
+ "urdu-phonetic-keyboard" "Urdu" "اص" t
+ "Input method for Urdu.
+Uses phonetic keyboard layout from https://www.branah.com/urdu";
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?ق)
+ ("w" ?و)
+ ("e" ?ع)
+ ("r" ?ر)
+ ("t" ?ت)
+ ("y" ?ے)
+ ("u" ?ء)
+ ("i" ?ی)
+ ("o" ?ہ)
+ ("p" ?پ)
+ ("a" ?ا)
+ ("s" ?س)
+ ("d" ?د)
+ ("f" ?ف)
+ ("g" ?گ)
+ ("h" ?ح)
+ ("j" ?ج)
+ ("k" ?ک)
+ ("l" ?ل)
+ ("z" ?ز)
+ ("x" ?ش)
+ ("c" ?چ)
+ ("v" ?ط)
+ ("b" ?ب)
+ ("n" ?ن)
+ ("m" ?م)
+ ("Q" ?ْ)
+ ("W" ?ٔ)
+ ("E" ?ٰ)
+ ("R" ?ڑ)
+ ("T" ?ٹ)
+ ("Y" ?َ)
+ ("U" ?ئ)
+ ("I" ?ِ)
+ ("O" ?ۃ)
+ ("P" ?ُ)
+ ("A" ?آ)
+ ("S" ?ص)
+ ("D" ?ڈ)
+ ("F" ?أ)
+ ("G" ?غ)
+ ("H" ?ھ)
+ ("J" ?ض)
+ ("K" ?خ)
+ ("L" ?ٖ)
+ ("Z" ?ذ)
+ ("X" ?ژ)
+ ("C" ?ث)
+ ("V" ?ظ)
+ ("B" ?ً)
+ ("N" ?ں)
+ ("M" ?ّ)
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?٦)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+ ("0" ?۰)
+ ("`" ?؏)
+ ("#" ?ؔ)
+ ("$" ?ؒ)
+ ("%" ?٪)
+ ("^" ?ؓ)
+ ("&" ?ؑ)
+ ("*" ?ؐ)
+ ("(" ?\))
+ (")" ?\()
+ ("=" ?+)
+ (";" ?؛)
+ ("\\" ?÷)
+ ("|" ?x)
+ ("," ?،)
+ ("." ?۔)
+ ("<" ?ٗ)
+ (">" ?.)
+ ("?" ?؟)
+ ("[" ?﷽)
+ ("]" ?ﷲ)
+ ("{" ?ﷺ))
+
+;;;;; Customizable Input Method
+;;;;;; Variable declarations
+;; We define these variables now so that byte-compiler does not complain.
+;; Later they will be changed to custom variables. Their value must be void
+;; here as otherwise cutsom will not initialize them to their standard value.
+(defvar pakistan-urdu-prefixes)
+(defvar pakistan-urdu-translations)
+(defvar pakistan-urdu-diacritics-and-other-symbols)
+(defvar pakistan-urdu-poetic-symbols)
+(defvar pakistan-urdu-religious-symbols)
+(defvar pakistan-urdu-use-roman-digits)
+(defvar pakistan-extra-balochi-brahui-translations)
+(defvar pakistan-extra-pashto-translations)
+(defvar pakistan-extra-saraiki-hindko-translations)
+(defvar pakistan-extra-sindhi-translations)
+
+;;;;;; Helper functions
+(defun pakistan--define-quail-rules (rules &optional prefix package)
+ "Define translations for `urdu-custom' input method as determined by RULES.
+PACKAGE determines the input method and defaults to `urdu-custom'. RULES is
+the list of rules to define, see `quail-defrule' for details. If non-nil
+PREFIX is a string that is prefixed to each string in RULES. PREFIX can be a
+symbol in which case it is looked up in `pakistan-urdu-prefixes' to obtain the
+string."
+ (setq package (or package "urdu-custom"))
+ (when (and prefix (symbolp prefix))
+ (setq prefix (car (alist-get prefix pakistan-urdu-prefixes))))
+ (dolist (rule rules)
+ (quail-defrule (concat prefix (car rule)) (cadr rule) package)))
+
+(defun pakistan--define-numeral-translations (&optional package)
+ "Define translations to translate digits to arabic digits.
+Translations are for PACKAGE which defaults to `urdu-custom'."
+ (pakistan--define-quail-rules
+ '(("0" ?۰)
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?۶)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+ ("%" ?٪))
+ nil package))
+
+(defun pakistan--set-numeral-translations (var val)
+ "VAR should be `pakistan-urdu-use-roman-digits' and VAL its value.
+This is a setter function for the custom-variable."
+ (set-default-toplevel-value var val)
+ (if val
+ (pakistan--regenerate-translations)
+ (pakistan--define-numeral-translations)))
+
+(defun pakistan--regenerate-translations ()
+ "Regenerate the translations for urdu-custom input method."
+ (quail-select-package "urdu-custom")
+ (quail-install-map (list nil))
+ (pakistan--define-quail-rules pakistan-urdu-translations)
+ (unless pakistan-urdu-use-roman-digits
+ (pakistan--define-numeral-translations))
+ (pakistan--define-quail-rules
+ pakistan-urdu-diacritics-and-other-symbols 'diacritics)
+ (pakistan--define-quail-rules pakistan-urdu-poetic-symbols 'poetic)
+ (pakistan--define-quail-rules pakistan-urdu-religious-symbols 'religious)
+ (pakistan--define-quail-rules
+ pakistan-extra-balochi-brahui-translations 'balochi-brahui)
+ (pakistan--define-quail-rules pakistan-extra-pashto-translations 'pashto)
+ (pakistan--define-quail-rules
+ pakistan-extra-saraiki-hindko-translations 'saraiki-hindko)
+ (pakistan--define-quail-rules pakistan-extra-sindhi-translations 'sindhi))
+
+(defun pakistan--set-prefixes (var val)
+ "VAR should be `pakistan-urdu-prefixes' and VAL is the value to be set.
+Setter function for `pakistan-urdu-prefixes'."
+ (set-default-toplevel-value var val)
+ (when (boundp 'pakistan-urdu-use-roman-digits)
+ (pakistan--regenerate-translations)))
+
+(defun pakistan--make-setter (&optional prefix)
+ "Return the setter function.
+The function adds rules to `urdu-custom' with PREFIX."
+ (lambda (var val)
+ (set-default-toplevel-value var val)
+ (if (boundp 'pakistan-urdu-use-roman-digits)
+ (pakistan--regenerate-translations)
+ (pakistan--define-quail-rules val prefix))))
+
+;;;;;; Package definition
+(quail-define-package
+ "urdu-custom" "Urdu" "اا" t
+ "Intuitive and customizable transl input method for Urdu.
+By default this input method doesn't try to follow the common romanization of
+Urdu very closely. The reason for this is allow to for input efficiency. It
+works as follows:
+
+1) All lower case letters on QWERTY keyboard are translated to an urdu
+character. When more than one Urdu letter corresponds to the same Roman
+letter, the most common Urdu letter has been chosen. The frequency analysis
+was done on the basis of Urdu word list at
+https://github.com/urduhack/urdu-words/blob/master/words.txt As a result some
+of the translations are:
+h → ہ
+s → س , c → ص
+z → ز
+
+2) For the next common letter the uppercase English letter is used, e.g.
+r → ر , R → ڑ
+n → ن , N → ں
+
+3) The letter x is used for postfix completions. There are two subcases:
+3a) When more than two urdu letter map to the same roman letter,
+e.g.
+t → ت, T → ٹ , tx → ط , Tx → ۃ
+h → ہ , H → ھ , hx → ح , Hx → ۂ
+s → س , c → ص , sx → ش , S → ث , cx → چ
+z → ز , Z → ض, zx → ذ , Zx → ظ
+3b) The urdu letters that are commonly romanized by a English letter + h
+can be obtained by the same English letter + x i.e.
+gx → غ , cx → چ, kx → خ , sx → ش
+
+4) Y → ژ is somewhat of an abberation. All four of z, Z, zx and Zx are
+used by more common letters. Y is used for ژ because it is sometimes
+pronounced close to Y for some European languages.
+
+These translations can be changed by customizing `pakistan-urdu-translations'.
+
+5) o is used for prefix completion of diacrtics or اعر۱ب as well as some
+poetic and religious symbols. The most common three diacritics are mapped to
+oa → zabr (a for above)
+ob → zer (b for below)
+oo → pesh (o for the circle in pesh)
+
+6) The poetic symbols are also available under G (for غزل), while religious
+symbols are also available under M (for مزہب).
+
+7) Characters from Balochi, Brahui Pashto, Saraiki and Sindhi which are not
+part of Urdu alphabet can also be input. Each set of these sets correspond to
+a different prefixes. See `pakistan-urdu-prefixes' for the prefixes.
+
+The translations and the prefixes described above can be customized. Various
+customization options can be found under the customization group
+`pakistan-urdu-input'."
+ nil t t t t nil nil nil nil nil t)
+
+;;;;;; Customizations
+(defgroup pakistan-urdu-input nil
+ "Customization group for Urdu input methods."
+ :group 'quail)
+
+(defcustom pakistan-urdu-prefixes
+ '((diacritics "o")
+ (poetic "G")
+ (religious "M")
+ (balochi-brahui "B")
+ (pashto "P")
+ (sindhi "C")
+ (saraiki-hindko "X"))
+ "Prefixes for `urdu-custom' input method."
+ :set #'pakistan--set-prefixes
+ :type '(repeat (list symbol string))
+ :version "30.1")
+
+(defcustom pakistan-urdu-translations
+ '(("a" ?ا)
+ ("y" ?ی)
+ ("r" ?ر)
+ ("n" ?ن)
+ ("v" ?و)
+ ("m" ?م)
+ ("t" ?ت)
+ ("l" ?ل)
+ ("k" ?ک)
+ ("b" ?ب)
+ ("d" ?د)
+ ("h" ?ہ)
+ ("s" ?س)
+ ("H" ?ھ)
+ ("p" ?پ)
+ ("N" ?ں)
+ ("g" ?گ)
+ ("sx" ?ش)
+ ("j" ?ج)
+ ("T" ?ٹ)
+ ("f" ?ف)
+ ("cx" ?چ)
+ ("z" ?ز)
+ ("u" ?ع)
+ ("q" ?ق)
+ ("kx" ?خ)
+ ("e" ?ے)
+ ("E" ?ۓ)
+ ("hx" ?ح)
+ ("i" ?ئ)
+ ("R" ?ڑ)
+ ("tx" ?ط)
+ ("c" ?ص)
+ ("D" ?ڈ)
+ ("gx" ?غ)
+ ("A" ?آ)
+ ("Z" ?ض)
+ ("V" ?ؤ)
+ ("zx" ?ذ)
+ ("S" ?ث)
+ ("Zx" ?ظ)
+ ("Hx" ?ۂ)
+ ("ix" ?ء)
+ ("Tx" ?ۃ)
+ ("Y" ?ژ)
+ ("ax" ?أ)
+ ("." ?۔)
+ ("," ?،)
+ (";" ?؛)
+ ("?" ?؟))
+ "Translations for Urdu characters and common punctuations."
+ :set (pakistan--make-setter)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-urdu-diacritics-and-other-symbols
+ '(("a" ?َ) ;; zabar زبر
+ ("b" ?ِ) ;; zer زير
+ ("o" ?ُ) ;; pesh پيش
+ ("j" ?ْ) ;; jazam جزم
+ ("S" ?ّ) ;; tashdid تشدید
+ ("k" ?ٰ) ;; khari zabar کھڑی زبر
+ ("u" ?٘) ;; ulti jazm الٹی جزم
+ ("s" ?؎)
+ ("m" ?؏)
+ ("t" ?ؔ)
+ ("c" ?ؐ)
+ ("r" ?ؒ)
+ ("R" ?ؓ)
+ ("A" ?ؑ))
+ "Translations to input Urdu diacrtics.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'diacritics)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-urdu-poetic-symbols
+ '(("s" ?؎)
+ ("m" ?؏)
+ ("t" ?ؔ))
+ "Translation to input Urdu peotic symbols.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'poetic)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-urdu-religious-symbols
+ '(("s" ?ؐ)
+ ("r" ?ؒ)
+ ("R" ?ؓ)
+ ("a" ?ؑ)
+ ("A" ?ﷲ)
+ ("S" ?ﷺ))
+ "Translation to input Urdu peotic symbols.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'religious)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+;; I don't understand how many of these letters are pronounced.
+;; So better translations are welcome.
+(defcustom pakistan-extra-balochi-brahui-translations
+ '(("v" ?ۏ)
+ ("y" ?ݔ)
+;; Brahui
+ ("l" ?ڷ))
+ "Translations to input Balochi and Brahui letters not found in Urdu.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'balochi-brahui)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-extra-pashto-translations
+ '(("t" ?ټ)
+ ("d" ?ډ)
+ ("r" ?ړ)
+ ("n" ?ڼ)
+ ("s" ?ښ)
+ ("R" ?ږ)
+ ("h" ?څ)
+ ("H" ?ځ))
+ "Translations to input Pashto letters not found in Urdu.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'pashto)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-extra-sindhi-translations
+ '(("k" ?ڪ)
+ ("j" ?ڄ)
+ ("t" ?ٺ)
+ ("T" ?ٽ)
+ ("tx" ?ٿ)
+ ("b" ?ٻ)
+ ("B" ?ڀ)
+ ("r" ?ڙ)
+ ("d" ?ڌ)
+ ("D" ?ڏ)
+ ("dx" ?ڊ)
+ ("Dx" ?ڍ)
+ ("h" ?ڃ)
+ ("c" ?ڇ)
+ ("p" ?ڦ)
+ ("n" ?ڻ)
+ ("g" ?ڳ)
+ ("G" ?ڱ))
+ "Translations to input Sindhi letters not found in Urdu.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'sindhi)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-extra-saraiki-hindko-translations
+ '(("b" ?ٻ)
+ ("h" ?ڄ)
+ ("g" ?ڳ)
+ ("d" ?ݙ)
+ ("n" ?ݨ)
+;; Hindko
+ ("r" ?ݬ)
+ ("v" ?ڨ)
+ ("N" ?ݩ)
+ ("V" ?ٷ))
+"Translations to input Saraiki letters not found in Urdu.
+These are available under the prefix specified in `pakistan-urdu-prefixes'."
+ :set (pakistan--make-setter 'saraiki-hindko)
+ :type '(repeat (list string character))
+ :version "30.1")
+
+(defcustom pakistan-urdu-use-roman-digits
+ nil
+ "Whether urdu-custom input method should use roman digits."
+ :set #'pakistan--set-numeral-translations
+ :type 'boolean
+ :version "30.1")
+
+;;;; Sindhi Input Methods
+;;;;; Keyboard
+;; Layout taken from https://www.branah.com/sindhi
+(quail-define-package
+ "sindhi-keyboard" "Sindhi" "سِ" t
+ "Input method for Sindhi.
+Uses keyboard layout from https://www.branah.com/sindhi ."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?ق)
+ ("w" ?ص)
+ ("e" ?ي)
+ ("r" ?ر)
+ ("t" ?ت)
+ ("y" ?ٿ)
+ ("u" ?ع)
+ ("i" ?ڳ)
+ ("o" ?و)
+ ("p" ?پ)
+ ("a" ?ا)
+ ("s" ?س)
+ ("d" ?د)
+ ("f" ?ف)
+ ("g" ?گ)
+ ("h" ?ه)
+ ("j" ?ج)
+ ("k" ?ڪ)
+ ("l" ?ل)
+ ("z" ?ز)
+ ("x" ?خ)
+ ("c" ?ط)
+ ("v" ?ڀ)
+ ("b" ?ب)
+ ("n" ?ن)
+ ("m" ?م)
+ ("Q" ?َ)
+ ("W" ?ض)
+ ("E" ?ِ)
+ ("R" ?ڙ)
+ ("T" ?ٽ)
+ ("Y" ?ث)
+ ("U" ?غ)
+ ("I" ?ھ)
+ ("O" ?ُ)
+ ("P" ?ڦ)
+ ("A" ?آ)
+ ("S" ?ش)
+ ("D" ?ڊ)
+ ("F" ?ڦ)
+ ("G" ?ً)
+ ("H" ?ح)
+ ("J" ?ٍ)
+ ("K" ?ۡ)
+ ("L" ?:)
+ ("Z" ?ذ)
+ ("X" ?ّ)
+ ("C" ?ظ)
+ ("V" ?ء)
+ ("B" ?ٻ)
+ ("N" ?ڻ)
+ ("M" ?۾)
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?٦)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+ ("0" ?۰)
+ ("`" ?’)
+ ("-" ?ڏ)
+ ("=" ?ڌ)
+ ("~" ?‘)
+ ("@" ?ى)
+ ("#" ?ؔ)
+ ("$" ?ؒ)
+ ("%" ?٪)
+ ("^" ?ؓ)
+ ("&" ?۽)
+ ("*" ?ؤ)
+ ("(" ?\))
+ (")" ?\()
+ ("[" ?ڇ)
+ ("]" ?چ)
+ ("{" ?ڃ)
+ ("}" ?ڄ)
+ (";" ?ک)
+ ("'" ?ڱ)
+ ("\\" ?ڍ)
+ (":" ?؛)
+ ("|" ?ٺ)
+ ("," ?،)
+ ("/" ?ئ)
+ ("<" ?“)
+ (">" ?”)
+ ("?" ?؟))
+
+
+;;;; Pashto Input Methods
+;;;;; Keyboard
+(quail-define-package
+ "pashto-keyboard" "Pashto" "پ" t
+ "Input method for Pashto.
+Uses keyboard layout from https://www.branah.com/pashto ."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("q" ?ض)
+ ("w" ?ص)
+ ("e" ?ث)
+ ("r" ?ق)
+ ("t" ?ف)
+ ("y" ?غ)
+ ("u" ?ع)
+ ("i" ?ه)
+ ("o" ?خ)
+ ("p" ?ح)
+ ("a" ?ش)
+ ("s" ?س)
+ ("d" ?ی)
+ ("f" ?ب)
+ ("g" ?ل)
+ ("h" ?ا)
+ ("j" ?ت)
+ ("k" ?ن)
+ ("l" ?م)
+ ("z" ?ۍ)
+ ("x" ?ې)
+ ("c" ?ز)
+ ("v" ?ر)
+ ("b" ?ذ)
+ ("n" ?د)
+ ("m" ?ړ)
+ ("Q" ?ْ)
+ ("W" ?ٌ)
+ ("E" ?ٍ)
+ ("R" ?ً)
+ ("T" ?ُ)
+ ("Y" ?ِ)
+ ("U" ?َ)
+ ("I" ?ّ)
+ ("O" ?څ)
+ ("P" ?ځ)
+ ("A" ?ښ)
+ ("S" ?ﺉ)
+ ("D" ?ي)
+ ("F" ?پ)
+ ("G" ?أ)
+ ("H" ?آ)
+ ("J" ?ټ)
+ ("K" ?ڼ)
+ ("L" ?ة)
+ ("Z" ?ظ)
+ ("X" ?ط)
+ ("C" ?ژ)
+ ("V" ?ء)
+ ("B" ?)
+ ("N" ?ډ)
+ ("M" ?ؤ)
+ ("1" ?۱)
+ ("2" ?۲)
+ ("3" ?۳)
+ ("4" ?۴)
+ ("5" ?۵)
+ ("6" ?۶)
+ ("7" ?۷)
+ ("8" ?۸)
+ ("9" ?۹)
+ ("0" ?۰)
+ ("`" ?)
+ ("~" ?÷)
+ ("@" ?٬)
+ ("#" ?٫)
+ ("%" ?٪)
+ ("^" ?×)
+ ("&" ?«)
+ ("*" ?»)
+ ("_" ?ـ)
+ ("[" ?ج)
+ ("]" ?چ)
+ ("{" ?\[)
+ ("}" ?\])
+ (";" ?ک)
+ ("'" ?ګ)
+ ("\"" ?؛)
+ ("|" ?٭)
+ ("," ?و)
+ ("." ?ږ)
+ ("<" ?،)
+ (">" ?.)
+ ("?" ?؟))
+
+;;; End Matter
+(provide 'pakistan)
+;;; pakistan.el ends here
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 3800ea70ea4..8a571661e89 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -149,14 +149,14 @@ documentation of `unload-feature' for details.")
(save-current-buffer
(dolist (buffer (buffer-list))
(set-buffer buffer)
- (let ((proposed major-mode))
+ (let ((proposed (derived-mode-all-parents major-mode)))
;; Look for a predecessor mode not defined in the feature we're
processing
- (while (and proposed (rassq proposed unload-function-defs-list))
- (setq proposed (get proposed 'derived-mode-parent)))
- (unless (eq proposed major-mode)
+ (while (and proposed (rassq (car proposed) unload-function-defs-list))
+ (setq proposed (cdr proposed)))
+ (unless (eq (car proposed) major-mode)
;; Two cases: either proposed is nil, and we want to switch to
fundamental
;; mode, or proposed is not nil and not major-mode, and so we use it.
- (funcall (or proposed 'fundamental-mode)))))))
+ (funcall (or (car proposed) 'fundamental-mode)))))))
(defvar loadhist-unload-filename nil)
diff --git a/lisp/locate.el b/lisp/locate.el
index 63386e18ebb..caccf644c02 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -141,13 +141,11 @@ system, or of all files that you have access to. Consult
the
documentation of that program for the details about how it determines
which file names match SEARCH-STRING. (Those details vary highly with
the version.)"
- :type 'string
- :group 'locate)
+ :type 'string)
(defcustom locate-post-command-hook nil
"List of hook functions run after `locate' (see `run-hooks')."
- :type 'hook
- :group 'locate)
+ :type 'hook)
(defvar locate-history-list nil
"The history list used by the \\[locate] command.")
@@ -162,13 +160,11 @@ This function should take one argument, a string (the
name to find)
and return a list of strings. The first element of the list should be
the name of a command to be executed by a shell, the remaining elements
should be the arguments to that command (including the name to find)."
- :type 'function
- :group 'locate)
+ :type 'function)
(defcustom locate-buffer-name "*Locate*"
"Name of the buffer to show results from the \\[locate] command."
- :type 'string
- :group 'locate)
+ :type 'string)
(defcustom locate-fcodes-file nil
"File name for the database of file names used by `locate'.
@@ -179,20 +175,17 @@ Just setting this variable does not actually change the
database
that `locate' searches. The executive program that the Emacs
function `locate' uses, as given by the variables `locate-command'
or `locate-make-command-line', determines the database."
- :type '(choice (const :tag "None" nil) file)
- :group 'locate)
+ :type '(choice (const :tag "None" nil) file))
(defcustom locate-header-face nil
"Face used to highlight the locate header."
- :type '(choice (const :tag "None" nil) face)
- :group 'locate)
+ :type '(choice (const :tag "None" nil) face))
;;;###autoload
(defcustom locate-ls-subdir-switches (purecopy "-al")
"`ls' switches for inserting subdirectories in `*Locate*' buffers.
This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches."
:type 'string
- :group 'locate
:version "22.1")
(defcustom locate-update-when-revert nil
@@ -202,13 +195,11 @@ If non-nil, offer to update the locate database when
reverting that buffer.
option `locate-update-path'.)
If nil, reverting does not update the locate database."
:type 'boolean
- :group 'locate
:version "22.1")
(defcustom locate-update-command "updatedb"
"The executable program used to update the locate database."
- :type 'string
- :group 'locate)
+ :type 'string)
(defcustom locate-update-path "/"
"The default directory from where `locate-update-command' is called.
@@ -218,7 +209,6 @@ can be achieved by setting this option to \"/su::\" or
\"/sudo::\"
permissions are sufficient to run the command, you can set this
option to \"/\"."
:type 'string
- :group 'locate
:version "22.1")
(defcustom locate-prompt-for-command nil
@@ -227,13 +217,11 @@ Otherwise, that behavior is invoked via a prefix argument.
Setting this option non-nil actually inverts the meaning of a prefix arg;
that is, with a prefix arg, you get the default behavior."
- :group 'locate
:type 'boolean)
(defcustom locate-mode-hook nil
"List of hook functions run by `locate-mode' (see `run-mode-hooks')."
- :type 'hook
- :group 'locate)
+ :type 'hook)
;; Functions
@@ -371,17 +359,17 @@ except that FILTER is not optional."
(defvar locate-mode-map
(let ((map (copy-keymap dired-mode-map)))
;; Undefine Useless Dired Menu bars
- (define-key map [menu-bar Dired] 'undefined)
- (define-key map [menu-bar subdir] 'undefined)
- (define-key map [menu-bar mark executables] 'undefined)
- (define-key map [menu-bar mark directory] 'undefined)
- (define-key map [menu-bar mark directories] 'undefined)
- (define-key map [menu-bar mark symlinks] 'undefined)
- (define-key map [M-mouse-2] 'locate-mouse-view-file)
- (define-key map "\C-c\C-t" 'locate-tags)
- (define-key map "l" 'locate-do-redisplay)
- (define-key map "U" 'dired-unmark-all-files)
- (define-key map "V" 'locate-find-directory)
+ (define-key map [menu-bar Dired] #'undefined)
+ (define-key map [menu-bar subdir] #'undefined)
+ (define-key map [menu-bar mark executables] #'undefined)
+ (define-key map [menu-bar mark directory] #'undefined)
+ (define-key map [menu-bar mark directories] #'undefined)
+ (define-key map [menu-bar mark symlinks] #'undefined)
+ (define-key map [M-mouse-2] #'locate-mouse-view-file)
+ (define-key map "\C-c\C-t" #'locate-tags)
+ (define-key map "l" #'locate-do-redisplay)
+ (define-key map "U" #'dired-unmark-all-files)
+ (define-key map "V" #'locate-find-directory)
map)
"Local keymap for Locate mode buffers.")
@@ -486,7 +474,7 @@ do not work in subdirectories.
(setq-local revert-buffer-function #'locate-update)
(setq-local page-delimiter "\n\n"))
-(put 'locate-mode 'derived-mode-parent 'dired-mode)
+(derived-mode-add-parents 'locate-mode '(dired-mode special-mode))
(defun locate-do-setup (search-string)
(goto-char (point-min))
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index bebaad720db..409ef7165fe 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -509,7 +509,7 @@ Message buffer where you can explain more about the patch."
(list (read-string (format-prompt "This patch is about" guess)
nil nil guess)
file)))
- (switch-to-buffer "*Patch Help*")
+ (pop-to-buffer-same-window "*Patch Help*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert "Thank you for considering submitting a patch to the Emacs
project.\n\n"
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index caf54d40fc2..46906a3dc7d 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -679,6 +679,13 @@ for use at QPOS."
'completions-common-part)
qprefix))))
(qcompletion (concat qprefix qnew)))
+ ;; Some completion tables (including this one) pass
+ ;; along necessary information as text properties
+ ;; on the first character of the completion. Make
+ ;; sure the quoted completion has these properties
+ ;; too.
+ (add-text-properties 0 1 (text-properties-at 0 completion)
+ qcompletion)
;; Attach unquoted completion string, which is needed
;; to score the completion in `completion--flex-score'.
(put-text-property 0 1 'completion--unquoted
@@ -2407,9 +2414,14 @@ These include:
(base-prefix (buffer-substring (minibuffer--completion-prompt-end)
(+ start base-size)))
(base-suffix
- (if (eq (alist-get 'category (cdr md)) 'file)
- (buffer-substring (save-excursion (or (search-forward "/"
nil t) (point-max)))
- (point-max))
+ (if (or (eq (alist-get 'category (cdr md)) 'file)
+ completion-in-region-mode-predicate)
+ (buffer-substring
+ (save-excursion
+ (if completion-in-region-mode-predicate
+ (point)
+ (or (search-forward "/" nil t) (point-max))))
+ (point-max))
""))
(all-md (completion--metadata (buffer-substring-no-properties
start (point))
@@ -3528,8 +3540,13 @@ Like `internal-complete-buffer', but removes BUFFER from
the completion list."
(defun completion-emacs22-try-completion (string table pred point)
(let ((suffix (substring string point))
(completion (try-completion (substring string 0 point) table pred)))
- (if (not (stringp completion))
- completion
+ (cond
+ ((eq completion t)
+ (if (equal "" suffix)
+ t
+ (cons string point)))
+ ((not (stringp completion)) completion)
+ (t
;; Merge a trailing / in completion with a / after point.
;; We used to only do it for word completion, but it seems to make
;; sense for all completions.
@@ -3543,7 +3560,7 @@ Like `internal-complete-buffer', but removes BUFFER from
the completion list."
(eq ?/ (aref suffix 0)))
;; This leaves point after the / .
(setq suffix (substring suffix 1)))
- (cons (concat completion suffix) (length completion)))))
+ (cons (concat completion suffix) (length completion))))))
(defun completion-emacs22-all-completions (string table pred point)
(let ((beforepoint (substring string 0 point)))
@@ -3840,17 +3857,26 @@ details."
(funcall completion-lazy-hilit-fn (copy-sequence str))
str))
-(defun completion--hilit-from-re (string regexp)
- "Fontify STRING with `completions-common-part' using REGEXP."
- (let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
- (me (and md (match-end 0)))
- (from 0))
- (while md
- (add-face-text-property from (pop md) 'completions-common-part nil
string)
- (setq from (pop md)))
- (unless (or (not me) (= from me))
- (add-face-text-property from me 'completions-common-part nil string))
- string))
+(defun completion--hilit-from-re (string regexp &optional point-idx)
+ "Fontify STRING using REGEXP POINT-IDX.
+`completions-common-part' and `completions-first-difference' are
+used. POINT-IDX is the position of point in the presumed \"PCM\"
+pattern that was used to generate derive REGEXP from."
+(let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
+ (pos (if point-idx (match-beginning point-idx) (match-end 0)))
+ (me (and md (match-end 0)))
+ (from 0))
+ (while md
+ (add-face-text-property from (pop md) 'completions-common-part nil string)
+ (setq from (pop md)))
+ (if (> (length string) pos)
+ (add-face-text-property
+ pos (1+ pos)
+ 'completions-first-difference
+ nil string))
+ (unless (or (not me) (= from me))
+ (add-face-text-property from me 'completions-common-part nil string))
+ string))
(defun completion--flex-score-1 (md-groups match-end len)
"Compute matching score of completion.
@@ -3975,16 +4001,17 @@ see) for later lazy highlighting."
completion-lazy-hilit-fn nil)
(cond
((and completions (cl-loop for e in pattern thereis (stringp e)))
- (let* ((re (completion-pcm--pattern->regex pattern 'group)))
+ (let* ((re (completion-pcm--pattern->regex pattern 'group))
+ (point-idx (completion-pcm--pattern-point-idx pattern)))
(setq completion-pcm--regexp re)
(cond (completion-lazy-hilit
(setq completion-lazy-hilit-fn
- (lambda (str) (completion--hilit-from-re str re)))
+ (lambda (str) (completion--hilit-from-re str re point-idx)))
completions)
(t
(mapcar
(lambda (str)
- (completion--hilit-from-re (copy-sequence str) re))
+ (completion--hilit-from-re (copy-sequence str) re point-idx))
completions)))))
(t completions)))
@@ -4714,13 +4741,15 @@ instead of the default completion table."
history)
(user-error "No history available"))))
;; FIXME: Can we make it work for CRM?
- (completion-in-region
- (minibuffer--completion-prompt-end) (point-max)
- (lambda (string pred action)
- (if (eq action 'metadata)
- '(metadata (display-sort-function . identity)
- (cycle-sort-function . identity))
- (complete-with-action action completions string pred))))))
+ (let ((completion-in-region-mode-predicate
+ (lambda () (get-buffer-window "*Completions*" 0))))
+ (completion-in-region
+ (minibuffer--completion-prompt-end) (point-max)
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (display-sort-function . identity)
+ (cycle-sort-function . identity))
+ (complete-with-action action completions string pred)))))))
(defun minibuffer-complete-defaults ()
"Complete minibuffer defaults as far as possible.
@@ -4731,7 +4760,9 @@ instead of the completion table."
(functionp minibuffer-default-add-function))
(setq minibuffer-default-add-done t
minibuffer-default (funcall minibuffer-default-add-function)))
- (let ((completions (ensure-list minibuffer-default)))
+ (let ((completions (ensure-list minibuffer-default))
+ (completion-in-region-mode-predicate
+ (lambda () (get-buffer-window "*Completions*" 0))))
(completion-in-region
(minibuffer--completion-prompt-end) (point-max)
(lambda (string pred action)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3de4721ec77..e4d3ba8c74b 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -435,7 +435,7 @@ Emacs dired can't find files."
(defun tramp-adb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -450,17 +450,10 @@ Emacs dired can't find files."
(file-name-as-directory f)
f))
(with-current-buffer (tramp-get-buffer v)
- (delete-dups
- (append
- ;; On some file systems like "sdcard", "." and ".." are
- ;; not included. We fix this by `delete-dups'.
- '("." "..")
- (delq
- nil
- (mapcar
- (lambda (l)
- (and (not (string-match-p (rx bol (* blank) eol) l)) l))
- (split-string (buffer-string) "\n"))))))))))))
+ (mapcar
+ (lambda (l)
+ (and (not (string-match-p (rx bol (* blank) eol) l)) l))
+ (split-string (buffer-string) "\n" 'omit)))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 79eafc5c12e..587b9db067a 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -739,7 +739,7 @@ absolute file names."
(defun tramp-crypt-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(let* (completion-regexp-list
diff --git a/lisp/net/tramp-fuse.el b/lisp/net/tramp-fuse.el
index aadc64666a5..30516ce9ecc 100644
--- a/lisp/net/tramp-fuse.el
+++ b/lisp/net/tramp-fuse.el
@@ -102,22 +102,12 @@
(defun tramp-fuse-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (tramp-fuse-remove-hidden-files
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
+ (tramp-fuse-remove-hidden-files
(all-completions
filename
- (delete-dups
- (append
- (file-name-all-completions
- filename (tramp-fuse-local-file-name directory))
- ;; Some storage systems do not return "." and "..".
- (let (result)
- (dolist (item '(".." ".") result)
- (when (string-prefix-p filename item)
- (catch 'match
- (dolist (elt completion-regexp-list)
- (unless (string-match-p elt item) (throw 'match nil)))
- (setq result (cons (concat item "/") result))))))))))))
+ (file-name-all-completions
+ filename (tramp-fuse-local-file-name directory))))))
;; This function isn't used.
(defun tramp-fuse-handle-insert-directory
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 451c033a044..35778aca6d4 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1463,13 +1463,13 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(defun tramp-gvfs-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (unless (tramp-compat-string-search "/" filename)
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
+ (unless (tramp-compat-string-search "/" filename)
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (let ((result '("./" "../")))
+ (let (result)
;; Get a list of directories and files.
(dolist (item
(tramp-gvfs-get-directory-attributes directory)
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index c73c86a9110..f67d8a0ec2f 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -136,7 +136,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; Remove last element of `(exec-path)', which is `exec-directory'.
;; Use `path-separator' as it does eshell.
(setq eshell-path-env
- (if (file-remote-p default-directory)
+ (if (tramp-tramp-file-p default-directory)
(string-join (butlast (exec-path)) path-separator)
(getenv "PATH"))))
@@ -158,7 +158,7 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(defun tramp-recentf-exclude-predicate (name)
"Predicate to exclude a remote file name from recentf.
NAME must be equal to `tramp-current-connection'."
- (when (file-remote-p name)
+ (when (tramp-tramp-file-p name)
(tramp-file-name-equal-p
(tramp-dissect-file-name name) (car tramp-current-connection))))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 49acf8395c5..3b47dafcb46 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1848,60 +1848,60 @@ ID-FORMAT valid values are `string' and `integer'."
;; files.
(defun tramp-sh-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (with-parsed-tramp-file-name (expand-file-name directory) nil
- (when (and (not (tramp-compat-string-search "/" filename))
- (tramp-connectable-p v))
- (unless (tramp-compat-string-search "/" filename)
- (ignore-error file-missing
- (all-completions
- filename
- (with-tramp-file-property v localname "file-name-all-completions"
- (let (result)
- ;; Get a list of directories and files, including
- ;; reliably tagging the directories with a trailing "/".
- ;; Because I rock. --daniel@danann.net
- (if (tramp-get-remote-perl v)
- (progn
- (tramp-maybe-send-script
- v tramp-perl-file-name-all-completions
- "tramp_perl_file_name_all_completions")
- (setq result
- (tramp-send-command-and-read
- v (format "tramp_perl_file_name_all_completions %s"
- (tramp-shell-quote-argument localname))
- 'noerror))
- ;; Cached values.
- (dolist (elt result)
- (tramp-set-file-property
- v (cadr elt) "file-directory-p" (nth 2 elt))
- (tramp-set-file-property
- v (cadr elt) "file-exists-p" (nth 3 elt))
- (tramp-set-file-property
- v (cadr elt) "file-readable-p" (nth 4 elt)))
- ;; Result.
- (mapcar #'car result))
-
- ;; Do it with ls.
- (when (tramp-send-command-and-check
- v (format (concat
- "cd %s 2>&1 && %s -a 2>%s"
- " | while IFS= read f; do"
- " if %s -d \"$f\" 2>%s;"
- " then echo \"$f/\"; else echo \"$f\"; fi;"
- " done")
- (tramp-shell-quote-argument localname)
- (tramp-get-ls-command v)
- (tramp-get-remote-null-device v)
- (tramp-get-test-command v)
- (tramp-get-remote-null-device v)))
-
- ;; Now grab the output.
- (with-current-buffer (tramp-get-buffer v)
- (goto-char (point-max))
- (while (zerop (forward-line -1))
- (push
- (buffer-substring (point) (line-end-position)) result)))
- result))))))))))
+ (tramp-skeleton-file-name-all-completions filename directory
+ (with-parsed-tramp-file-name (expand-file-name directory) nil
+ (when (and (not (tramp-compat-string-search "/" filename))
+ (tramp-connectable-p v))
+ (unless (tramp-compat-string-search "/" filename)
+ (all-completions
+ filename
+ (with-tramp-file-property v localname "file-name-all-completions"
+ (let (result)
+ ;; Get a list of directories and files, including
+ ;; reliably tagging the directories with a trailing "/".
+ ;; Because I rock. --daniel@danann.net
+ (if (tramp-get-remote-perl v)
+ (progn
+ (tramp-maybe-send-script
+ v tramp-perl-file-name-all-completions
+ "tramp_perl_file_name_all_completions")
+ (setq result
+ (tramp-send-command-and-read
+ v (format "tramp_perl_file_name_all_completions %s"
+ (tramp-shell-quote-argument localname))
+ 'noerror))
+ ;; Cached values.
+ (dolist (elt result)
+ (tramp-set-file-property
+ v (cadr elt) "file-directory-p" (nth 2 elt))
+ (tramp-set-file-property
+ v (cadr elt) "file-exists-p" (nth 3 elt))
+ (tramp-set-file-property
+ v (cadr elt) "file-readable-p" (nth 4 elt)))
+ ;; Result.
+ (mapcar #'car result))
+
+ ;; Do it with ls.
+ (when (tramp-send-command-and-check
+ v (format (concat
+ "cd %s 2>&1 && %s -a 2>%s"
+ " | while IFS= read f; do"
+ " if %s -d \"$f\" 2>%s;"
+ " then echo \"$f/\"; else echo \"$f\"; fi;"
+ " done")
+ (tramp-shell-quote-argument localname)
+ (tramp-get-ls-command v)
+ (tramp-get-remote-null-device v)
+ (tramp-get-test-command v)
+ (tramp-get-remote-null-device v)))
+
+ ;; Now grab the output.
+ (with-current-buffer (tramp-get-buffer v)
+ (goto-char (point-max))
+ (while (zerop (forward-line -1))
+ (push
+ (buffer-substring (point) (line-end-position)) result)))
+ result))))))))))
;; cp, mv and ln
@@ -5540,7 +5540,7 @@ raises an error."
(unless noerror signal-hook-function)))
(read (current-buffer)))
;; Error handling.
- (when (search-forward-regexp (rx (not blank)) (line-end-position) t)
+ (when (search-forward-regexp (rx (not space)) (line-end-position) t)
(error nil)))
(error (unless noerror
(tramp-error
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index ac1b29f08cd..87fbb93e810 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -618,7 +618,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; with `jka-compr-handler', so we cannot trust its result as
;; indication for a remote file name.
(if-let ((tmpfile
- (and (file-remote-p filename) (file-local-copy filename))))
+ (and (tramp-tramp-file-p filename) (file-local-copy filename))))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
@@ -972,20 +972,19 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; files.
(defun tramp-smb-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(when (file-directory-p directory)
(with-parsed-tramp-file-name (expand-file-name directory) nil
(with-tramp-file-property v localname "file-name-all-completions"
- (delete-dups
- (mapcar
- (lambda (x)
- (list
- (if (tramp-compat-string-search "d" (nth 1 x))
- (file-name-as-directory (nth 0 x))
- (nth 0 x))))
- (tramp-smb-get-file-entries directory)))))))))
+ (mapcar
+ (lambda (x)
+ (list
+ (if (tramp-compat-string-search "d" (nth 1 x))
+ (file-name-as-directory (nth 0 x))
+ (nth 0 x))))
+ (tramp-smb-get-file-entries directory))))))))
(defun tramp-smb-handle-file-system-info (filename)
"Like `file-system-info' for Tramp files."
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index 40e438435fc..742b8128199 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -274,8 +274,8 @@ absolute file names."
(not (directory-name-p newname)))
(tramp-error v 'file-error "File is a directory %s" newname))
- (if (or (and (file-remote-p filename) (not t1))
- (and (file-remote-p newname) (not t2)))
+ (if (or (and (tramp-tramp-file-p filename) (not t1))
+ (and (tramp-tramp-file-p newname) (not t2)))
;; We cannot copy or rename directly.
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(if (eq op 'copy)
@@ -296,7 +296,7 @@ absolute file names."
;; When `newname' is local, we must change the ownership to
;; the local user.
- (unless (file-remote-p newname)
+ (unless (tramp-tramp-file-p newname)
(tramp-set-file-uid-gid
(concat (file-remote-p filename) newname)
(tramp-get-local-uid 'integer)
@@ -489,7 +489,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sudoedit-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for Tramp files."
- (ignore-error file-missing
+ (tramp-skeleton-file-name-all-completions filename directory
(all-completions
filename
(with-parsed-tramp-file-name (expand-file-name directory) nil
@@ -503,13 +503,11 @@ the result will be a local, non-Tramp, file name."
(if (ignore-errors (file-directory-p (expand-file-name f
directory)))
(file-name-as-directory f)
f))
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
- (split-string
- (tramp-get-buffer-string (tramp-get-connection-buffer v))
- "\n" 'omit)))))))))
+ (mapcar
+ (lambda (l) (and (not (string-match-p (rx bol (* blank) eol) l)) l))
+ (split-string
+ (tramp-get-buffer-string (tramp-get-connection-buffer v))
+ "\n" 'omit))))))))
(defun tramp-sudoedit-handle-file-readable-p (filename)
"Like `file-readable-p' for Tramp files."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 9cc319bef67..e19b8c78f8c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -2741,6 +2741,31 @@ not in completion mode."
(tramp-run-real-handler #'file-exists-p (list filename))))
+(defmacro tramp-skeleton-file-name-all-completions
+ (filename directory &rest body)
+ "Skeleton for `tramp-*-handle-filename-all-completions'.
+BODY is the backend specific code."
+ (declare (indent 2) (debug t))
+ `(ignore-error file-missing
+ (delete-dups (delq nil
+ (let* ((case-fold-search read-file-name-completion-ignore-case)
+ (result (progn ,@body)))
+ ;; Some storage systems do not return "." and "..".
+ (when (tramp-tramp-file-p ,directory)
+ (dolist (elt '(".." "."))
+ (when (string-prefix-p ,filename elt)
+ (setq result (cons (concat elt "/") result)))))
+ (if (consp completion-regexp-list)
+ ;; Discriminate over `completion-regexp-list'.
+ (mapcar
+ (lambda (x)
+ (when (stringp x)
+ (catch 'match
+ (dolist (elt completion-regexp-list x)
+ (unless (string-match-p elt x) (throw 'match nil))))))
+ result)
+ result))))))
+
(defvar tramp--last-hop-directory nil
"Tracks the directory from which to run login programs.")
@@ -2750,81 +2775,79 @@ not in completion mode."
;; completions.
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
- (let ((fullname
- (tramp-drop-volume-letter (expand-file-name filename directory)))
- (directory (tramp-drop-volume-letter directory))
- tramp--last-hop-directory hop result result1)
-
- ;; Suppress hop from completion.
- (when (string-match
- (rx
- (regexp tramp-prefix-regexp)
- (group (+ (regexp tramp-remote-file-name-spec-regexp)
- (regexp tramp-postfix-hop-regexp))))
- fullname)
- (setq hop (match-string 1 fullname)
- fullname (replace-match "" nil nil fullname 1)
- tramp--last-hop-directory
- (tramp-make-tramp-file-name (tramp-dissect-hop-name hop))))
-
- (let (;; When `tramp-syntax' is `simplified', we need a default method.
- (tramp-default-method
- (and (string-empty-p tramp-postfix-method-format)
- tramp-default-method))
- (tramp-default-method-alist
- (and (string-empty-p tramp-postfix-method-format)
- tramp-default-method-alist))
- tramp-default-user tramp-default-user-alist
- tramp-default-host tramp-default-host-alist)
-
- ;; Possible completion structures.
- (dolist (elt (tramp-completion-dissect-file-name fullname))
- (let* ((method (tramp-file-name-method elt))
- (user (tramp-file-name-user elt))
- (host (tramp-file-name-host elt))
- (localname (tramp-file-name-localname elt))
- (m (tramp-find-method method user host))
- all-user-hosts)
-
- (unless localname ;; Nothing to complete.
-
- (if (or user host)
-
- ;; Method dependent user / host combinations.
- (progn
- (mapc
- (lambda (x)
- (setq all-user-hosts
- (append all-user-hosts
- (funcall (nth 0 x) (nth 1 x)))))
- (tramp-get-completion-function m))
-
- (setq result
- (append result
- (mapcar
- (lambda (x)
- (tramp-get-completion-user-host
- method user host (nth 0 x) (nth 1 x)))
- (delq nil all-user-hosts)))))
-
- ;; Possible methods.
- (setq result
- (append result (tramp-get-completion-methods m hop)))))))
-
- ;; Unify list, add hop, remove nil elements.
- (dolist (elt result)
- (when elt
- (setq elt (replace-regexp-in-string
- tramp-prefix-regexp (concat tramp-prefix-format hop) elt))
- (push (substring elt (length directory)) result1)))
-
- ;; Complete local parts.
- (delete-dups
- (append
- result1
- (ignore-errors
- (tramp-run-real-handler
- #'file-name-all-completions (list filename directory))))))))
+ (tramp-skeleton-file-name-all-completions filename directory
+ (let ((fullname
+ (tramp-drop-volume-letter (expand-file-name filename directory)))
+ (directory (tramp-drop-volume-letter directory))
+ tramp--last-hop-directory hop result result1)
+
+ ;; Suppress hop from completion.
+ (when (string-match
+ (rx
+ (regexp tramp-prefix-regexp)
+ (group (+ (regexp tramp-remote-file-name-spec-regexp)
+ (regexp tramp-postfix-hop-regexp))))
+ fullname)
+ (setq hop (match-string 1 fullname)
+ fullname (replace-match "" nil nil fullname 1)
+ tramp--last-hop-directory
+ (tramp-make-tramp-file-name (tramp-dissect-hop-name hop))))
+
+ (let (;; When `tramp-syntax' is `simplified', we need a default method.
+ (tramp-default-method
+ (and (string-empty-p tramp-postfix-method-format)
+ tramp-default-method))
+ (tramp-default-method-alist
+ (and (string-empty-p tramp-postfix-method-format)
+ tramp-default-method-alist))
+ tramp-default-user tramp-default-user-alist
+ tramp-default-host tramp-default-host-alist)
+
+ ;; Possible completion structures.
+ (dolist (elt (tramp-completion-dissect-file-name fullname))
+ (let* ((method (tramp-file-name-method elt))
+ (user (tramp-file-name-user elt))
+ (host (tramp-file-name-host elt))
+ (localname (tramp-file-name-localname elt))
+ (m (tramp-find-method method user host))
+ all-user-hosts)
+
+ (unless localname ;; Nothing to complete.
+ (if (or user host)
+ ;; Method dependent user / host combinations.
+ (progn
+ (mapc
+ (lambda (x)
+ (setq all-user-hosts
+ (append all-user-hosts
+ (funcall (nth 0 x) (nth 1 x)))))
+ (tramp-get-completion-function m))
+
+ (setq result
+ (append result
+ (mapcar
+ (lambda (x)
+ (tramp-get-completion-user-host
+ method user host (nth 0 x) (nth 1 x)))
+ all-user-hosts))))
+
+ ;; Possible methods.
+ (setq result
+ (append result (tramp-get-completion-methods m hop)))))))
+
+ ;; Add hop.
+ (dolist (elt result)
+ (when elt
+ (setq elt (replace-regexp-in-string
+ tramp-prefix-regexp (concat tramp-prefix-format hop)
elt))
+ (push (substring elt (length directory)) result1)))
+
+ ;; Complete local parts.
+ (append
+ result1
+ (ignore-errors
+ (tramp-run-real-handler
+ #'file-name-all-completions (list filename directory))))))))
;; Method, host name and user name completion for a file.
(defun tramp-completion-handle-file-name-completion
@@ -3432,7 +3455,7 @@ BODY is the backend specific code."
"Apparent cycle of symbolic links for %s" ,filename))
;; If the resulting localname looks remote, we must quote
;; it for security reasons.
- (when (file-remote-p result)
+ (when (tramp-tramp-file-p result)
(setq result (file-name-quote result 'top)))
result)))))))
@@ -3572,7 +3595,7 @@ BODY is the backend specific code."
;; Lock file.
(when (and (not (auto-save-file-name-p
(file-name-nondirectory filename)))
- (file-remote-p lockname)
+ (tramp-tramp-file-p lockname)
(not file-locked))
(setq file-locked t)
;; `lock-file' exists since Emacs 28.1.
@@ -4102,7 +4125,7 @@ Let-bind it when necessary.")
(< numchase numchase-limit))
(setq numchase (1+ numchase)
result
- (if (file-remote-p symlink-target)
+ (if (tramp-tramp-file-p symlink-target)
(file-name-quote symlink-target 'top)
(tramp-drop-volume-letter
(expand-file-name
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index e69ce4f1d12..2df3396ee72 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1932,12 +1932,12 @@ buffer or nil if no such result exists."
(defun org-babel-result-names (&optional file)
"Return the names of results in FILE or the current buffer."
- (save-excursion
- (when file (find-file file)) (goto-char (point-min))
- (let ((case-fold-search t) names)
+ (with-current-buffer (if file (find-file-noselect file) (current-buffer))
+ (org-with-point-at 1
+ (let ((case-fold-search t) names)
(while (re-search-forward org-babel-result-w-name-regexp nil t)
(setq names (cons (match-string-no-properties 9) names)))
- names)))
+ names))))
;;;###autoload
(defun org-babel-next-src-block (&optional arg)
@@ -2358,7 +2358,7 @@ INFO may provide the values of these header arguments (in
the
using the argument supplied to specify the export block
or snippet type."
(cond ((stringp result)
- (setq result (org-no-properties result))
+ (setq result (substring-no-properties result))
(when (member "file" result-params)
(setq result
(org-babel-result-to-file
diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el
index 2c30a26056b..87e38e414ce 100644
--- a/lisp/org/ob-shell.el
+++ b/lisp/org/ob-shell.el
@@ -166,6 +166,11 @@ This function is called by `org-babel-execute-src-block'."
"Return a list of statements declaring the values as a generic variable."
(format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline)))
+(defun org-babel--variable-assignments:fish
+ (varname values &optional sep hline)
+ "Return a list of statements declaring the values as a fish variable."
+ (format "set %s %s" varname (org-babel-sh-var-to-sh values sep hline)))
+
(defun org-babel--variable-assignments:bash_array
(varname values &optional sep hline)
"Return a list of statements declaring the values as a bash array."
@@ -211,8 +216,11 @@ This function is called by `org-babel-execute-src-block'."
(if (string-suffix-p "bash" shell-file-name)
(org-babel--variable-assignments:bash
(car pair) (cdr pair) sep hline)
- (org-babel--variable-assignments:sh-generic
- (car pair) (cdr pair) sep hline)))
+ (if (string-suffix-p "fish" shell-file-name)
+ (org-babel--variable-assignments:fish
+ (car pair) (cdr pair) sep hline)
+ (org-babel--variable-assignments:sh-generic
+ (car pair) (cdr pair) sep hline))))
(org-babel--get-vars params))))
(defun org-babel-sh-var-to-sh (var &optional sep hline)
diff --git a/lisp/org/ol-info.el b/lisp/org/ol-info.el
index ad9e4a12bd7..350ccf5cc57 100644
--- a/lisp/org/ol-info.el
+++ b/lisp/org/ol-info.el
@@ -129,13 +129,13 @@ If LINK is not an info link then DESC is returned."
(defconst org-info-emacs-documents
'("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
- "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp"
- "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww"
- "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el"
- "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs"
- "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve"
- "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper"
- "widget" "wisent" "woman")
+ "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eglot" "eieio" "eintr"
+ "elisp" "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell"
+ "eudc" "eww" "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info"
+ "mairix-el" "message" "mh-e" "modus-themes" "newsticker" "nxml-mode"
"octave-mode"
+ "org" "pcl-cvs" "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic"
+ "ses" "sieve" "smtpmail" "speedbar" "srecode" "todo-mode" "tramp"
"transient"
+ "url" "use-package" "vhdl-mode" "vip" "viper" "vtable" "widget" "wisent"
"woman")
"List of Emacs documents available.
Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 38e81d9d713..670116304e6 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -6321,6 +6321,11 @@ specification like [h]h:mm."
(org-element-cache-map
(lambda (el)
(when (and (org-element-property :deadline el)
+ ;; Only consider active timestamp values.
+ (memq (org-element-property
+ :type
+ (org-element-property :deadline el))
+ '(diary active active-range))
(or (not with-hour)
(org-element-property
:hour-start
@@ -6662,6 +6667,11 @@ scheduled items with an hour specification like [h]h:mm."
(org-element-cache-map
(lambda (el)
(when (and (org-element-property :scheduled el)
+ ;; Only consider active timestamp values.
+ (memq (org-element-property
+ :type
+ (org-element-property :scheduled el))
+ '(diary active active-range))
(or (not with-hour)
(org-element-property
:hour-start
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index cfef38581c6..e5b0fbcf2a9 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of Org.
Inserted by installing Org mode or when a release is made."
- (let ((org-release "9.6.10"))
+ (let ((org-release "9.6.11"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of Org mode.
Inserted by installing Org or when a release is made."
- (let ((org-git-version "release_9.6.10"))
+ (let ((org-git-version "release_9.6.11"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 49f62d0f43b..34c572a3f57 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -9,7 +9,7 @@
;; URL: https://orgmode.org
;; Package-Requires: ((emacs "26.1"))
-;; Version: 9.6.10
+;; Version: 9.6.11
;; This file is part of GNU Emacs.
;;
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 94cc5a22881..e9cc0ed8fc7 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -264,13 +264,17 @@ See `org-export-inline-image-p' for more information about
rules.")
(defconst org-export-ignored-local-variables
- '( org-font-lock-keywords org-element--cache-change-tic
- org-element--cache-change-tic org-element--cache-size
- org-element--headline-cache-size
- org-element--cache-sync-keys-value
- org-element--cache-change-warning org-element--headline-cache
- org-element--cache org-element--cache-sync-keys
- org-element--cache-sync-requests org-element--cache-sync-timer)
+ '( org-font-lock-keywords
+ org-element--cache org-element--cache-size
+ org-element--headline-cache org-element--headline-cache-size
+ org-element--cache-hash-left org-element--cache-hash-right
+ org-element--cache-sync-requests org-element--cache-sync-timer
+ org-element--cache-sync-keys-value org-element--cache-change-tic
+ org-element--cache-last-buffer-size
+ org-element--cache-diagnostics-ring
+ org-element--cache-diagnostics-ring-size
+ org-element--cache-gapless
+ org-element--cache-change-warning)
"List of variables not copied through upon buffer duplication.
Export process takes place on a copy of the original buffer.
When this copy is created, all Org related local variables not in
@@ -6691,6 +6695,11 @@ or FILE."
',ext-plist)))
(with-temp-buffer
(insert output)
+ ;; Ensure final newline. This is what was done
+ ;; historically, when we used `write-file'.
+ ;; Note that adding a newline is only safe for
+ ;; non-binary data.
+ (unless (bolp) (insert "\n"))
(let ((coding-system-for-write ',encoding))
(write-region (point-min) (point-max) ,file)))
(or (ignore-errors (funcall ',post-process ,file)) ,file)))
@@ -6698,6 +6707,11 @@ or FILE."
backend subtreep visible-only body-only ext-plist)))
(with-temp-buffer
(insert output)
+ ;; Ensure final newline. This is what was done
+ ;; historically, when we used `write-file'.
+ ;; Note that adding a newline is only safe for
+ ;; non-binary data.
+ (unless (bolp) (insert "\n"))
(let ((coding-system-for-write encoding))
(write-region (point-min) (point-max) file)))
(when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p
output))
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index bc280284588..0afed5276f5 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -35,6 +35,8 @@
;;; Code:
+(require 'thingatpt)
+
(defgroup bug-reference nil
"Hyperlinking references to bug reports."
;; Somewhat arbitrary, by analogy with eg goto-address.
@@ -465,10 +467,10 @@ and set it if applicable."
(defun bug-reference--try-setup-gnus-article ()
(when (and bug-reference-mode ;; Only if enabled in article buffers.
(derived-mode-p
- 'gnus-article-mode
- ;; Apparently, gnus-article-prepare-hook is run in the
- ;; summary buffer...
- 'gnus-summary-mode)
+ '(gnus-article-mode
+ ;; Apparently, `gnus-article-prepare-hook' is run in the
+ ;; summary buffer...
+ gnus-summary-mode))
gnus-article-buffer
gnus-original-article-buffer
(buffer-live-p (get-buffer gnus-article-buffer))
@@ -654,17 +656,31 @@ have been run, the auto-setup is inhibited.")
(run-hook-with-args-until-success
'bug-reference-auto-setup-functions)))))
-;;;###autoload
-(define-minor-mode bug-reference-mode
- "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
- :after-hook (bug-reference--run-auto-setup)
- (if bug-reference-mode
- (jit-lock-register #'bug-reference-fontify)
+(defun bug-reference--url-at-point ()
+ "`thing-at-point' provider function."
+ (get-char-property (point) 'bug-reference-url))
+
+(defun bug-reference--init (enable)
+ (if enable
+ (progn
+ (jit-lock-register #'bug-reference-fontify)
+ (setq-local thing-at-point-provider-alist
+ (append thing-at-point-provider-alist
+ '((url . bug-reference--url-at-point)))))
(jit-lock-unregister #'bug-reference-fontify)
+ (setq thing-at-point-provider-alist
+ (delete '((url . bug-reference--url-at-point))
+ thing-at-point-provider-alist))
(save-restriction
(widen)
(bug-reference-unfontify (point-min) (point-max)))))
+;;;###autoload
+(define-minor-mode bug-reference-mode
+ "Toggle hyperlinking bug references in the buffer (Bug Reference mode)."
+ :after-hook (bug-reference--run-auto-setup)
+ (bug-reference--init bug-reference-mode))
+
(defun bug-reference-mode-force-auto-setup ()
"Enable `bug-reference-mode' and force auto-setup.
Enabling `bug-reference-mode' runs its auto-setup only if
@@ -681,12 +697,7 @@ same buffer is re-used for different contexts."
(define-minor-mode bug-reference-prog-mode
"Like `bug-reference-mode', but only buttonize in comments and strings."
:after-hook (bug-reference--run-auto-setup)
- (if bug-reference-prog-mode
- (jit-lock-register #'bug-reference-fontify)
- (jit-lock-unregister #'bug-reference-fontify)
- (save-restriction
- (widen)
- (bug-reference-unfontify (point-min) (point-max)))))
+ (bug-reference--init bug-reference-prog-mode))
(provide 'bug-reference)
;;; bug-reference.el ends here
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index 70717a90caa..a56ce26fc79 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -135,7 +135,7 @@ symbol."
res)
(let ((buffer (car buffers)))
(with-current-buffer buffer
- (if (derived-mode-p 'c-ts-mode 'c++-ts-mode)
+ (if (derived-mode-p '(c-ts-mode c++-ts-mode))
(loop (append res (list buffer)) (cdr buffers))
(loop res (cdr buffers))))))))
@@ -193,7 +193,7 @@ in this Emacs session."
To set the default indent style globally, use
`c-ts-mode-set-global-style'."
(interactive (list (c-ts-mode--prompt-for-style)))
- (if (not (derived-mode-p 'c-ts-mode 'c++-ts-mode))
+ (if (not (derived-mode-p '(c-ts-mode c++-ts-mode)))
(user-error "The current buffer is not in `c-ts-mode' nor `c++-ts-mode'")
(setq-local c-ts-mode-indent-style style)
(setq treesit-simple-indent-rules
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index f5e0d21108f..018a194ac14 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -9440,37 +9440,47 @@ multi-line strings (but not C++, for example)."
(or c-promote-possible-types (eq res t)))
(c-record-type-id (cons (match-beginning 1) (match-end 1))))
- (if (and c-opt-type-component-key
+ (cond
+ ((and c-opt-type-component-key
(save-match-data
(looking-at c-opt-type-component-key)))
;; There might be more keywords for the type.
- (let (safe-pos)
- (c-forward-keyword-clause 1 t)
- (while (progn
- (setq safe-pos (point))
- (c-forward-syntactic-ws)
- (looking-at c-opt-type-component-key))
- (when (and c-record-type-identifiers
- (looking-at c-primitive-type-key))
- (c-record-type-id (cons (match-beginning 1)
- (match-end 1))))
- (c-forward-keyword-clause 1 t))
- (if (looking-at c-primitive-type-key)
- (progn
- (when c-record-type-identifiers
- (c-record-type-id (cons (match-beginning 1)
- (match-end 1))))
- (c-forward-keyword-clause 1 t)
- (setq res t))
- (goto-char safe-pos)
- (setq res 'prefix))
- (setq pos (point)))
- (if (save-match-data (c-forward-keyword-clause 1 t))
- (setq pos (point))
- (if pos
- (goto-char pos)
- (goto-char (match-end 1))
- (setq pos (point)))))
+ (let (safe-pos)
+ (c-forward-keyword-clause 1 t)
+ (while (progn
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)
+ (looking-at c-opt-type-component-key))
+ (when (and c-record-type-identifiers
+ (looking-at c-primitive-type-key))
+ (c-record-type-id (cons (match-beginning 1)
+ (match-end 1))))
+ (c-forward-keyword-clause 1 t))
+ (if (looking-at c-primitive-type-key)
+ (progn
+ (when c-record-type-identifiers
+ (c-record-type-id (cons (match-beginning 1)
+ (match-end 1))))
+ (c-forward-keyword-clause 1 t)
+ (setq res t)
+ (while (progn
+ (setq safe-pos (point))
+ (c-forward-syntactic-ws)
+ (looking-at c-opt-type-component-key))
+ (c-forward-keyword-clause 1 t)))
+ (goto-char safe-pos)
+ (setq res 'prefix))
+ (setq pos (point))))
+ ((save-match-data (c-forward-keyword-clause 1 t))
+ (while (progn
+ (setq pos (point))
+ (c-forward-syntactic-ws)
+ (and c-opt-type-component-key
+ (looking-at c-opt-type-component-key)))
+ (c-forward-keyword-clause 1 t)))
+ (pos (goto-char pos))
+ (t (goto-char (match-end 1))
+ (setq pos (point))))
(c-forward-syntactic-ws))
((and (eq name-res t)
@@ -12617,31 +12627,27 @@ comment at the start of cc-engine.el for more info."
(let ((open-brace (point)) kwd-start first-specifier-pos)
(c-syntactic-skip-backward c-block-prefix-charset limit t)
- (when (and c-recognize-<>-arglists
- (eq (char-before) ?>))
- ;; Could be at the end of a template arglist.
- (let ((c-parse-and-markup-<>-arglists t))
- (while (and
- (c-backward-<>-arglist nil limit)
- (progn
- (c-syntactic-skip-backward c-block-prefix-charset limit t)
- (eq (char-before) ?>))))))
-
- ;; Skip back over noise clauses.
- (while (and
- c-opt-cpp-prefix
- (eq (char-before) ?\))
- (let ((after-paren (point)))
- (if (and (c-go-list-backward)
- (progn (c-backward-syntactic-ws)
- (c-simple-skip-symbol-backward))
- (or (looking-at c-paren-nontype-key)
- (looking-at c-noise-macro-with-parens-name-re)))
- (progn
- (c-syntactic-skip-backward c-block-prefix-charset limit t)
- t)
- (goto-char after-paren)
- nil))))
+ (while
+ (or
+ ;; Could be after a template arglist....
+ (and c-recognize-<>-arglists
+ (eq (char-before) ?>)
+ (let ((c-parse-and-markup-<>-arglists t))
+ (c-backward-<>-arglist nil limit)))
+ ;; .... or after a noise clause with parens.
+ (and c-opt-cpp-prefix
+ (let ((after-paren (point)))
+ (if (eq (char-before) ?\))
+ (and
+ (c-go-list-backward)
+ (eq (char-after) ?\()
+ (progn (c-backward-syntactic-ws)
+ (c-simple-skip-symbol-backward))
+ (or (looking-at c-paren-nontype-key) ; e.g. __attribute__
+ (looking-at c-noise-macro-with-parens-name-re)))
+ (goto-char after-paren)
+ nil))))
+ (c-syntactic-skip-backward c-block-prefix-charset limit t))
;; Note: Can't get bogus hits inside template arglists below since they
;; have gotten paren syntax above.
@@ -12651,10 +12657,18 @@ comment at the start of cc-engine.el for more info."
;; The `c-decl-block-key' search continues from there since
;; we know it can't match earlier.
(if goto-start
- (when (c-syntactic-re-search-forward c-symbol-start
- open-brace t t)
- (goto-char (setq first-specifier-pos (match-beginning 0)))
- t)
+ (progn
+ (while
+ (and
+ (c-syntactic-re-search-forward c-symbol-start
+ open-brace t t)
+ (goto-char (match-beginning 0))
+ (if (or (looking-at c-noise-macro-name-re)
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause)
+ (setq first-specifier-pos (match-beginning 0))
+ nil)))
+ first-specifier-pos)
t)
(cond
@@ -12723,34 +12737,39 @@ comment at the start of cc-engine.el for more info."
(goto-char first-specifier-pos)
(while (< (point) kwd-start)
- (if (looking-at c-symbol-key)
- ;; Accept any plain symbol token on the ground that
- ;; it's a specifier masked through a macro (just
- ;; like `c-forward-decl-or-cast-1' skip forward over
- ;; such tokens).
- ;;
- ;; Could be more restrictive wrt invalid keywords,
- ;; but that'd only occur in invalid code so there's
- ;; no use spending effort on it.
- (let ((end (match-end 0))
- (kwd-sym (c-keyword-sym (match-string 0))))
- (unless
- (and kwd-sym
- ;; Moving over a protection kwd and the following
- ;; ":" (in C++ Mode) to the next token could take
- ;; us all the way up to `kwd-start', leaving us
- ;; no chance to update `first-specifier-pos'.
- (not (c-keyword-member kwd-sym 'c-protection-kwds))
- (c-forward-keyword-clause 0))
- (goto-char end)
- (c-forward-syntactic-ws)))
-
+ (cond
+ ((or (looking-at c-noise-macro-name-re)
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
+ ((looking-at c-symbol-key)
+ ;; Accept any plain symbol token on the ground that
+ ;; it's a specifier masked through a macro (just
+ ;; like `c-forward-decl-or-cast-1' skips forward over
+ ;; such tokens).
+ ;;
+ ;; Could be more restrictive wrt invalid keywords,
+ ;; but that'd only occur in invalid code so there's
+ ;; no use spending effort on it.
+ (let ((end (match-end 0))
+ (kwd-sym (c-keyword-sym (match-string 0))))
+ (unless
+ (and kwd-sym
+ ;; Moving over a protection kwd and the following
+ ;; ":" (in C++ Mode) to the next token could take
+ ;; us all the way up to `kwd-start', leaving us
+ ;; no chance to update `first-specifier-pos'.
+ (not (c-keyword-member kwd-sym 'c-protection-kwds))
+ (c-forward-keyword-clause 0))
+ (goto-char end)
+ (c-forward-syntactic-ws))))
+
+ ((c-syntactic-re-search-forward c-symbol-start
+ kwd-start 'move t)
;; Can't parse a declaration preamble and is still
;; before `kwd-start'. That means `first-specifier-pos'
;; was in some earlier construct. Search again.
- (if (c-syntactic-re-search-forward c-symbol-start
- kwd-start 'move t)
- (goto-char (setq first-specifier-pos (match-beginning 0)))
+ (goto-char (setq first-specifier-pos (match-beginning 0))))
+ (t
;; Got no preamble before the block declaration keyword.
(setq first-specifier-pos kwd-start))))
@@ -14165,7 +14184,8 @@ comment at the start of cc-engine.el for more info."
(defun c-add-class-syntax (symbol
containing-decl-open
containing-decl-start
- containing-decl-kwd)
+ containing-decl-kwd
+ &rest args)
;; The inclass and class-close syntactic symbols are added in
;; several places and some work is needed to fix everything.
;; Therefore it's collected here.
@@ -14180,7 +14200,7 @@ comment at the start of cc-engine.el for more info."
;; Ought to use `c-add-stmt-syntax' instead of backing up to boi
;; here, but we have to do like this for compatibility.
(back-to-indentation)
- (c-add-syntax symbol (point))
+ (apply #'c-add-syntax symbol (point) args)
(if (and (c-keyword-member containing-decl-kwd
'c-inexpr-class-kwds)
(/= containing-decl-start (c-point 'boi containing-decl-start)))
@@ -14214,9 +14234,10 @@ comment at the start of cc-engine.el for more info."
;; CASE B.1: class-open
((save-excursion
(and (eq (char-after) ?{)
- (c-looking-at-decl-block t)
+ (setq placeholder (c-looking-at-decl-block t))
(setq beg-of-same-or-containing-stmt (point))))
- (c-add-syntax 'class-open beg-of-same-or-containing-stmt))
+ (c-add-syntax 'class-open beg-of-same-or-containing-stmt
+ (c-point 'boi placeholder)))
;; CASE B.2: brace-list-open
((or (consp special-brace-list)
@@ -14711,7 +14732,10 @@ comment at the start of cc-engine.el for more info."
'lambda-intro-cont)))
(goto-char (cdr placeholder))
(back-to-indentation)
- (c-add-stmt-syntax tmpsymbol nil t
+ (c-add-stmt-syntax tmpsymbol
+ (and (eq tmpsymbol 'class-open)
+ (list (point)))
+ t
(c-most-enclosing-brace state-cache (point))
paren-state)
(unless (eq (point) (cdr placeholder))
@@ -14754,9 +14778,10 @@ comment at the start of cc-engine.el for more info."
(goto-char indent-point)
(skip-chars-forward " \t")
(and (eq (char-after) ?{)
- (c-looking-at-decl-block t)
+ (setq tmp-pos (c-looking-at-decl-block t))
(setq placeholder (point))))
- (c-add-syntax 'class-open placeholder))
+ (c-add-syntax 'class-open placeholder
+ (c-point 'boi tmp-pos)))
;; CASE 5A.3: brace list open
((save-excursion
@@ -15154,10 +15179,14 @@ comment at the start of cc-engine.el for more info."
((and containing-sexp
(eq char-after-ip ?})
(eq containing-decl-open containing-sexp))
+ (save-excursion
+ (goto-char containing-decl-open)
+ (setq tmp-pos (c-looking-at-decl-block t)))
(c-add-class-syntax 'class-close
containing-decl-open
containing-decl-start
- containing-decl-kwd))
+ containing-decl-kwd
+ (c-point 'boi tmp-pos)))
;; CASE 5H: we could be looking at subsequent knr-argdecls
((and c-recognize-knr-p
diff --git a/lisp/progmodes/cmake-ts-mode.el b/lisp/progmodes/cmake-ts-mode.el
index 53d471c381a..8fcdcaddc7b 100644
--- a/lisp/progmodes/cmake-ts-mode.el
+++ b/lisp/progmodes/cmake-ts-mode.el
@@ -63,7 +63,15 @@
((parent-is "foreach_loop") parent-bol cmake-ts-mode-indent-offset)
((parent-is "function_def") parent-bol cmake-ts-mode-indent-offset)
((parent-is "if_condition") parent-bol cmake-ts-mode-indent-offset)
- ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset)))
+ ((parent-is "normal_command") parent-bol cmake-ts-mode-indent-offset)
+ ;;; Release v0.4.0 wraps arguments in an argument_list node.
+ ,@(ignore-errors
+ (treesit-query-capture 'cmake '((argument_list) @capture))
+ `(((parent-is "argument_list") grand-parent
cmake-ts-mode-indent-offset)))
+ ;;; Release v0.3.0 wraps the body of commands into a body node.
+ ,@(ignore-errors
+ (treesit-query-capture 'cmake '((body) @capture))
+ `(((parent-is "body") grand-parent cmake-ts-mode-indent-offset)))))
"Tree-sitter indent rules for `cmake-ts-mode'.")
(defvar cmake-ts-mode--constants
@@ -89,8 +97,8 @@
"CMake if conditions for tree-sitter font-locking.")
(defun cmake-ts-mode--font-lock-compatibility-fe9b5e0 ()
- "Indent rules helper, to handle different releases of tree-sitter-cmake.
-Check if a node type is available, then return the right indent rules."
+ "Font lock helper, to handle different releases of tree-sitter-cmake.
+Check if a node type is available, then return the right font lock rules."
;; handle commit fe9b5e0
(condition-case nil
(progn (treesit-query-capture 'cmake '((argument_list) @capture))
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 5b3395b77d2..ab624a08646 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -6641,7 +6641,7 @@ side-effect of memorizing only. Examples in
`cperl-style-examples'."
(defun cperl-info-on-current-command ()
(declare (obsolete cperl-perldoc "30.1"))
(interactive)
- (cperl-info-on-command (cperl-word-at-point)))
+ (cperl-perldoc (cperl-word-at-point)))
(defun cperl-imenu-info-imenu-search ()
(declare (obsolete nil "30.1"))
@@ -6660,32 +6660,9 @@ side-effect of memorizing only. Examples in
`cperl-style-examples'."
(defun cperl-imenu-on-info ()
(declare (obsolete nil "30.1"))
(interactive)
- (require 'imenu)
- (let* ((buffer (current-buffer))
- imenu-create-index-function
- imenu-prev-index-position-function
- imenu-extract-index-name-function
- (index-item (save-restriction
- (save-window-excursion
- (set-buffer (cperl-info-buffer nil))
- (setq imenu-create-index-function
- 'imenu-default-create-index-function
- imenu-prev-index-position-function
- #'cperl-imenu-info-imenu-search
- imenu-extract-index-name-function
- #'cperl-imenu-info-imenu-name)
- (imenu-choose-buffer-index)))))
- (and index-item
- (progn
- (push-mark)
- (pop-to-buffer "*info-perl*")
- (cond
- ((markerp (cdr index-item))
- (goto-char (marker-position (cdr index-item))))
- (t
- (goto-char (cdr index-item))))
- (set-window-start (selected-window) (point))
- (pop-to-buffer buffer)))))
+ (message
+ (concat "The info file `perl' is no longer available.\n"
+ "Consider installing the perl-doc package from GNU ELPA.")))
(defun cperl-lineup (beg end &optional step minshift)
"Lineup construction in a region.
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 816f6952d2e..48ea33c3ee1 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -221,7 +221,11 @@ chosen (interactively or automatically)."
. ,(eglot-alternatives
'(("vscode-json-language-server" "--stdio")
("vscode-json-languageserver" "--stdio")
("json-languageserver" "--stdio"))))
- ((js-mode js-ts-mode tsx-ts-mode
typescript-ts-mode typescript-mode)
+ (((js-mode :language-id "javascript")
+ (js-ts-mode :language-id "javascript")
+ (tsx-ts-mode :language-id "typescriptreact")
+ (typescript-ts-mode :language-id
"typescript")
+ (typescript-mode :language-id "typescript"))
. ("typescript-language-server" "--stdio"))
((bash-ts-mode sh-mode) .
("bash-language-server" "start"))
((php-mode phps-mode)
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index 05edb4159a1..c687ed9d06b 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -74,6 +74,18 @@
:safe 'integerp
:group 'elixir-ts)
+;; 'define-derived-mode' doesn't expose the generated mode hook
+;; variable to Custom, because we are not smart enough to provide the
+;; ':options' for hook variables. Also, some packages modify hook
+;; variables. The below is done because users of this mode explicitly
+;; requested the hook to be customizable via Custom.
+(defcustom elixir-ts-mode-hook nil
+ "Hook run after entering `elixir-ts-mode'."
+ :type 'hook
+ :options '(eglot-ensure)
+ :group 'elixir-ts
+ :version "30.1")
+
(defface elixir-ts-font-comment-doc-identifier-face
'((t (:inherit font-lock-doc-face)))
"Face used for @comment.doc tags in Elixir files.")
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 3afdc59a67e..7ae4bcea1e1 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -1006,9 +1006,10 @@ detailed description of this mode.
(gud-def gud-pp
(gud-call
(concat
- "pp " (if (eq (buffer-local-value
- 'major-mode (window-buffer)) 'speedbar-mode)
- (gdb-find-watch-expression) "%e")) arg)
+ "pp " (if (eq (buffer-local-value 'major-mode (window-buffer))
+ 'speedbar-mode)
+ (gdb-find-watch-expression) "%e"))
+ arg)
nil "Print the Emacs s-expression.")
(define-key gud-minor-mode-map [left-margin mouse-1]
@@ -4586,7 +4587,8 @@ left-to-right display order of the properties."
(gdb-set-window-buffer
(gdb-get-buffer-create
'gdb-registers-buffer
- gdb-thread-number) t)))
+ gdb-thread-number)
+ t)))
map))
(define-derived-mode gdb-locals-mode gdb-parent-mode "Locals"
@@ -4706,7 +4708,8 @@ executes FUNCTION."
(gdb-set-window-buffer
(gdb-get-buffer-create
'gdb-locals-buffer
- gdb-thread-number) t)))
+ gdb-thread-number)
+ t)))
(define-key map "f" #'gdb-registers-toggle-filter)
map))
@@ -5106,7 +5109,7 @@ Function buffers are locals buffer, registers buffer,
etc, but
not including main command buffer (the one where you type GDB
commands) or source buffers (that display program source code)."
(with-current-buffer buffer
- (derived-mode-p 'gdb-parent-mode 'gdb-inferior-io-mode)))
+ (derived-mode-p '(gdb-parent-mode gdb-inferior-io-mode))))
(defun gdb--buffer-type (buffer)
"Return the type of BUFFER if it is a function buffer.
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index d9eccacc48b..f60cc9372eb 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -6892,7 +6892,7 @@ If these don't exist, a letter in the string is
automatically selected."
;; Display prompt and wait for quick reply
(message "%s[%s]" prompt
(mapconcat (lambda(x) (char-to-string (car x)))
- keys-alist ""))
+ keys-alist))
(if (sit-for delay)
;; No quick reply: Show help
(save-window-excursion
@@ -7958,7 +7958,7 @@ demand _EXTRA in the keyword list."
;; If this is the OBJ_NEW function, try to figure out the class and use
;; the keywords from the corresponding INIT method.
(if (and (equal (upcase name) "OBJ_NEW")
- (derived-mode-p 'idlwave-mode 'idlwave-shell-mode))
+ (derived-mode-p '(idlwave-mode idlwave-shell-mode)))
(let* ((bos (save-excursion (idlwave-beginning-of-statement) (point)))
(string (buffer-substring bos (point)))
(case-fold-search t)
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 2193779b759..a910d759c83 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -148,10 +148,6 @@
:feature 'delimiter
'(["," ";"] @font-lock-delimiter-face)
- :language 'lua
- :feature 'escape
- '((escape_sequence) @font-lock-escape-face)
-
:language 'lua
:feature 'constant
'((variable_list
@@ -213,6 +209,11 @@
: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
@@ -506,17 +507,18 @@ Calls REPORT-FN directly."
(group (0+ nonl))
eol))
nil t)
- for line = (string-to-number (match-string 1))
- for beg = (string-to-number (match-string 2))
- for end = (string-to-number (match-string 3))
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string
1))
+ (string-to-number (match-string
2)))
for msg = (match-string 4)
for type = (if (string-match "^(W" msg)
:warning
:error)
when (and beg end)
collect (flymake-make-diagnostic source
- (cons line beg)
- (cons line (1+
end))
+ beg
+ end
type
msg)
into diags
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 95db9d0ef4c..bdf8aab003b 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1721,13 +1721,12 @@ With some possible metadata (to be decided).")
(current-buffer)))
(write-region nil nil filename nil 'silent))))
-;;;###autoload
-(defun project-remember-project (pr &optional no-write)
- "Add project PR to the front of the project list.
+(defun project--remember-dir (root &optional no-write)
+ "Add project root ROOT to the front of the project list.
Save the result in `project-list-file' if the list of projects
has changed, and NO-WRITE is nil."
(project--ensure-read-project-list)
- (let ((dir (abbreviate-file-name (project-root pr))))
+ (let ((dir (abbreviate-file-name root)))
(unless (equal (caar project--list) dir)
(dolist (ent project--list)
(when (equal dir (car ent))
@@ -1736,6 +1735,13 @@ has changed, and NO-WRITE is nil."
(unless no-write
(project--write-project-list)))))
+;;;###autoload
+(defun project-remember-project (pr &optional no-write)
+ "Add project PR to the front of the project list.
+Save the result in `project-list-file' if the list of projects
+has changed, and NO-WRITE is nil."
+ (project--remember-dir (project-root pr) no-write))
+
(defun project--remove-from-project-list (project-root report-message)
"Remove directory PROJECT-ROOT of a missing project from the project list.
If the directory was in the list before the removal, save the
@@ -1757,6 +1763,8 @@ the project list."
(project--remove-from-project-list
project-root "Project `%s' removed from known projects"))
+(defvar project--dir-history)
+
(defun project-prompt-project-dir ()
"Prompt the user for a directory that is one of the known project roots.
The project is chosen among projects known from the project list,
@@ -1769,27 +1777,37 @@ It's also possible to enter an arbitrary directory not
in the list."
;; completion style).
(project--file-completion-table
(append project--list `(,dir-choice))))
+ (project--dir-history (project-known-project-roots))
(pr-dir ""))
(while (equal pr-dir "")
;; If the user simply pressed RET, do this again until they don't.
- (setq pr-dir (completing-read "Select project: " choices nil t)))
+ (setq pr-dir
+ (let (history-add-new-input)
+ (completing-read "Select project: " choices nil t nil
'project--dir-history))))
(if (equal pr-dir dir-choice)
(read-directory-name "Select directory: " default-directory nil t)
pr-dir)))
+(defvar project--name-history)
+
(defun project-prompt-project-name ()
"Prompt the user for a project, by name, that is one of the known project
roots.
The project is chosen among projects known from the project list,
see `project-list-file'.
It's also possible to enter an arbitrary directory not in the list."
(let* ((dir-choice "... (choose a dir)")
+ project--name-history
(choices
(let (ret)
- (dolist (dir (project-known-project-roots))
+ ;; Iterate in reverse order so project--name-history is in
+ ;; the correct order.
+ (dolist (dir (reverse (project-known-project-roots)))
;; we filter out directories that no longer map to a project,
;; since they don't have a clean project-name.
- (if-let (proj (project--find-in-directory dir))
- (push (cons (project-name proj) proj) ret)))
+ (when-let (proj (project--find-in-directory dir))
+ (let ((name (project-name proj)))
+ (push name project--name-history)
+ (push (cons name proj) ret))))
ret))
;; XXX: Just using this for the category (for the substring
;; completion style).
@@ -1798,7 +1816,9 @@ It's also possible to enter an arbitrary directory not in
the list."
(pr-name ""))
(while (equal pr-name "")
;; If the user simply pressed RET, do this again until they don't.
- (setq pr-name (completing-read "Select project: " table nil t)))
+ (setq pr-name
+ (let (history-add-new-input)
+ (completing-read "Select project: " table nil t nil
'project--name-history))))
(if (equal pr-name dir-choice)
(read-directory-name "Select directory: " default-directory nil t)
(let ((proj (assoc pr-name choices)))
@@ -2064,6 +2084,7 @@ made from `project-switch-commands'.
When called in a program, it will use the project corresponding
to directory DIR."
(interactive (list (funcall project-prompter)))
+ (project--remember-dir dir)
(let ((command (if (symbolp project-switch-commands)
project-switch-commands
(project--switch-project-command)))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index d3cb5a77e22..ab3bf1b4ec0 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -979,7 +979,7 @@ It makes underscores and dots word constituent chars.")
"raise" "return" "try" "while" "with" "yield"
;; These are technically operators, but we fontify them as
;; keywords.
- "and" "in" "is" "not" "or"))
+ "and" "in" "is" "not" "or" "not in"))
(defvar python--treesit-builtins
'("abs" "all" "any" "ascii" "bin" "bool" "breakpoint" "bytearray"
@@ -1235,7 +1235,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(when (python--treesit-variable-p node)
(treesit-fontify-with-override
(treesit-node-start node) (treesit-node-end node)
- 'font-lock-variable-name-face override start end)))
+ 'font-lock-variable-use-face override start end)))
;;; Indentation
@@ -6842,8 +6842,8 @@ implementations: `python-mode' and `python-ts-mode'."
'(( comment definition)
( keyword string type)
( assignment builtin constant decorator
- escape-sequence number property string-interpolation )
- ( bracket delimiter function operator variable)))
+ escape-sequence number string-interpolation )
+ ( bracket delimiter function operator variable property)))
(setq-local treesit-font-lock-settings python--treesit-settings)
(setq-local imenu-create-index-function
#'python-imenu-treesit-create-index)
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index ba0cbc8b066..b983c671cd9 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -1340,7 +1340,7 @@ to update the alist.")
If FLAG is nil, just uses `current-word'.
Otherwise scans backward for most likely Tcl command word."
(if (and flag
- (derived-mode-p 'tcl-mode 'inferior-tcl-mode))
+ (derived-mode-p '(tcl-mode inferior-tcl-mode)))
(condition-case nil
(save-excursion
;; Look backward for first word actually in alist.
@@ -1575,7 +1575,7 @@ The first line is assumed to look like \"#!.../program
...\"."
(if (memq char '(?\[ ?\] ?{ ?} ?\\ ?\" ?$ ?\s ?\;))
(concat "\\" (char-to-string char))
(char-to-string char)))
- string ""))
+ string))
diff --git a/lisp/progmodes/typescript-ts-mode.el
b/lisp/progmodes/typescript-ts-mode.el
index b976145dbf3..b6d5495adbb 100644
--- a/lisp/progmodes/typescript-ts-mode.el
+++ b/lisp/progmodes/typescript-ts-mode.el
@@ -124,6 +124,11 @@ Argument LANGUAGE is either `typescript' or `tsx'."
((parent-is "arrow_function") parent-bol typescript-ts-mode-indent-offset)
((parent-is "parenthesized_expression") parent-bol
typescript-ts-mode-indent-offset)
((parent-is "binary_expression") parent-bol
typescript-ts-mode-indent-offset)
+ ((match "while" "do_statement") parent-bol 0)
+ ((match "else" "if_statement") parent-bol 0)
+ ((parent-is ,(rx (or (seq (or "if" "for" "for_in" "while" "do")
"_statement")
+ "else_clause")))
+ parent-bol typescript-ts-mode-indent-offset)
,@(when (eq language 'tsx)
(append (tsx-ts-mode--indent-compatibility-b893426)
diff --git a/lisp/replace.el b/lisp/replace.el
index 6b06e48c384..ff7ca1145b8 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2642,10 +2642,6 @@ passed in. If LITERAL is set, no checking is done,
anyway."
noedit nil)))
(set-match-data match-data)
(replace-match newtext fixedcase literal)
- ;; `query-replace' undo feature needs the beginning of the match position,
- ;; but `replace-match' may change it, for instance, with a regexp like "^".
- ;; Ensure that this function preserves the match data (Bug#31492).
- (set-match-data match-data)
;; `replace-match' leaves point at the end of the replacement text,
;; so move point to the beginning when replacing backward.
(when backward (goto-char (nth 0 match-data)))
@@ -2759,6 +2755,7 @@ to a regexp that is actually used for the search.")
(isearch-regexp-lax-whitespace
replace-regexp-lax-whitespace)
(isearch-case-fold-search case-fold)
+ (isearch-invisible search-invisible)
(isearch-forward (not backward))
(isearch-other-end match-beg)
(isearch-error nil)
diff --git a/lisp/simple.el b/lisp/simple.el
index 0d399ba5c94..c0384cf5c0c 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -1029,7 +1029,7 @@ that if you use overwrite mode as your normal editing
mode, you can use
this function to insert characters when necessary.
In binary overwrite mode, this function does overwrite, and octal
-(or decimal or hex) digits are interpreted as a character code. This
+\(or decimal or hex) digits are interpreted as a character code. This
is intended to be useful for editing binary files."
(interactive "*p")
(let* ((char
@@ -2427,9 +2427,7 @@ BUFFER."
"Say whether MODES are in action in BUFFER.
This is the case if either the major mode is derived from one of MODES,
or (if one of MODES is a minor mode), if it is switched on in BUFFER."
- (or (apply #'provided-mode-derived-p
- (buffer-local-value 'major-mode buffer)
- modes)
+ (or (provided-mode-derived-p (buffer-local-value 'major-mode buffer) modes)
;; It's a minor mode.
(seq-intersection modes
(buffer-local-value 'local-minor-modes buffer)
@@ -2990,11 +2988,17 @@ this by calling a function defined by
`minibuffer-default-add-function'.")
(defun minibuffer-default-add-completions ()
"Return a list of all completions without the default value.
This function is used to add all elements of the completion table to
-the end of the list of defaults just after the default value."
+the end of the list of defaults just after the default value.
+If you don't want to add initial completions to the default value,
+use either `minibuffer-setup-hook' or `minibuffer-with-setup-hook'
+to set the value of `minibuffer-default-add-function' to nil."
(let ((def minibuffer-default)
- (all (all-completions ""
- minibuffer-completion-table
- minibuffer-completion-predicate)))
+ ;; Avoid some popular completions with undefined order
+ (all (unless (memq minibuffer-completion-table
+ `(help--symbol-completion-table ,obarray))
+ (all-completions ""
+ minibuffer-completion-table
+ minibuffer-completion-predicate))))
(if (listp def)
(append def all)
(cons def (delete def all)))))
@@ -11082,6 +11086,10 @@ If the buffer doesn't exist, create it first."
(pop-to-buffer-same-window (get-scratch-buffer-create)))
(defun kill-buffer--possibly-save (buffer)
+ "Ask the user to confirm killing of a modified BUFFER.
+
+If the user confirms, optionally save BUFFER that is about to be
+killed."
(let ((response
(cadr
(read-multiple-choice
diff --git a/lisp/so-long.el b/lisp/so-long.el
index b7cfce31173..d91002e873a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -783,8 +783,7 @@ an example."
:package-version '(so-long . "1.0"))
(make-variable-buffer-local 'so-long-file-local-mode-function)
-;; `provided-mode-derived-p' was added in 26.1
-(unless (fboundp 'provided-mode-derived-p)
+(unless (fboundp 'provided-mode-derived-p) ;Only in Emacs≥26.1
(defun provided-mode-derived-p (mode &rest modes)
"Non-nil if MODE is derived from one of MODES.
Uses the `derived-mode-parent' property of the symbol to trace backwards.
@@ -1717,7 +1716,7 @@ major mode is a member (or derivative of a member) of
`so-long-target-modes'.
(not so-long--inhibited)
(not so-long--calling)
(or (eq so-long-target-modes t)
- (apply #'derived-mode-p so-long-target-modes))
+ (derived-mode-p so-long-target-modes))
(setq so-long-detected-p (funcall so-long-predicate))
;; `so-long' should be called; but only if and when the buffer is
;; displayed in a window. Long lines in invisible buffers are generally
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
index aad0aa40fa4..8a525739c9a 100644
--- a/lisp/sqlite.el
+++ b/lisp/sqlite.el
@@ -24,19 +24,28 @@
;;; Code:
(defmacro with-sqlite-transaction (db &rest body)
- "Execute BODY while holding a transaction for DB."
+ "Execute BODY while holding a transaction for DB.
+If BODY completes normally, commit the changes and return
+the value of BODY.
+If BODY signals an error, or transaction commit fails, roll
+back the transaction changes."
(declare (indent 1) (debug (form body)))
(let ((db-var (gensym))
- (func-var (gensym)))
+ (func-var (gensym))
+ (res-var (gensym))
+ (commit-var (gensym)))
`(let ((,db-var ,db)
- (,func-var (lambda () ,@body)))
+ (,func-var (lambda () ,@body))
+ ,res-var ,commit-var)
(if (sqlite-available-p)
(unwind-protect
(progn
(sqlite-transaction ,db-var)
- (funcall ,func-var))
- (sqlite-commit ,db-var))
- (funcall ,func-var)))))
+ (setq ,res-var (funcall ,func-var))
+ (setq ,commit-var (sqlite-commit ,db-var))
+ ,res-var)
+ (or ,commit-var (sqlite-rollback ,db-var))))
+ (funcall ,func-var))))
(provide 'sqlite)
diff --git a/lisp/startup.el b/lisp/startup.el
index 37843eab176..e40c316a8e8 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -2036,7 +2036,10 @@ a face or button specification."
(call-interactively
'recover-session)))
" to recover the files you were editing."))))
-
+ ;; Insert the permissions notice if the user has yet to grant Emacs
+ ;; storage permissions.
+ (when (fboundp 'android-after-splash-screen)
+ (funcall 'android-after-splash-screen t))
(when concise
(fancy-splash-insert
:face 'variable-pitch "\n"
@@ -2238,6 +2241,11 @@ splash screen in another window."
"type M-x recover-session RET\nto recover"
" the files you were editing.\n"))
+ ;; Insert the permissions notice if the user has yet to grant
+ ;; Emacs storage permissions.
+ (when (fboundp 'android-after-splash-screen)
+ (funcall 'android-after-splash-screen nil))
+
(use-local-map splash-screen-keymap)
;; Display the input that we set up in the buffer.
diff --git a/lisp/subr.el b/lisp/subr.el
index d4173b4daba..7f2dcdc4d90 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -460,6 +460,10 @@ Also see `ignore'."
Errors cause entry to the debugger when `debug-on-error' is non-nil.
This can be overridden by `debug-ignored-errors'.
+When `noninteractive' is non-nil (in particular, in batch mode), an
+unhandled error calls `kill-emacs', which terminates the Emacs
+session with a non-zero exit code.
+
To signal with MESSAGE without interpreting format characters
like `%', `\\=`' and `\\='', use (error \"%s\" MESSAGE).
In Emacs, the convention is that error messages start with a capital
@@ -2678,26 +2682,150 @@ The variable list SPEC is the same as in `if-let*'."
;; PUBLIC: find if the current mode derives from another.
-(defun provided-mode-derived-p (mode &rest modes)
- "Non-nil if MODE is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards.
-If you just want to check `major-mode', use `derived-mode-p'."
- (declare (side-effect-free t))
- (while
- (and
- (not (memq mode modes))
- (let* ((parent (get mode 'derived-mode-parent)))
- (setq mode (or parent
- ;; If MODE is an alias, then follow the alias.
- (let ((alias (symbol-function mode)))
- (and (symbolp alias) alias)))))))
- mode)
-
-(defun derived-mode-p (&rest modes)
- "Non-nil if the current major mode is derived from one of MODES.
-Uses the `derived-mode-parent' property of the symbol to trace backwards."
- (declare (side-effect-free t))
- (apply #'provided-mode-derived-p major-mode modes))
+(defun merge-ordered-lists (lists &optional error-function)
+ "Merge LISTS in a consistent order.
+LISTS is a list of lists of elements.
+Merge them into a single list containing the same elements (removing
+duplicates), obeying their relative positions in each list.
+The order of the (sub)lists determines the final order in those cases where
+the order within the sublists does not impose a unique choice.
+Equality of elements is tested with `eql'.
+
+If a consistent order does not exist, call ERROR-FUNCTION with
+a remaining list of lists that we do not know how to merge.
+It should return the candidate to use to continue the merge, which
+has to be the head of one of the lists.
+By default we choose the head of the first list."
+ ;; Algorithm inspired from
+ ;; [C3](https://en.wikipedia.org/wiki/C3_linearization)
+ (let ((result '()))
+ (setq lists (remq nil lists)) ;Don't mutate the original `lists' argument.
+ (while (cdr (setq lists (delq nil lists)))
+ ;; Try to find the next element of the result. This
+ ;; is achieved by considering the first element of each
+ ;; (non-empty) input list and accepting a candidate if it is
+ ;; consistent with the rests of the input lists.
+ (let* ((next nil)
+ (tail lists))
+ (while tail
+ (let ((candidate (caar tail))
+ (other-lists lists))
+ ;; Ensure CANDIDATE is not in any position but the first
+ ;; in any of the element lists of LISTS.
+ (while other-lists
+ (if (not (memql candidate (cdr (car other-lists))))
+ (setq other-lists (cdr other-lists))
+ (setq candidate nil)
+ (setq other-lists nil)))
+ (if (not candidate)
+ (setq tail (cdr tail))
+ (setq next candidate)
+ (setq tail nil))))
+ (unless next ;; The graph is inconsistent.
+ (setq next (funcall (or error-function #'caar) lists))
+ (unless (assoc next lists #'eql)
+ (error "Invalid candidate returned by error-function: %S" next)))
+ ;; The graph is consistent so far, add NEXT to result and
+ ;; merge input lists, dropping NEXT from their heads where
+ ;; applicable.
+ (push next result)
+ (setq lists
+ (mapcar (lambda (l) (if (eql (car l) next) (cdr l) l))
+ lists))))
+ (if (null result) (car lists) ;; Common case.
+ (append (nreverse result) (car lists)))))
+
+(defun derived-mode-all-parents (mode &optional known-children)
+ "Return all the parents of MODE, starting with MODE.
+The returned list is not fresh, don't modify it.
+\n(fn MODE)" ;`known-children' is for internal use only.
+ ;; Can't use `with-memoization' :-(
+ (let ((ps (get mode 'derived-mode--all-parents)))
+ (cond
+ (ps ps)
+ ((memq mode known-children)
+ ;; These things happen, better not get all worked up about it.
+ ;;(error "Cycle in the major mode hierarchy: %S" mode)
+ ;; But do try to return something meaningful.
+ (memq mode (reverse known-children)))
+ (t
+ ;; The mode hierarchy (or DAG, actually), is very static, but we
+ ;; need to react to changes because `parent' may not be defined
+ ;; yet (e.g. it's still just an autoload), so the recursive call
+ ;; to `derived-mode-all-parents' may return an
+ ;; invalid/incomplete result which we'll need to update when the
+ ;; mode actually gets loaded.
+ (let* ((new-children (cons mode known-children))
+ (get-all-parents
+ (lambda (parent)
+ ;; Can't use `cl-lib' here (nor `gv') :-(
+ ;;(cl-assert (not (equal parent mode)))
+ ;;(cl-pushnew mode (get parent 'derived-mode--followers))
+ (let ((followers (get parent 'derived-mode--followers)))
+ (unless (memq mode followers)
+ (put parent 'derived-mode--followers
+ (cons mode followers))))
+ (derived-mode-all-parents parent new-children)))
+ (parent (or (get mode 'derived-mode-parent)
+ ;; If MODE is an alias, then follow the alias.
+ (let ((alias (symbol-function mode)))
+ (and (symbolp alias) alias))))
+ (extras (get mode 'derived-mode-extra-parents))
+ (all-parents
+ (merge-ordered-lists
+ (cons (if (and parent (not (memq parent extras)))
+ (funcall get-all-parents parent))
+ (mapcar get-all-parents extras)))))
+ ;; Cache the result unless it was affected by `known-children'
+ ;; because of a cycle.
+ (if (and (memq mode all-parents) known-children)
+ (cons mode (remq mode all-parents))
+ (put mode 'derived-mode--all-parents (cons mode all-parents))))))))
+
+(defun provided-mode-derived-p (mode &optional modes &rest old-modes)
+ "Non-nil if MODE is derived from a mode that is a member of the list MODES.
+MODES can also be a single mode instead of a list.
+If you just want to check `major-mode', use `derived-mode-p'.
+We also still support the deprecated calling convention:
+\(provided-mode-derived-p MODE &rest MODES)."
+ (declare (side-effect-free t)
+ (advertised-calling-convention (mode modes) "30.1"))
+ (cond
+ (old-modes (setq modes (cons modes old-modes)))
+ ((not (listp modes)) (setq modes (list modes))))
+ (let ((ps (derived-mode-all-parents mode)))
+ (while (and modes (not (memq (car modes) ps)))
+ (setq modes (cdr modes)))
+ (car modes)))
+
+(defun derived-mode-p (&optional modes &rest old-modes)
+ "Non-nil if the current major mode is derived from one of MODES.
+MODES should be a list of symbols or a single mode symbol instead of a list.
+We also still support the deprecated calling convention:
+\(derived-mode-p &rest MODES)."
+ (declare (side-effect-free t)
+ (advertised-calling-convention (modes) "30.1"))
+ (provided-mode-derived-p major-mode (if old-modes (cons modes old-modes)
+ modes)))
+
+(defun derived-mode-set-parent (mode parent)
+ "Declare PARENT to be the parent of MODE."
+ (put mode 'derived-mode-parent parent)
+ (derived-mode--flush mode))
+
+(defun derived-mode-add-parents (mode extra-parents)
+ "Add EXTRA-PARENTS to the parents of MODE.
+Declares the parents of MODE to be its main parent (as defined
+in `define-derived-mode') plus EXTRA-PARENTS."
+ (put mode 'derived-mode-extra-parents extra-parents)
+ (derived-mode--flush mode))
+
+(defun derived-mode--flush (mode)
+ (put mode 'derived-mode--all-parents nil)
+ (let ((followers (get mode 'derived-mode--followers)))
+ (when followers ;; Common case.
+ (put mode 'derived-mode--followers nil)
+ (mapc #'derived-mode--flush followers))))
(defvar-local major-mode--suspended nil)
(put 'major-mode--suspended 'permanent-local t)
@@ -3204,22 +3332,30 @@ only unbound fallback disabled is downcasing of the
last event."
(message nil)
(use-global-map old-global-map))))
+(defvar touch-screen-events-received nil
+ "Whether a touch screen event has ever been translated.
+The value of this variable governs whether
+`read--potential-mouse-event' calls read-key or read-event.")
+
;; FIXME: Once there's a safe way to transition away from read-event,
;; callers to this function should be updated to that way and this
;; function should be deleted.
(defun read--potential-mouse-event ()
- "Read an event that might be a mouse event.
+ "Read an event that might be a mouse event.
This function exists for backward compatibility in code packaged
with Emacs. Do not call it directly in your own packages."
- ;; `xterm-mouse-mode' events must go through `read-key' as they
- ;; are decoded via `input-decode-map'.
- (if xterm-mouse-mode
- (read-key nil
- ;; Normally `read-key' discards all mouse button
- ;; down events. However, we want them here.
- t)
- (read-event)))
+ ;; `xterm-mouse-mode' events must go through `read-key' as they
+ ;; are decoded via `input-decode-map'.
+ (if (or xterm-mouse-mode
+ ;; If a touch screen is being employed, then mouse events
+ ;; are subject to translation as well.
+ touch-screen-events-received)
+ (read-key nil
+ ;; Normally `read-key' discards all mouse button
+ ;; down events. However, we want them here.
+ t)
+ (read-event)))
(defvar read-passwd-map
;; BEWARE: `defconst' would purecopy it, breaking the sharing with
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index 7d9a033d723..36470097b40 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -339,5 +339,91 @@ the `stop-selecting-text' editing key."
(global-set-key [stop-selecting-text] 'android-deactivate-mark-command)
+;; Splash screen notice. Users are frequently left scratching their
+;; heads when they overlook the Android appendex in the Emacs manual
+;; and discover that external storage is not accessible; worse yet,
+;; Android 11 and later veil the settings panel controlling such
+;; permissions behind layer upon layer of largely immaterial settings
+;; panels, such that several modified copies of the Android Settings
+;; app have omitted them altogether after their developers conducted
+;; their own interface simplifications. Display a button on the
+;; splash screen that instructs users on granting these permissions
+;; when they are denied.
+
+(declare-function android-external-storage-available-p "androidfns.c")
+(declare-function android-request-storage-access "androidfns.c")
+(declare-function android-request-directory-access "androidfns.c")
+
+(defun android-display-storage-permission-popup (&optional _ignored)
+ "Display a dialog regarding storage permissions.
+Display a buffer explaining the need for storage permissions and
+offering to grant them."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*Android Permissions*")
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (insert (propertize "Storage Access Permissions"
+ 'face '(bold (:height 1.2))))
+ (insert "
+
+Before Emacs can access your device's external storage
+directories, such as /sdcard and /storage/emulated/0, you must
+grant it permission to do so.
+
+Alternatively, you can request access to a particular directory
+in external storage, whereafter it will be available under the
+directory /content/storage.
+
+")
+ (insert-button "Grant storage permissions"
+ 'action (lambda (_)
+ (android-request-storage-access)
+ (quit-window)))
+ (newline)
+ (newline)
+ (insert-button "Request access to directory"
+ 'action (lambda (_)
+ (android-request-directory-access)))
+ (newline)
+ (special-mode)
+ (setq buffer-read-only t))
+ (let ((window (display-buffer "*Android Permissions*")))
+ (when (windowp window)
+ (with-selected-window window
+ ;; Fill the text to the width of this window in columns if it
+ ;; does not exceed 72, that the text might not be wrapped or
+ ;; truncated.
+ (when (<= (window-width window) 72)
+ (let ((fill-column (window-width window))
+ (inhibit-read-only t))
+ (fill-region (point-min) (point-max))))))))
+
+(defun android-after-splash-screen (fancy-p)
+ "Insert a brief notice on the absence of storage permissions.
+If storage permissions are as yet denied to Emacs, insert a short
+notice to that effect, followed by a button that enables the user
+to grant such permissions.
+
+FANCY-P non-nil means the notice will be displayed with faces, in
+the style appropriate for its incorporation within the fancy splash
+screen display; see `francy-splash-insert'."
+ (unless (android-external-storage-available-p)
+ (if fancy-p
+ (fancy-splash-insert
+ :face '(variable-pitch
+ font-lock-function-call-face)
+ "\nPermissions necessary to access external storage directories have
+been denied. Click "
+ :link '("here" android-display-storage-permission-popup)
+ " to grant them.")
+ (insert
+ "Permissions necessary to access external storage directories have been
+denied. ")
+ (insert-button "Click here to grant them."
+ 'action #'android-display-storage-permission-popup
+ 'follow-link t)
+ (newline))))
+
+
(provide 'android-win)
;; android-win.el ends here.
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 9bd1135c5be..b71e85b0e37 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -3974,7 +3974,8 @@ You can bind this to the key C-c i in GNUS or mail by
adding to
(point-max)))
(t (min (point-max) (funcall ispell-message-text-end))))))
(default-prefix ; Vanilla cite prefix (just used for cite-regexp)
- (if (ispell-non-empty-string mail-yank-prefix)
+ (if mail-yank-prefix
+ (ispell-non-empty-string mail-yank-prefix)
" \\|\t"))
(cite-regexp ;Prefix of quoted text
(cond
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index a26e7b9c83a..d1644b5613e 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -2133,6 +2133,7 @@ If NOT-ALL is non-nil, save the `.dvi' file."
t "%r.pdf"))
'("pdf" "xe" "lua"))
((concat tex-command
+ " " tex-start-options
" " (if (< 0 (length tex-start-commands))
(shell-quote-argument tex-start-commands))
" %f")
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 5d4f4df9131..88efbf73beb 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -52,7 +52,6 @@
;;; Code:
-(require 'cl-lib)
(provide 'thingatpt)
(defvar thing-at-point-provider-alist nil
@@ -175,11 +174,14 @@ See the file `thingatpt.el' for documentation on how to
define
a symbol as a valid THING."
(let ((text
(cond
- ((cl-loop for (pthing . function) in thing-at-point-provider-alist
- when (eq pthing thing)
- for result = (funcall function)
- when result
- return result))
+ ((let ((alist thing-at-point-provider-alist)
+ elt result)
+ (while (and alist (null result))
+ (setq elt (car alist)
+ alist (cdr alist))
+ (and (eq (car elt) thing)
+ (setq result (funcall (cdr elt)))))
+ result))
((get thing 'thing-at-point)
(funcall (get thing 'thing-at-point)))
(t
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index ea1e27a263b..56adb75cefc 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -33,15 +33,41 @@
(defvar touch-screen-current-tool nil
"The touch point currently being tracked, or nil.
-If non-nil, this is a list of nine elements: the ID of the touch
+If non-nil, this is a list of ten elements: the ID of the touch
point being tracked, the window where the touch began, a cons
-containing the last known position of the touch point, relative
+holding the last registered position of the touch point, relative
to that window, a field used to store data while tracking the
-touch point, the initial position of the touchpoint, and another
-four fields to used store data while tracking the touch point.
+touch point, the initial position of the touchpoint, another four
+fields to used store data while tracking the touch point, and the
+last known position of the touch point.
+
See `touch-screen-handle-point-update' and
`touch-screen-handle-point-up' for the meanings of the fourth
-element.")
+element.
+
+The third and last elements differ in that the former is not
+modified until after a gesture is recognized in reaction to an
+update, whereas the latter is updated upon each apposite
+`touchscreen-update' event.")
+
+(defvar touch-screen-aux-tool nil
+ "The ancillary tool being tracked, or nil.
+If non-nil, this is a vector of ten elements: the ID of the
+touch point being tracked, the window where the touch began, a
+cons holding the initial position of the touch point, and the
+last known position of the touch point, all in the same format as
+in `touch-screen-current-tool', the distance in pixels between
+the current tool and the aformentioned initial position, the
+center of the line formed between those two points, the ratio
+between the present distance between both tools and the aforesaid
+initial distance when a pinch gesture was last sent, and three
+elements into which commands can save data particular to a tool.
+
+The ancillary tool is a second tool whose movement is interpreted
+in unison with that of the current tool to recognize gestures
+comprising the motion of both such as \"pinch\" gestures, in
+which the text scale is adjusted in proportion to the distance
+between both tools.")
(defvar touch-screen-set-point-commands '(mouse-set-point)
"List of commands known to set the point.
@@ -229,7 +255,7 @@ horizontal scrolling according to the movement in DX."
(window (cadr touch-screen-current-tool))
(lines-vscrolled (or (nth 7 touch-screen-current-tool) 0))
(lines-hscrolled (or (nth 8 touch-screen-current-tool) 0)))
- (setq accumulator (+ accumulator dx)) ; Add dx;
+ (setq accumulator (+ accumulator dx)) ; Add dx.
;; Figure out how much it has scrolled and how much remains on the
;; left or right of the window. If a line has already been
;; vscrolled but no hscrolling has happened, don't hscroll, as
@@ -844,6 +870,101 @@ keeping the bounds of the region intact, and set up state
for
+;; Pinch gesture.
+
+(defvar text-scale-mode)
+(defvar text-scale-mode-amount)
+(defvar text-scale-mode-step)
+
+(defun touch-screen-scroll-point-to-y (target-point target-y)
+ "Move the row surrounding TARGET-POINT to TARGET-Y.
+Scroll the current window such that the position of TARGET-POINT
+within it on the Y axis approaches TARGET-Y."
+ (condition-case nil
+ (let* ((last-point (point))
+ (current-y (cadr (pos-visible-in-window-p target-point
+ nil t)))
+ (direction (if (if current-y
+ (< target-y current-y)
+ (< (window-start) target-point))
+ -1 1)))
+ (while (< 0 (* direction (if current-y
+ (- target-y current-y)
+ (- (window-start) target-point))))
+ (scroll-down direction)
+ (setq last-point (point))
+ (setq current-y (cadr (pos-visible-in-window-p target-point nil t))))
+ (unless (and (< direction 0) current-y)
+ (scroll-up direction)
+ (goto-char last-point)))
+ ;; Ignore BOB and EOB.
+ ((beginning-of-buffer end-of-buffer) nil)))
+
+(defun touch-screen-pinch (event)
+ "Scroll the window in the touchscreen-pinch event EVENT.
+Pan the display by the pan deltas in EVENT, and adjust the
+text scale by the ratio therein."
+ (interactive "e")
+ (require 'face-remap)
+ (let* ((posn (cadr event))
+ (window (posn-window posn))
+ (scale (nth 2 event))
+ (ratio-diff (nth 5 event))
+ current-scale start-scale)
+ (when (windowp window)
+ (with-selected-window window
+ (setq current-scale (if text-scale-mode
+ text-scale-mode-amount
+ 0)
+ start-scale (or (aref touch-screen-aux-tool 7)
+ (aset touch-screen-aux-tool 7
+ current-scale)))
+ ;; Set the text scale.
+ (text-scale-set (+ start-scale
+ (round (log scale text-scale-mode-step))))
+ ;; Subsequently move the row which was at the centrum to its Y
+ ;; position.
+ (if (and (not (eq current-scale
+ text-scale-mode-amount))
+ (posn-point posn)
+ (cdr (posn-x-y posn)))
+ (touch-screen-scroll-point-to-y (posn-point posn)
+ (cdr (posn-x-y posn)))
+ ;; Rather than scroll POSN's point to its old row, scroll the
+ ;; display by the Y axis deltas within EVENT.
+ (let ((height (window-default-line-height))
+ (y-accumulator (or (aref touch-screen-aux-tool 8) 0)))
+ (setq y-accumulator (+ y-accumulator (nth 4 event)))
+ (when (or (> y-accumulator height)
+ (< y-accumulator (- height)))
+ (ignore-errors
+ (if (> y-accumulator 0)
+ (scroll-down 1)
+ (scroll-up 1)))
+ (setq y-accumulator 0))
+ (aset touch-screen-aux-tool 8 y-accumulator))
+ ;; Likewise for the X axis deltas.
+ (let ((width (frame-char-width))
+ (x-accumulator (or (aref touch-screen-aux-tool 9) 0)))
+ (setq x-accumulator (+ x-accumulator (nth 3 event)))
+ (when (or (> x-accumulator width)
+ (< x-accumulator (- width)))
+ ;; Do not hscroll if the ratio has shrunk, for that is
+ ;; generally attended by the centerpoint moving left,
+ ;; and Emacs can hscroll left even when no lines are
+ ;; truncated.
+ (unless (and (< x-accumulator 0)
+ (< ratio-diff 0))
+ (if (> x-accumulator 0)
+ (scroll-right 1)
+ (scroll-left 1)))
+ (setq x-accumulator 0))
+ (aset touch-screen-aux-tool 9 x-accumulator)))))))
+
+(define-key global-map [touchscreen-pinch] #'touch-screen-pinch)
+
+
+
;; Touch screen event translation. The code here translates raw touch
;; screen events into `touchscreen-scroll' events and mouse events in
;; a ``DWIM'' fashion, consulting the keymaps at the position of the
@@ -886,20 +1007,28 @@ Perform the editing operations or throw to the input
translation
function with an input event tied to any gesture that is
recognized.
+Update the tenth element of `touch-screen-current-tool' with
+POINT relative to the window it was placed on. Update the third
+element in like fashion, once sufficient motion has accumulated
+that an event is generated.
+
POINT must be the touch point currently being tracked as
`touch-screen-current-tool'.
If the fourth element of `touch-screen-current-tool' is nil, then
-the touch has just begun. Determine how much POINT has moved.
-If POINT has moved upwards or downwards by a significant amount,
-then set the fourth element to `scroll'. Then, generate a
-`touchscreen-scroll' event with the window that POINT was
-initially placed upon, and pixel deltas describing how much point
-has moved relative to its previous position in the X and Y axes.
+the touch has just begun. In a related case, if it is
+`ancillary-tool', then the ancillary tool has been removed and
+gesture translation must be resumed. Determine how much POINT
+has moved. If POINT has moved upwards or downwards by a
+significant amount, then set the fourth element to `scroll'.
+Then, generate a `touchscreen-scroll' event with the window that
+POINT was initially placed upon, and pixel deltas describing how
+much point has moved relative to its previous position in the X
+and Y axes.
If the fourth element of `touchscreen-current-tool' is `scroll',
then generate a `touchscreen-scroll' event with the window that
-qPOINT was initially placed upon, and pixel deltas describing how
+POINT was initially placed upon, and pixel deltas describing how
much point has moved relative to its previous position in the X
and Y axes.
@@ -918,34 +1047,23 @@ If the fourth element of `touch-screen-current-tool' is
If the fourth element of `touch-screen-current-tool' is `drag',
then move point to the position of POINT."
- (let ((window (nth 1 touch-screen-current-tool))
- (what (nth 3 touch-screen-current-tool)))
- (cond ((null what)
- (let* ((posn (cdr point))
- (last-posn (nth 2 touch-screen-current-tool))
- (original-posn (nth 4 touch-screen-current-tool))
- ;; Now get the position of X and Y relative to
- ;; WINDOW.
- (relative-xy
- (touch-screen-relative-xy posn window))
- (col (and (not (posn-area original-posn))
- (car (posn-col-row original-posn
- (posn-window posn)))))
- ;; Don't start horizontal scrolling if the touch
- ;; point originated within two columns of the window
- ;; edges, as systems like Android use those two
- ;; columns to implement gesture navigation.
- (diff-x-eligible
- (and col (> col 2)
- (< col (- (window-width window) 2))))
+ (let* ((window (nth 1 touch-screen-current-tool))
+ (what (nth 3 touch-screen-current-tool))
+ (posn (cdr point))
+ ;; Now get the position of X and Y relative to WINDOW.
+ (relative-xy
+ (touch-screen-relative-xy posn window)))
+ ;; Update the 10th field of the tool list with RELATIVE-XY.
+ (setcar (nthcdr 9 touch-screen-current-tool) relative-xy)
+ (cond ((or (null what)
+ (eq what 'ancillary-tool))
+ (let* ((last-posn (nth 2 touch-screen-current-tool))
(diff-x (- (car last-posn) (car relative-xy)))
(diff-y (- (cdr last-posn) (cdr relative-xy))))
(when (or (> diff-y 10)
- (and diff-x-eligible
- (> diff-x (frame-char-width)))
+ (> diff-x (frame-char-width))
(< diff-y -10)
- (and diff-x-eligible
- (< diff-x (- (frame-char-width)))))
+ (< diff-x (- (frame-char-width))))
(setcar (nthcdr 3 touch-screen-current-tool)
'scroll)
(setcar (nthcdr 2 touch-screen-current-tool)
@@ -966,12 +1084,7 @@ then move point to the position of POINT."
(when touch-screen-current-timer
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
- (let* ((posn (cdr point))
- (last-posn (nth 2 touch-screen-current-tool))
- ;; Now get the position of X and Y relative to
- ;; WINDOW.
- (relative-xy
- (touch-screen-relative-xy posn window))
+ (let* ((last-posn (nth 2 touch-screen-current-tool))
(diff-x (- (car last-posn) (car relative-xy)))
(diff-y (- (cdr last-posn) (cdr relative-xy))))
(setcar (nthcdr 3 touch-screen-current-tool)
@@ -1014,6 +1127,116 @@ then move point to the position of POINT."
;; Generate a (touchscreen-drag POSN) event.
(throw 'input-event (list 'touchscreen-drag posn)))))))
+(defsubst touch-screen-distance (pos1 pos2)
+ "Compute the distance in pixels between POS1 and POS2.
+Each is a coordinate whose car and cdr are respectively its X and
+Y values."
+ (let ((v1 (- (cdr pos2) (cdr pos1)))
+ (v2 (- (car pos2) (car pos1))))
+ (abs (sqrt (+ (* v1 v1) (* v2 v2))))))
+
+(defsubst touch-screen-centrum (pos1 pos2)
+ "Compute the center of a line between the points POS1 and POS2.
+Each, and value, is a coordinate whose car and cdr are
+respectively its X and Y values."
+ (let ((v1 (+ (cdr pos2) (cdr pos1)))
+ (v2 (+ (car pos2) (car pos1))))
+ (cons (/ v2 2) (/ v1 2))))
+
+(defun touch-screen-handle-aux-point-update (point number)
+ "Notice that a point being observed has moved.
+Register motion from either the current or ancillary tool while
+an ancillary tool is present.
+
+POINT must be the cdr of an element of a `touchscreen-update'
+event's list of touch points. NUMBER must be its touch ID.
+
+Calculate the distance between POINT's position and that of the
+other tool (which is to say the ancillary tool of POINT is the
+current tool, and vice versa). Compare this distance to that
+between both points at the time they were placed on the screen,
+and signal a pinch event to adjust the text scale and scroll the
+window by the factor so derived. Such events are lists formed as
+so illustrated:
+
+ (touchscreen-pinch CENTRUM RATIO PAN-X PAN-Y RATIO-DIFF)
+
+in which CENTRUM is a posn representing the midpoint of a line
+between the present locations of both tools, RATIO is the said
+factor, PAN-X is the number of pixels on the X axis that centrum
+has moved since the last event, PAN-Y is that on the Y axis, and
+RATIO-DIFF is the difference between RATIO and the ratio in the
+last such event."
+ (let (this-point-position
+ other-point-position
+ (window (cadr touch-screen-current-tool)))
+ (when (windowp window)
+ (if (eq number (aref touch-screen-aux-tool 0))
+ (progn
+ ;; The point pressed is the ancillary tool. Set
+ ;; other-point-position to that of the current tool.
+ (setq other-point-position (nth 9 touch-screen-current-tool))
+ ;; Update the position within touch-screen-aux-tool.
+ (aset touch-screen-aux-tool 3
+ (setq this-point-position
+ (touch-screen-relative-xy point window))))
+ (setq other-point-position (aref touch-screen-aux-tool 3))
+ (setcar (nthcdr 2 touch-screen-current-tool)
+ (setq this-point-position
+ (touch-screen-relative-xy point window)))
+ (setcar (nthcdr 9 touch-screen-current-tool)
+ this-point-position))
+ ;; Now compute, and take the absolute of, this distance.
+ (let ((distance (touch-screen-distance this-point-position
+ other-point-position))
+ (centrum (touch-screen-centrum this-point-position
+ other-point-position))
+ (initial-distance (aref touch-screen-aux-tool 4))
+ (initial-centrum (aref touch-screen-aux-tool 5)))
+ (let* ((ratio (/ distance initial-distance))
+ (ratio-diff (- ratio (aref touch-screen-aux-tool 6)))
+ (diff (abs (- ratio (aref touch-screen-aux-tool 6))))
+ (centrum-diff (+ (abs (- (car initial-centrum)
+ (car centrum)))
+ (abs (- (cdr initial-centrum)
+ (cdr centrum))))))
+ ;; If the difference in ratio has surpassed a threshold of
+ ;; 0.2 or the centrum difference exceeds the frame's char
+ ;; width, send a touchscreen-pinch event with this
+ ;; information and update that saved in
+ ;; touch-screen-aux-tool.
+ (when (or (> diff 0.2)
+ (> centrum-diff
+ (/ (frame-char-width) 2)))
+ (aset touch-screen-aux-tool 5 centrum)
+ (aset touch-screen-aux-tool 6 ratio)
+ (throw 'input-event
+ (list 'touchscreen-pinch
+ (if (or (<= (car centrum) 0)
+ (<= (cdr centrum) 0))
+ (list window nil centrum nil nil
+ nil nil nil nil nil)
+ (let ((posn (posn-at-x-y (car centrum)
+ (cdr centrum)
+ window)))
+ (if (eq (posn-window posn)
+ window)
+ posn
+ ;; Return a placeholder
+ ;; outside the window if
+ ;; the centrum has moved
+ ;; beyond the confines of
+ ;; the window where the
+ ;; gesture commenced.
+ (list window nil centrum nil nil
+ nil nil nil nil nil))))
+ ratio
+ (- (car centrum)
+ (car initial-centrum))
+ (- (cdr centrum)
+ (cdr initial-centrum))
+ ratio-diff))))))))
+
(defun touch-screen-window-selection-changed (frame)
"Notice that FRAME's selected window has changed.
Cancel any timer that is supposed to hide the keyboard in
@@ -1037,6 +1260,13 @@ POINT should be the point currently tracked as
PREFIX should be a virtual function key used to look up key
bindings.
+If an ancillary touch point is being observed, transfer touch
+information from `touch-screen-aux-tool' to
+`touch-screen-current-tool' and set it to nil, thereby resuming
+gesture recognition with that tool replacing the tool removed.
+
+Otherwise:
+
If the fourth element of `touch-screen-current-tool' is nil or
`restart-drag', move point to the position of POINT, selecting
the window under POINT as well, and deactivate the mark; if there
@@ -1061,140 +1291,159 @@ If the command being executed is listed in
`touch-screen-set-point-commands' also display the on-screen
keyboard if the current buffer and the character at the new point
is not read-only."
- (let ((what (nth 3 touch-screen-current-tool))
- (posn (cdr point)) window point)
- (cond ((or (null what)
- ;; If dragging has been restarted but the touch point
- ;; hasn't been moved, translate the sequence into a
- ;; regular mouse click.
- (eq what 'restart-drag))
- (when (windowp (posn-window posn))
- (setq point (posn-point posn)
- window (posn-window posn))
- ;; Select the window that was tapped given that it isn't
- ;; an inactive minibuffer window.
- (when (or (not (eq window
- (minibuffer-window
- (window-frame window))))
- (minibuffer-window-active-p window))
- (select-window window))
- ;; Now simulate a mouse click there. If there is a link
- ;; or a button, use mouse-2 to push it.
- (let* ((event (list (if (or (mouse-on-link-p posn)
- (and point (button-at point)))
- 'mouse-2
- 'mouse-1)
- posn))
- ;; Look for the command bound to this event.
- (command (key-binding (if prefix
- (vector prefix
- (car event))
- (vector (car event)))
- t nil posn)))
- (deactivate-mark)
- (when point
- ;; This is necessary for following links.
- (goto-char point))
- ;; Figure out if the on screen keyboard needs to be
- ;; displayed.
- (when command
- (if (memq command touch-screen-set-point-commands)
- (if touch-screen-translate-prompt
- ;; When a `mouse-set-point' command is
- ;; encountered and
- ;; `touch-screen-handle-touch' is being
- ;; called from the keyboard command loop,
- ;; call it immediately so that point is set
- ;; prior to the on screen keyboard being
- ;; displayed.
- (call-interactively command nil
- (vector event))
- (if (and (or (not buffer-read-only)
- touch-screen-display-keyboard)
- ;; Detect the splash screen and avoid
- ;; displaying the on screen keyboard
- ;; there.
- (not (equal (buffer-name) "*GNU Emacs*")))
- ;; Once the on-screen keyboard has been
- ;; opened, add
- ;; `touch-screen-window-selection-changed'
- ;; as a window selection change function
- ;; This then prevents it from being hidden
- ;; after exiting the minibuffer.
- (progn
- (add-hook 'window-selection-change-functions
- #'touch-screen-window-selection-changed)
- (frame-toggle-on-screen-keyboard (selected-frame)
- nil))
- ;; Otherwise, hide the on screen keyboard
- ;; now.
- (frame-toggle-on-screen-keyboard (selected-frame) t))
- ;; But if it's being called from `describe-key'
- ;; or some such, return it as a key sequence.
- (throw 'input-event event)))
- ;; If not, return the event.
- (throw 'input-event event)))))
- ((eq what 'mouse-drag)
- ;; Generate a corresponding `mouse-1' event.
- (let* ((new-window (posn-window posn))
- (new-point (posn-point posn))
- (old-posn (nth 4 touch-screen-current-tool))
- (old-window (posn-window posn))
- (old-point (posn-point posn)))
+ (if touch-screen-aux-tool
+ (progn
+ (let ((point-no (aref touch-screen-aux-tool 0))
+ (relative-xy (aref touch-screen-aux-tool 3)))
+ ;; Replace the current position of touch-screen-current-tool
+ ;; with relative-xy and its number with point-no, but leave
+ ;; other information (such as its starting position) intact:
+ ;; this touchpoint is meant to continue the gesture
+ ;; interrupted by the removal of the last, not to commence a
+ ;; new one.
+ (setcar touch-screen-current-tool point-no)
+ (setcar (nthcdr 2 touch-screen-current-tool)
+ relative-xy)
+ (setcar (nthcdr 9 touch-screen-current-tool)
+ relative-xy))
+ (setq touch-screen-aux-tool nil))
+ (let ((what (nth 3 touch-screen-current-tool))
+ (posn (cdr point)) window point)
+ (cond ((or (null what)
+ ;; If dragging has been restarted but the touch point
+ ;; hasn't been moved, translate the sequence into a
+ ;; regular mouse click.
+ (eq what 'restart-drag))
+ (when (windowp (posn-window posn))
+ (setq point (posn-point posn)
+ window (posn-window posn))
+ ;; Select the window that was tapped given that it
+ ;; isn't an inactive minibuffer window.
+ (when (or (not (eq window
+ (minibuffer-window
+ (window-frame window))))
+ (minibuffer-window-active-p window))
+ (select-window window))
+ ;; Now simulate a mouse click there. If there is a
+ ;; link or a button, use mouse-2 to push it.
+ (let* ((event (list (if (or (mouse-on-link-p posn)
+ (and point (button-at point)))
+ 'mouse-2
+ 'mouse-1)
+ posn))
+ ;; Look for the command bound to this event.
+ (command (key-binding (if prefix
+ (vector prefix
+ (car event))
+ (vector (car event)))
+ t nil posn)))
+ (deactivate-mark)
+ (when point
+ ;; This is necessary for following links.
+ (goto-char point))
+ ;; Figure out if the on screen keyboard needs to be
+ ;; displayed.
+ (when command
+ (if (memq command touch-screen-set-point-commands)
+ (if touch-screen-translate-prompt
+ ;; Forgo displaying the virtual keyboard
+ ;; should touch-screen-translate-prompt be
+ ;; set, for then the key won't be delivered
+ ;; to the command loop, but rather to a
+ ;; caller of read-key-sequence such as
+ ;; describe-key.
+ (throw 'input-event event)
+ (if (and (or (not buffer-read-only)
+ touch-screen-display-keyboard)
+ ;; Detect the splash screen and
+ ;; avoid displaying the on screen
+ ;; keyboard there.
+ (not (equal (buffer-name) "*GNU Emacs*")))
+ ;; Once the on-screen keyboard has been
+ ;; opened, add
+ ;; `touch-screen-window-selection-changed'
+ ;; as a window selection change function
+ ;; This then prevents it from being
+ ;; hidden after exiting the minibuffer.
+ (progn
+ (add-hook
+ 'window-selection-change-functions
+ #'touch-screen-window-selection-changed)
+ (frame-toggle-on-screen-keyboard
+ (selected-frame) nil))
+ ;; Otherwise, hide the on screen keyboard
+ ;; now.
+ (frame-toggle-on-screen-keyboard (selected-frame)
+ t))
+ ;; But if it's being called from `describe-key'
+ ;; or some such, return it as a key sequence.
+ (throw 'input-event event)))
+ ;; If not, return the event.
+ (throw 'input-event event)))))
+ ((eq what 'mouse-drag)
+ ;; Generate a corresponding `mouse-1' event.
+ (let* ((new-window (posn-window posn))
+ (new-point (posn-point posn))
+ (old-posn (nth 4 touch-screen-current-tool))
+ (old-window (posn-window posn))
+ (old-point (posn-point posn)))
+ (throw 'input-event
+ ;; If the position of the touch point hasn't
+ ;; changed, or it doesn't start or end on a
+ ;; window...
+ (if (and (not old-point) (not new-point))
+ ;; Should old-point and new-point both equal
+ ;; nil, compare the posn areas and nominal
+ ;; column position. If either are
+ ;; different, generate a drag event.
+ (let ((new-col-row (posn-col-row posn))
+ (new-area (posn-area posn))
+ (old-col-row (posn-col-row old-posn))
+ (old-area (posn-area old-posn)))
+ (if (and (equal new-col-row old-col-row)
+ (eq new-area old-area))
+ ;; ... generate a mouse-1 event...
+ (list 'mouse-1 posn)
+ ;; ... otherwise, generate a
+ ;; drag-mouse-1 event.
+ (list 'drag-mouse-1 old-posn posn)))
+ (if (and (eq new-window old-window)
+ (eq new-point old-point)
+ (windowp new-window)
+ (windowp old-window))
+ ;; ... generate a mouse-1 event...
+ (list 'mouse-1 posn)
+ ;; ... otherwise, generate a drag-mouse-1
+ ;; event.
+ (list 'drag-mouse-1 old-posn posn))))))
+ ((eq what 'mouse-1-menu)
+ ;; Generate a `down-mouse-1' event at the position the tap
+ ;; took place.
(throw 'input-event
- ;; If the position of the touch point hasn't
- ;; changed, or it doesn't start or end on a
- ;; window...
- (if (and (not old-point) (not new-point))
- ;; Should old-point and new-point both equal
- ;; nil, compare the posn areas and nominal
- ;; column position. If either are different,
- ;; generate a drag event.
- (let ((new-col-row (posn-col-row posn))
- (new-area (posn-area posn))
- (old-col-row (posn-col-row old-posn))
- (old-area (posn-area old-posn)))
- (if (and (equal new-col-row old-col-row)
- (eq new-area old-area))
- ;; ... generate a mouse-1 event...
- (list 'mouse-1 posn)
- ;; ... otherwise, generate a drag-mouse-1 event.
- (list 'drag-mouse-1 old-posn posn)))
- (if (and (eq new-window old-window)
- (eq new-point old-point)
- (windowp new-window)
- (windowp old-window))
- ;; ... generate a mouse-1 event...
- (list 'mouse-1 posn)
- ;; ... otherwise, generate a drag-mouse-1 event.
- (list 'drag-mouse-1 old-posn posn))))))
- ((eq what 'mouse-1-menu)
- ;; Generate a `down-mouse-1' event at the position the tap
- ;; took place.
- (throw 'input-event
- (list 'down-mouse-1
- (nth 4 touch-screen-current-tool))))
- ((or (eq what 'drag)
- ;; Merely initiating a drag is sufficient to select a
- ;; word if word selection is enabled.
- (eq what 'held))
- ;; Display the on screen keyboard if the region is now
- ;; active. Check this within the window where the tool was
- ;; first place.
- (setq window (nth 1 touch-screen-current-tool))
- (when window
- (with-selected-window window
- (when (and (region-active-p)
- (not buffer-read-only))
- ;; Once the on-screen keyboard has been opened, add
- ;; `touch-screen-window-selection-changed' as a window
- ;; selection change function This then prevents it from
- ;; being hidden after exiting the minibuffer.
- (progn
- (add-hook 'window-selection-change-functions
- #'touch-screen-window-selection-changed)
- (frame-toggle-on-screen-keyboard (selected-frame)
- nil)))))))))
+ (list 'down-mouse-1
+ (nth 4 touch-screen-current-tool))))
+ ((or (eq what 'drag)
+ ;; Merely initiating a drag is sufficient to select a
+ ;; word if word selection is enabled.
+ (eq what 'held))
+ ;; Display the on screen keyboard if the region is now
+ ;; active. Check this within the window where the tool
+ ;; was first place.
+ (setq window (nth 1 touch-screen-current-tool))
+ (when window
+ (with-selected-window window
+ (when (and (region-active-p)
+ (not buffer-read-only))
+ ;; Once the on-screen keyboard has been opened, add
+ ;; `touch-screen-window-selection-changed' as a
+ ;; window selection change function. This then
+ ;; prevents it from being hidden after exiting the
+ ;; minibuffer.
+ (progn
+ (add-hook 'window-selection-change-functions
+ #'touch-screen-window-selection-changed)
+ (frame-toggle-on-screen-keyboard (selected-frame)
+ nil))))))))))
(defun touch-screen-handle-touch (event prefix &optional interactive)
"Handle a single touch EVENT, and perform associated actions.
@@ -1207,8 +1456,15 @@ If INTERACTIVE, execute the command associated with any
event
generated instead of throwing `input-event'. Otherwise, throw
`input-event' with a single input event if that event should take
the place of EVENT within the key sequence being translated, or
-`nil' if all tools have been released."
+`nil' if all tools have been released.
+
+Set `touch-screen-events-received' to `t' to indicate that touch
+screen events have been received, and thus by extension require
+functions undertaking event management themselves to call
+`read-key' rather than `read-event'."
(interactive "e\ni\np")
+ (unless touch-screen-events-received
+ (setq touch-screen-events-received t))
(if interactive
;; Called interactively (probably from wid-edit.el.)
;; Add any event generated to `unread-command-events'.
@@ -1234,81 +1490,151 @@ the place of EVENT within the key sequence being
translated, or
(when touch-screen-current-timer
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
- ;; Replace any previously ongoing gesture. If POSITION has no
- ;; window or position, make it nil instead.
- (setq tool-list (and (windowp window)
- (list touchpoint window
- (posn-x-y position)
- nil position
- nil nil nil nil))
- touch-screen-current-tool tool-list)
-
- ;; Select the window underneath the event as the checks below
- ;; will look up keymaps and markers inside its buffer.
- (save-selected-window
- ;; Check if `touch-screen-extend-selection' is enabled, the
- ;; tap lies on the point or the mark, and the region is
- ;; active. If that's the case, set the fourth element of
- ;; `touch-screen-current-tool' to `restart-drag', then
- ;; generate a `touchscreen-restart-drag' event.
- (when tool-list
- ;; tool-list is always non-nil where the selected window
- ;; matters.
- (select-window window)
- (when (and touch-screen-extend-selection
- (or (eq point (point))
- (eq point (mark)))
- (region-active-p)
- ;; Only restart drag-to-select if the tap falls
- ;; on the same row as the selection. This
- ;; prevents dragging from starting if the tap
- ;; is below the last window line with text and
- ;; `point' is at ZV, as the user most likely
- ;; meant to scroll the window instead.
- (when-let* ((posn-point (posn-at-point point))
- (posn-row (cdr (posn-col-row posn-point))))
- (eq (cdr (posn-col-row position)) posn-row)))
- ;; Indicate that a drag is about to restart.
- (setcar (nthcdr 3 tool-list) 'restart-drag)
- ;; Generate the `restart-drag' event.
- (throw 'input-event (list 'touchscreen-restart-drag
- position))))
- ;; Determine if there is a command bound to `down-mouse-1'
- ;; at the position of the tap and that command is not a
- ;; command whose functionality is replaced by the long-press
- ;; mechanism. If so, set the fourth element of
- ;; `touch-screen-current-tool' to `mouse-drag' and generate
- ;; an emulated `mouse-1' event.
- ;;
- ;; If the command in question is a keymap, set that element
- ;; to `mouse-1-menu' instead of `mouse-drag', and don't
- ;; generate a `down-mouse-1' event immediately. Instead,
- ;; wait for the touch point to be released.
- (if (and tool-list
- (and (setq binding
- (key-binding (if prefix
- (vector prefix
- 'down-mouse-1)
- [down-mouse-1])
- t nil position))
- (not (and (symbolp binding)
- (get binding 'ignored-mouse-command)))))
- (if (or (keymapp binding)
- (and (symbolp binding)
- (get binding 'mouse-1-menu-command)))
- ;; binding is a keymap, or a command that does
- ;; almost the same thing. If a `mouse-1' event is
- ;; generated after the keyboard command loop
- ;; displays it as a menu, that event could cause
- ;; unwanted commands to be run. Set what to
- ;; `mouse-1-menu' instead and wait for the up event
- ;; to display the menu.
- (setcar (nthcdr 3 tool-list) 'mouse-1-menu)
- (progn (setcar (nthcdr 3 tool-list) 'mouse-drag)
- (throw 'input-event (list 'down-mouse-1 position))))
- (and point
- ;; Start the long-press timer.
- (touch-screen-handle-timeout nil))))))
+ ;; If a tool already exists...
+ (if (and touch-screen-current-tool
+ ;; ..and the number of this tool is at variance with
+ ;; that of the current tool: if a `touchscreen-end'
+ ;; event is delivered that is somehow withheld from
+ ;; this function and the system does not assign
+ ;; monotonically increasing touch point identifiers,
+ ;; then the ancillary tool will be set to a tool
+ ;; bearing the same number as the current tool, and
+ ;; consequently the mechanism for detecting
+ ;; erroneously retained touch points upon the
+ ;; registration of `touchscreen-update' events will
+ ;; not be activated.
+ (not (eq touchpoint (car touch-screen-current-tool))))
+ ;; Then record this tool as the ``auxiliary tool''.
+ ;; Updates to the auxiliary tool are considered in unison
+ ;; with those to the current tool; the distance between
+ ;; both tools is measured and compared with that when the
+ ;; auxiliary tool was first pressed, then interpreted as a
+ ;; scale by which to adjust text within the current tool's
+ ;; window.
+ (when (eq (if (framep window) window (window-frame window))
+ ;; Verify that the new tool was placed on the
+ ;; same frame the current tool has, so as not to
+ ;; consider events distributed across distinct
+ ;; frames components of a single gesture.
+ (window-frame (nth 1 touch-screen-current-tool)))
+ ;; Set touch-screen-aux-tool as is proper. Mind that
+ ;; the last field is always relative to the current
+ ;; tool's window.
+ (let* ((window (nth 1 touch-screen-current-tool))
+ (relative-x-y (touch-screen-relative-xy position
+ window))
+ (initial-pos (nth 4 touch-screen-current-tool))
+ (initial-x-y (touch-screen-relative-xy initial-pos
+ window))
+ computed-distance computed-centrum)
+ ;; Calculate the distance and centrum from this point
+ ;; to the initial position of the current tool.
+ (setq computed-distance (touch-screen-distance relative-x-y
+ initial-x-y)
+ computed-centrum (touch-screen-centrum relative-x-y
+ initial-x-y))
+ ;; If computed-distance is zero, ignore this tap.
+ (unless (zerop computed-distance)
+ (setq touch-screen-aux-tool (vector touchpoint window
+ position relative-x-y
+ computed-distance
+ computed-centrum
+ 1.0 nil nil nil)))
+ ;; When an auxiliary tool is pressed, any gesture
+ ;; previously in progress must be terminated, so long
+ ;; as it represents a gesture recognized from the
+ ;; current tool's motion rather than ones detected by
+ ;; this function from circumstances surrounding its
+ ;; first press, such as the presence of a menu or
+ ;; down-mouse-1 button beneath its first press.
+ (unless (memq (nth 3 touch-screen-current-tool)
+ '(mouse-drag mouse-1-menu))
+ ;; Set the what field to the symbol `ancillary-tool'
+ ;; rather than nil, that mouse events may not be
+ ;; generated if no gesture is subsequently
+ ;; recognized; this, among others, prevents
+ ;; undesirable point movement (through the execution
+ ;; of `mouse-set-point') after both points are
+ ;; released without any gesture being detected.
+ (setcar (nthcdr 3 touch-screen-current-tool)
+ 'ancillary-tool))))
+ ;; Replace any previously ongoing gesture. If POSITION has no
+ ;; window or position, make it nil instead.
+ (setq tool-list (and (windowp window)
+ (list touchpoint window
+ (posn-x-y position)
+ nil position
+ nil nil nil nil
+ (posn-x-y position)))
+ touch-screen-current-tool tool-list)
+ ;; Select the window underneath the event as the checks below
+ ;; will look up keymaps and markers inside its buffer.
+ (save-selected-window
+ ;; Check if `touch-screen-extend-selection' is enabled,
+ ;; the tap lies on the point or the mark, and the region
+ ;; is active. If that's the case, set the fourth element
+ ;; of `touch-screen-current-tool' to `restart-drag', then
+ ;; generate a `touchscreen-restart-drag' event.
+ (when tool-list
+ ;; tool-list is always non-nil where the selected window
+ ;; matters.
+ (select-window window)
+ (when (and touch-screen-extend-selection
+ (or (eq point (point))
+ (eq point (mark)))
+ (region-active-p)
+ ;; Only restart drag-to-select if the tap
+ ;; falls on the same row as the selection.
+ ;; This prevents dragging from starting if
+ ;; the tap is below the last window line with
+ ;; text and `point' is at ZV, as the user
+ ;; most likely meant to scroll the window
+ ;; instead.
+ (when-let* ((posn-point (posn-at-point point))
+ (posn-row (cdr
+ (posn-col-row posn-point))))
+ (eq (cdr (posn-col-row position)) posn-row)))
+ ;; Indicate that a drag is about to restart.
+ (setcar (nthcdr 3 tool-list) 'restart-drag)
+ ;; Generate the `restart-drag' event.
+ (throw 'input-event (list 'touchscreen-restart-drag
+ position))))
+ ;; Determine if there is a command bound to `down-mouse-1'
+ ;; at the position of the tap and that command is not a
+ ;; command whose functionality is replaced by the
+ ;; long-press mechanism. If so, set the fourth element of
+ ;; `touch-screen-current-tool' to `mouse-drag' and
+ ;; generate an emulated `mouse-1' event.
+ ;;
+ ;; If the command in question is a keymap, set that
+ ;; element to `mouse-1-menu' instead of `mouse-drag', and
+ ;; don't generate a `down-mouse-1' event immediately.
+ ;; Instead, wait for the touch point to be released.
+ (if (and tool-list
+ (and (setq binding
+ (key-binding (if prefix
+ (vector prefix
+ 'down-mouse-1)
+ [down-mouse-1])
+ t nil position))
+ (not (and (symbolp binding)
+ (get binding 'ignored-mouse-command)))))
+ (if (or (keymapp binding)
+ (and (symbolp binding)
+ (get binding 'mouse-1-menu-command)))
+ ;; binding is a keymap, or a command that does
+ ;; almost the same thing. If a `mouse-1' event is
+ ;; generated after the keyboard command loop
+ ;; displays it as a menu, that event could cause
+ ;; unwanted commands to be run. Set what to
+ ;; `mouse-1-menu' instead and wait for the up
+ ;; event to display the menu.
+ (setcar (nthcdr 3 tool-list) 'mouse-1-menu)
+ (progn (setcar (nthcdr 3 tool-list) 'mouse-drag)
+ (throw 'input-event (list 'down-mouse-1 position))))
+ (and point
+ ;; Start the long-press timer.
+ (touch-screen-handle-timeout nil)))))))
((eq (car event) 'touchscreen-update)
(unless touch-screen-current-tool
;; If a stray touchscreen-update event arrives (most likely
@@ -1317,10 +1643,35 @@ the place of EVENT within the key sequence being
translated, or
;; The positions of tools currently pressed against the screen
;; have changed. If there is a tool being tracked as part of a
;; gesture, look it up in the list of tools.
- (let ((new-point (assq (car touch-screen-current-tool)
- (cadr event))))
- (when new-point
- (touch-screen-handle-point-update new-point))))
+ (if-let ((new-point (assq (car touch-screen-current-tool)
+ (cadr event))))
+ (if touch-screen-aux-tool
+ (touch-screen-handle-aux-point-update (cdr new-point)
+ (car new-point))
+ (touch-screen-handle-point-update new-point))
+ ;; If the current tool exists no longer, a touchscreen-end
+ ;; event is certain to have been disregarded. So that
+ ;; touchscreen gesture translation might continue as usual
+ ;; after this aberration to the normal flow of events, delete
+ ;; the current tool now.
+ (when touch-screen-current-timer
+ ;; Cancel the touch screen long-press timer, if it is still
+ ;; there by any chance.
+ (cancel-timer touch-screen-current-timer)
+ (setq touch-screen-current-timer nil))
+ ;; Don't call `touch-screen-handle-point-up' when terminating
+ ;; translation abnormally.
+ (setq touch-screen-current-tool nil
+ ;; Delete the ancillary tool while at it.
+ touch-screen-aux-tool nil)
+ (message "Current touch screen tool vanished!"))
+ ;; Check for updates to any ancillary point being monitored.
+ (when touch-screen-aux-tool
+ (let ((new-point (assq (aref touch-screen-aux-tool 0)
+ (cadr event))))
+ (when new-point
+ (touch-screen-handle-aux-point-update (cdr new-point)
+ (car new-point))))))
((eq (car event) 'touchscreen-end)
;; A tool has been removed from the screen. If it is the tool
;; currently being tracked, clear `touch-screen-current-tool'.
@@ -1330,15 +1681,38 @@ the place of EVENT within the key sequence being
translated, or
(when touch-screen-current-timer
(cancel-timer touch-screen-current-timer)
(setq touch-screen-current-timer nil))
- (unwind-protect
- ;; Don't perform any actions associated with releasing the
- ;; tool if the touch sequence was intercepted by another
- ;; program.
- (unless (caddr event)
- (touch-screen-handle-point-up (cadr event) prefix))
- ;; Make sure the tool list is cleared even if
- ;; `touch-screen-handle-point-up' throws.
- (setq touch-screen-current-tool nil)))
+ (let ((old-aux-tool touch-screen-aux-tool))
+ (unwind-protect
+ ;; Don't perform any actions associated with releasing the
+ ;; tool if the touch sequence was intercepted by another
+ ;; program.
+ (if (caddr event)
+ (setq touch-screen-current-tool nil)
+ (touch-screen-handle-point-up (cadr event) prefix))
+ ;; If an ancillary tool is present the function call above
+ ;; will merely transfer information from it into the current
+ ;; tool list, thereby rendering it the new current tool,
+ ;; until such time as it too is released.
+ (when (not (and old-aux-tool (not touch-screen-aux-tool)))
+ ;; Make sure the tool list is cleared even if
+ ;; `touch-screen-handle-point-up' throws.
+ (setq touch-screen-current-tool nil)))))
+ ;; If it is rather the ancillary tool, delete its vector. No
+ ;; further action is required, for the next update received will
+ ;; resume regular gesture recognition.
+ ;;
+ ;; The what field in touch-screen-current-tool is set to a
+ ;; signal value when the ancillary tool is pressed, so gesture
+ ;; recognition will commence with a clean slate, save for when
+ ;; the first touch landed atop a menu or some other area
+ ;; down-mouse-1 was bound.
+ ;;
+ ;; Gesture recognition will be inhibited in that case, so that
+ ;; mouse menu or mouse motion events are generated in its place
+ ;; as they would be were no ancillary tool ever pressed.
+ (when (and touch-screen-aux-tool
+ (eq (caadr event) (aref touch-screen-aux-tool 0)))
+ (setq touch-screen-aux-tool nil))
;; Throw to the key translation function.
(throw 'input-event nil)))))
@@ -1539,7 +1913,7 @@ if POSN is on a link or a button, or `mouse-1' otherwise."
;; Exports. These functions are intended for use externally.
-(defun touch-screen-track-tap (event &optional update data)
+(defun touch-screen-track-tap (event &optional update data threshold)
"Track a single tap starting from EVENT.
EVENT should be a `touchscreen-begin' event.
@@ -1549,16 +1923,45 @@ a `touchscreen-update' event is received in the mean
time and
contains a touch point with the same ID as in EVENT, call UPDATE
with that event and DATA.
+If THRESHOLD is non-nil, enforce a threshold of movement that is
+either itself or 10 pixels when it is not a number. If the
+aformentioned touch point moves beyond that threshold on any
+axis, return nil immediately, and further resume mouse event
+translation for the touch point at hand.
+
Return nil immediately if any other kind of event is received;
otherwise, return t once the `touchscreen-end' event arrives."
- (let ((disable-inhibit-text-conversion t))
+ (let ((disable-inhibit-text-conversion t)
+ (threshold (and threshold (or (and (numberp threshold)
+ threshold)
+ 10)))
+ (original-x-y (posn-x-y (cdadr event)))
+ (original-window (posn-window (cdadr event))))
(catch 'finish
(while t
- (let ((new-event (read-event nil)))
+ (let ((new-event (read-event nil))
+ touch-point)
(cond
((eq (car-safe new-event) 'touchscreen-update)
- (when (and update (assq (caadr event) (cadr new-event)))
- (funcall update new-event data)))
+ (when (setq touch-point (assq (caadr event) (cadr new-event)))
+ (when update
+ (funcall update new-event data))
+ (when threshold
+ (setq touch-point (cdr touch-point))
+ ;; Detect the touch point moving past the threshold.
+ (let* ((x-y (touch-screen-relative-xy touch-point
+ original-window))
+ (x (car x-y)) (y (cdr x-y)))
+ (when (or (> (abs (- x (car original-x-y))) threshold)
+ (> (abs (- y (cdr original-x-y))) threshold))
+ ;; Resume normal touch-screen to mouse event
+ ;; translation for this touch sequence by
+ ;; supplying both the event starting it and the
+ ;; motion event that overstepped the threshold to
+ ;; touch-screen-handle-touch.
+ (touch-screen-handle-touch event nil t)
+ (touch-screen-handle-touch new-event nil t)
+ (throw 'finish nil))))))
((eq (car-safe new-event) 'touchscreen-end)
(throw 'finish
;; Now determine whether or not the `touchscreen-end'
diff --git a/lisp/transient.el b/lisp/transient.el
index 52c21871548..dd2b4e0db0b 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -1959,10 +1959,11 @@ value. Otherwise return CHILDREN as is."
(if-not-mode (not (if (atom if-not-mode)
(eq major-mode if-not-mode)
(memq major-mode if-not-mode))))
- (if-derived (if (atom if-derived)
+ (if-derived (if (or (atom if-derived) (>= emacs-major-version 30))
(derived-mode-p if-derived)
(apply #'derived-mode-p if-derived)))
- (if-not-derived (not (if (atom if-not-derived)
+ (if-not-derived (not (if (or (atom if-not-derived)
+ (>= emacs-major-version 30))
(derived-mode-p if-not-derived)
(apply #'derived-mode-p if-not-derived))))
(t default)))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 45c5f313a8e..da8226f7d8a 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1565,7 +1565,7 @@ MATCHER:
NODE's index in PARENT. Therefore, to match the first child
where PARENT is \"argument_list\", use
- (match nil \"argument_list\" nil nil 0 0).
+ (match nil \"argument_list\" nil 0 0).
NODE-TYPE, PARENT-TYPE, and NODE-FIELD are regexps.
NODE-TYPE can also be `null', which matches when NODE is nil.
@@ -2034,7 +2034,8 @@ BACKWARD and ALL are the same as in
`treesit-search-forward'."
(goto-char current-pos)))
node))
-(make-obsolete 'treesit-sexp-type-regexp "`treesit-sexp-type-regexp' will be
removed in a few months, use `treesit-thing-settings' instead." "30.0.5")
+(make-obsolete 'treesit-sexp-type-regexp
+ "`treesit-sexp-type-regexp' will be removed soon, use
`treesit-thing-settings' instead." "30.1")
(defvar-local treesit-sexp-type-regexp nil
"A regexp that matches the node type of sexp nodes.
@@ -2304,7 +2305,8 @@ set, Emacs also looks for definition of defun in
(throw 'done nil)
(setq arg (if (> arg 0) (1+ arg) (1- arg))))))))
-(make-obsolete 'treesit-text-type-regexp "`treesit-text-type-regexp' will be
removed in a few months, use `treesit-thing-settings' instead." "30.0.5")
+(make-obsolete 'treesit-text-type-regexp
+ "`treesit-text-type-regexp' will be removed soon, use
`treesit-thing-settings' instead." "30.1")
(defvar-local treesit-text-type-regexp "\\`comment\\'"
"A regexp that matches the node type of textual nodes.
@@ -2315,7 +2317,8 @@ comments and multiline string literals. For example,
\"text_block\" in the case of a string. This is used by
`prog-fill-reindent-defun' and friends.")
-(make-obsolete 'treesit-sentence-type-regexp "`treesit-sentence-type-regexp'
will be removed in a few months, use `treesit-thing-settings' instead."
"30.0.5")
+(make-obsolete 'treesit-sentence-type-regexp
+ "`treesit-sentence-type-regexp' will be removed soon, use
`treesit-thing-settings' instead." "30.1")
(defvar-local treesit-sentence-type-regexp nil
"A regexp that matches the node type of sentence nodes.
@@ -2359,7 +2362,8 @@ the current line if the beginning of the defun is
indented."
(line-beginning-position))
(beginning-of-line))))
-(make-obsolete 'treesit--things-around "`treesit--things-around' will be
removed in a few months, use `treesit--thing-prev', `treesit--thing-next',
`treesit--thing-at' instead." "30.0.5")
+(make-obsolete 'treesit--things-around
+ "`treesit--things-around' will be removed soon, use
`treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead."
"30.1")
(defun treesit--things-around (pos thing)
"Return the previous, next, and parent thing around POS.
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 1463335d40f..e11b4a6a58e 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -83,18 +83,20 @@ PASSWORD - What password to use.
(pass (url-password url))
(user (url-user url))
(chan (url-filename url))
- (type (url-type url))
- (compatp (eql 5 (cdr (func-arity url-irc-function)))))
+ (type (url-type url)))
(if (url-target url)
(setq chan (concat chan "#" (url-target url))))
(if (string-match "^/" chan)
(setq chan (substring chan 1 nil)))
(if (= (length chan) 0)
(setq chan nil))
- (when compatp
- (lwarn 'url :error "Obsolete value for `url-irc-function'"))
- (apply url-irc-function
- host port chan user pass (unless compatp (list type)))
+ (condition-case nil
+ (funcall url-irc-function host port chan user pass type)
+ (wrong-number-of-arguments
+ (display-warning 'url
+ (concat "Incompatible value for `url-irc-function'."
+ " Likely not expecting a 6th (SCHEME) arg."))
+ (funcall url-irc-function host port chan user pass)))
nil))
;;;; ircs://
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 4623608f1db..91d5b7308dd 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -64,10 +64,11 @@ in any way you like."
(match-string 0 opponent)))
opponent))
(while (null answer)
+ (when noninteractive
+ (signal 'file-locked (list file opponent "Cannot resolve lock
conflict in batch mode")))
(message (substitute-command-keys
"%s locked by %s: (\\`s', \\`q', \\`p', \\`?')? ")
short-file short-opponent)
- (if noninteractive (error "Cannot resolve lock conflict in batch mode"))
(let ((tem (let ((inhibit-quit t)
(cursor-in-echo-area t))
(prog1 (downcase (read-char))
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 707fc7cfc07..2e057ecfaa7 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -423,7 +423,9 @@ in the order given by `git status'."
(rev (vc-working-revision file 'Git))
(disp-rev (or (vc-git--symbolic-ref file)
(and rev (substring rev 0 7))))
- (state-string (concat backend-name indicator disp-rev)))
+ (state-string (concat (unless (eq vc-display-status 'no-backend)
+ backend-name)
+ indicator disp-rev)))
(propertize state-string 'face face 'help-echo
(concat state-echo " under the " backend-name
" version control system"
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 89b2814a0a3..9df517ea847 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -365,7 +365,9 @@ specific file to query."
(and vc-hg-use-file-version-for-mode-line-version
truename)))))
(rev (or rev "???"))
- (state-string (concat backend-name indicator rev)))
+ (state-string (concat (unless (eq vc-display-status 'no-backend)
+ backend-name)
+ indicator rev)))
(propertize state-string 'face face 'help-echo
(concat state-echo " under the " backend-name
" version control system"))))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index c16fb63b2ff..8451128286b 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -152,8 +152,12 @@ visited and a warning displayed."
(defcustom vc-display-status t
"If non-nil, display revision number and lock status in mode line.
-Otherwise, not displayed."
- :type 'boolean
+If nil, only the backend name is displayed. When the value
+is `no-backend', then no backend name is displayed before the
+revision number and lock status."
+ :type '(choice (const :tag "Show only revision/status" no-backend)
+ (const :tag "Show backend and revision/status" t)
+ (const :tag "Show only backend name" nil))
:group 'vc)
@@ -766,7 +770,9 @@ This function assumes that the file is registered."
(rev (vc-working-revision file backend))
(`(,state-echo ,face ,indicator)
(vc-mode-line-state state))
- (state-string (concat backend-name indicator rev)))
+ (state-string (concat (unless (eq vc-display-status 'no-backend)
+ backend-name)
+ indicator rev)))
(propertize state-string 'face face 'help-echo
(concat state-echo " under the " backend-name
" version control system"))))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 95f9218dcbf..1bd9ecb2193 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1071,14 +1071,20 @@ 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
+ '(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.")
+
(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)
- ;; Maybe we could even use comint-mode rather than shell-mode?
- ((derived-mode-p
- 'dired-mode 'shell-mode 'eshell-mode 'compilation-mode)
+ ((or (null vc-deduce-backend-nonvc-modes)
+ (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 7b9c75d36b1..079d93d6011 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -453,7 +453,7 @@ non-nil means return old filename."
(force-mode-line-update)
(setq buffer-read-only t)
(setq major-mode 'dired-mode)
- (setq mode-name "Dired")
+ (dired-sort-set-mode-line)
(dired-advertise)
(dired-hide-details-update-invisibility-spec)
(remove-hook 'kill-buffer-hook #'wdired-check-kill-buffer t)
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index 86fc179396e..f4095c99089 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1026,8 +1026,8 @@ See also `whitespace-newline' and
`whitespace-display-mappings'."
((eq whitespace-global-modes t))
((listp whitespace-global-modes)
(if (eq (car-safe whitespace-global-modes) 'not)
- (not (apply #'derived-mode-p (cdr whitespace-global-modes)))
- (apply #'derived-mode-p whitespace-global-modes)))
+ (not (derived-mode-p (cdr whitespace-global-modes)))
+ (derived-mode-p whitespace-global-modes)))
(t nil))
;; ...we have a display (not running a batch job)
(not noninteractive)
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index 74412414113..6ae00171d84 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1127,7 +1127,7 @@ If nothing was called, return non-nil."
;; This a touchscreen event and must be handled
;; specially through `touch-screen-track-tap'.
(progn
- (unless (touch-screen-track-tap event)
+ (unless (touch-screen-track-tap event nil nil t)
(throw 'button-press-cancelled t)))
(unless (widget-apply button :mouse-down-action event)
(let ((track-mouse t))
diff --git a/lisp/window.el b/lisp/window.el
index 06d5cfc0077..0c5ccf167dc 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8054,10 +8054,8 @@ indirectly called by the latter."
(dolist (window windows)
(let ((mode?
(with-current-buffer (window-buffer window)
- (cond ((memq major-mode allowed-modes)
- 'same)
- ((apply #'derived-mode-p allowed-modes)
- 'derived)))))
+ (cond ((memq major-mode allowed-modes) 'same)
+ ((derived-mode-p allowed-modes) 'derived)))))
(when (and mode?
(not (and inhibit-same-window-p
(eq window curwin))))
diff --git a/src/android.c b/src/android.c
index 7a670cb507f..7ca5eab817c 100644
--- a/src/android.c
+++ b/src/android.c
@@ -1628,6 +1628,10 @@ android_init_emacs_service (void)
"Ljava/lang/String;)Ljava/lang/String;");
FIND_METHOD (valid_authority, "validAuthority",
"(Ljava/lang/String;)Z");
+ FIND_METHOD (external_storage_available,
+ "externalStorageAvailable", "()Z");
+ FIND_METHOD (request_storage_access,
+ "requestStorageAccess", "()V");
#undef FIND_METHOD
}
@@ -1965,7 +1969,7 @@ NATIVE_NAME (shutDownEmacs) (JNIEnv *env, jobject object)
static void
android_on_low_memory (void *closure)
{
- Fclear_image_cache (Qt, Qt);
+ Fclear_image_cache (Qt, Qnil);
garbage_collect ();
}
@@ -6558,6 +6562,57 @@ android_request_directory_access (void)
return rc;
}
+/* Return whether Emacs is entitled to access external storage.
+
+ On Android 5.1 and earlier, such permissions as are declared within
+ an application's manifest are granted during installation and are
+ irrevocable.
+
+ On Android 6.0 through Android 10.0, the right to read external
+ storage is a regular permission granted from the Permissions
+ panel.
+
+ On Android 11.0 and later, that right must be granted through an
+ independent ``Special App Access'' settings panel. */
+
+bool
+android_external_storage_available_p (void)
+{
+ jboolean rc;
+ jmethodID method;
+
+ if (android_api_level <= 22) /* LOLLIPOP_MR1 */
+ return true;
+
+ method = service_class.external_storage_available;
+ rc = (*android_java_env)->CallNonvirtualBooleanMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method);
+ android_exception_check ();
+
+ return rc;
+}
+
+/* Display a dialog from which the aforementioned rights can be
+ granted. */
+
+void
+android_request_storage_access (void)
+{
+ jmethodID method;
+
+ if (android_api_level <= 22) /* LOLLIPOP_MR1 */
+ return;
+
+ method = service_class.request_storage_access;
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
+ emacs_service,
+ service_class.class,
+ method);
+ android_exception_check ();
+}
+
/* The thread from which a query against a thread is currently being
diff --git a/src/android.h b/src/android.h
index 28d9d25930e..12f9472836f 100644
--- a/src/android.h
+++ b/src/android.h
@@ -123,6 +123,8 @@ extern void android_wait_event (void);
extern void android_toggle_on_screen_keyboard (android_window, bool);
extern _Noreturn void android_restart_emacs (void);
extern int android_request_directory_access (void);
+extern bool android_external_storage_available_p (void);
+extern void android_request_storage_access (void);
extern int android_get_current_api_level (void)
__attribute__ ((pure));
@@ -289,6 +291,8 @@ struct android_emacs_service
jmethodID rename_document;
jmethodID move_document;
jmethodID valid_authority;
+ jmethodID external_storage_available;
+ jmethodID request_storage_access;
};
extern JNIEnv *android_java_env;
diff --git a/src/androidfns.c b/src/androidfns.c
index 772a4f51e78..31a4924e34d 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -367,8 +367,16 @@ android_change_tab_bar_height (struct frame *f, int height)
the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
leading to the tab bar height being incorrectly set upon the next
call to android_set_font. (bug#59285) */
+
lines = height / unit;
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
+ if (lines == 0 && height != 0)
+ lines = 1;
+
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -3096,6 +3104,42 @@ within the directory `/content/storage'. */)
+/* Functions concerning storage permissions. */
+
+DEFUN ("android-external-storage-available-p",
+ Fandroid_external_storage_available_p,
+ Sandroid_external_storage_available_p, 0, 0, 0,
+ doc: /* Return non-nil if Emacs is entitled to access external storage.
+Return nil if the requisite permissions for external storage access
+have not been granted to Emacs, t otherwise. Such permissions can be
+requested by means of the `android-request-storage-access'
+command.
+
+External storage on Android encompasses the `/sdcard' and
+`/storage/emulated' directories, access to which is denied to programs
+absent these permissions. */)
+ (void)
+{
+ return android_external_storage_available_p () ? Qt : Qnil;
+}
+
+DEFUN ("android-request-storage-access", Fandroid_request_storage_access,
+ Sandroid_request_storage_access, 0, 0, "",
+ doc: /* Request permissions to access external storage.
+
+Return nil regardless of whether access permissions are granted or not,
+immediately after displaying the permissions request dialog.
+
+Use `android-external-storage-available-p' (which see) to verify
+whether Emacs has actually received such access permissions. */)
+ (void)
+{
+ android_request_storage_access ();
+ return Qnil;
+}
+
+
+
/* Miscellaneous input method related stuff. */
/* Report X, Y, by the phys cursor width and height as the cursor
@@ -3302,6 +3346,8 @@ bell being rung. */);
#ifndef ANDROID_STUBIFY
defsubr (&Sandroid_query_battery);
defsubr (&Sandroid_request_directory_access);
+ defsubr (&Sandroid_external_storage_available_p);
+ defsubr (&Sandroid_request_storage_access);
tip_timer = Qnil;
staticpro (&tip_timer);
diff --git a/src/androidterm.c b/src/androidterm.c
index 1593cac36ba..cfb64cd69a0 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -1377,7 +1377,7 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
{
/* Simply update the tool position and send an update. */
touchpoint->x = event->touch.x;
- touchpoint->y = event->touch.x;
+ touchpoint->y = event->touch.y;
android_update_tools (any, &inev.ie);
inev.ie.timestamp = event->touch.time;
@@ -1390,7 +1390,7 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
touchpoint = xmalloc (sizeof *touchpoint);
touchpoint->tool_id = event->touch.pointer_id;
touchpoint->x = event->touch.x;
- touchpoint->y = event->touch.x;
+ touchpoint->y = event->touch.y;
touchpoint->next = FRAME_OUTPUT_DATA (any)->touch_points;
touchpoint->tool_bar_p = false;
FRAME_OUTPUT_DATA (any)->touch_points = touchpoint;
diff --git a/src/editfns.c b/src/editfns.c
index 1b739128a20..3f1d2462ab0 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -727,6 +727,7 @@ This function does not move point. Also see
`line-beginning-position'. */)
DEFUN ("line-beginning-position",
Fline_beginning_position, Sline_beginning_position, 0, 1, 0,
doc: /* Return the position of the first character in the current
line/field.
+With optional argument N non-nil, move forward N - 1 lines first.
This function is like `pos-bol' (which see), but respects fields.
This function constrains the returned position to the current field
@@ -2780,7 +2781,7 @@ labeled_restrictions_pop (Lisp_Object buf)
Lisp_Object restrictions = assq_no_quit (buf, labeled_restrictions);
if (NILP (restrictions))
return;
- if (EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction))
+ if (BASE_EQ (labeled_restrictions_peek_label (buf), Qoutermost_restriction))
labeled_restrictions_remove (buf);
else
XSETCDR (restrictions, list1 (XCDR (XCAR (XCDR (restrictions)))));
@@ -2920,7 +2921,7 @@ To gain access to other portions of the buffer, use
current_buffer are the bounds that were set by the user, no
labeled restriction is in effect in current_buffer anymore:
remove it from the labeled_restrictions alist. */
- if (EQ (label, Qoutermost_restriction))
+ if (BASE_EQ (label, Qoutermost_restriction))
labeled_restrictions_pop (buf);
}
/* Changing the buffer bounds invalidates any recorded current column. */
diff --git a/src/eval.c b/src/eval.c
index 859cc162562..f66353b7faf 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -703,7 +703,7 @@ lexbound_p (Lisp_Object symbol)
{
case SPECPDL_LET_DEFAULT:
case SPECPDL_LET:
- if (EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment))
+ if (BASE_EQ (specpdl_symbol (pdl), Qinternal_interpreter_environment))
{
Lisp_Object env = specpdl_old_value (pdl);
if (CONSP (env) && !NILP (Fassq (symbol, env)))
@@ -1709,6 +1709,10 @@ DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
This function does not return.
+When `noninteractive' is non-nil (in particular, in batch mode), an
+unhandled error calls `kill-emacs', which terminates the Emacs
+session with a non-zero exit code.
+
An error symbol is a symbol with an `error-conditions' property
that is a list of condition names. The symbol should be non-nil.
A handler for any of those names will get to handle this signal.
@@ -4145,7 +4149,7 @@ NFRAMES and BASE specify the activation frame to use, as
in `backtrace-frame'.
{
Lisp_Object sym = specpdl_symbol (tmp);
Lisp_Object val = specpdl_old_value (tmp);
- if (EQ (sym, Qinternal_interpreter_environment))
+ if (BASE_EQ (sym, Qinternal_interpreter_environment))
{
Lisp_Object env = val;
for (; CONSP (env); env = XCDR (env))
diff --git a/src/fileio.c b/src/fileio.c
index 8919e08e1fd..51937e6d765 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4778,7 +4778,7 @@ by calling `format-decode', which see. */)
make_gap (total - GAP_SIZE + 1);
if (beg_offset != 0 || (!NILP (replace)
- && !EQ (replace, Qunbound)))
+ && !BASE_EQ (replace, Qunbound)))
{
if (emacs_fd_lseek (fd, beg_offset, SEEK_SET) < 0)
report_file_error ("Setting file position", orig_filename);
diff --git a/src/fns.c b/src/fns.c
index b491e39b7ad..ccce2327736 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -3239,7 +3239,7 @@ by a mouse, or by some window-system gesture, or via a
menu. */)
&& (CONSP (last_nonmenu_event)
|| (NILP (last_nonmenu_event) && CONSP (last_input_event))
|| (val = find_symbol_value (Qfrom__tty_menu_p),
- (!NILP (val) && !EQ (val, Qunbound))))
+ (!NILP (val) && !BASE_EQ (val, Qunbound))))
&& use_dialog_box)
{
Lisp_Object pane, menu, obj;
diff --git a/src/haikufns.c b/src/haikufns.c
index 8028a73abd1..e6b1f618d5b 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -184,6 +184,11 @@ haiku_change_tab_bar_height (struct frame *f, int height)
leading to the tab bar height being incorrectly set upon the next
call to x_set_font. (bug#59285) */
int lines = height / unit;
+
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
if (lines == 0 && height != 0)
lines = 1;
diff --git a/src/image.c b/src/image.c
index 6e4f74c67b8..7621d71d5b5 100644
--- a/src/image.c
+++ b/src/image.c
@@ -2344,6 +2344,7 @@ evicted. */)
{
if (!NILP (animation_cache))
{
+ CHECK_CONS (animation_cache);
#if defined (HAVE_WEBP) || defined (HAVE_GIF)
anim_prune_animation_cache (XCDR (animation_cache));
#endif
diff --git a/src/keyboard.c b/src/keyboard.c
index 13cb7835dff..81605e75ba2 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1601,7 +1601,7 @@ command_loop_1 (void)
if ((!NILP (Fwindow_system (Qnil))
|| ((symval =
find_symbol_value (Qtty_select_active_regions),
- (!EQ (symval, Qunbound) && !NILP (symval)))
+ (!BASE_EQ (symval, Qunbound) && !NILP (symval)))
&& !NILP (Fterminal_parameter (Qnil,
Qxterm__set_selection))))
/* Even if mark_active is non-nil, the actual buffer
diff --git a/src/module-env-30.h b/src/module-env-30.h
index 6ca03773181..e75210c7f8e 100644
--- a/src/module-env-30.h
+++ b/src/module-env-30.h
@@ -1,3 +1,3 @@
- /* Add module environment functions newly added in Emacs 29 here.
- Before Emacs 29 is released, remove this comment and start
- module-env-30.h on the master branch. */
+ /* Add module environment functions newly added in Emacs 30 here.
+ Before Emacs 30 is released, remove this comment and start
+ module-env-31.h on the master branch. */
diff --git a/src/nsfns.m b/src/nsfns.m
index 038a3fa23ad..33c6020ad51 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -641,6 +641,11 @@ ns_change_tab_bar_height (struct frame *f, int height)
leading to the tab bar height being incorrectly set upon the next
call to x_set_font. (bug#59285) */
int lines = height / unit;
+
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
if (lines == 0 && height != 0)
lines = 1;
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index c154d37f47f..13ac61de960 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -475,6 +475,11 @@ pgtk_change_tab_bar_height (struct frame *f, int height)
leading to the tab bar height being incorrectly set upon the next
call to x_set_font. (bug#59285) */
int lines = height / unit;
+
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
if (lines == 0 && height != 0)
lines = 1;
diff --git a/src/search.c b/src/search.c
index 692d8488049..2996d32fca1 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3140,11 +3140,25 @@ update_search_regs (ptrdiff_t oldstart, ptrdiff_t
oldend, ptrdiff_t newend)
ptrdiff_t change = newend - oldend;
ptrdiff_t i;
+ /* When replacing subgroup 3 in a match for regexp '\(\)\(\(\)\)\(\)'
+ start[i] should ideally stay unchanged for all but i=4 and end[i]
+ should move for all but i=1.
+ We don't have enough info here to distinguish those different subgroups
+ (except for subgroup 0), so instead we lean towards leaving the start[i]s
+ unchanged and towards moving the end[i]s. */
+
for (i = 0; i < search_regs.num_regs; i++)
{
- if (search_regs.start[i] >= oldend)
+ if (search_regs.start[i] <= oldstart)
+ /* If the subgroup that 'replace-match' is modifying encloses the
+ subgroup 'i', then its 'start' position should stay unchanged.
+ That's always true for subgroup 0.
+ For other subgroups it depends on details we don't have, so
+ we optimistically assume that it also holds for them. */
+ ;
+ else if (search_regs.start[i] >= oldend)
search_regs.start[i] += change;
- else if (search_regs.start[i] > oldstart)
+ else
search_regs.start[i] = oldstart;
if (search_regs.end[i] >= oldend)
search_regs.end[i] += change;
diff --git a/src/sfntfont.c b/src/sfntfont.c
index 39b250ac11e..68e850779fc 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -3392,12 +3392,22 @@ sfntfont_open (struct frame *f, Lisp_Object font_entity,
(Vvertical_centering_font_regexp,
font->props[FONT_NAME_INDEX]) >= 0));
- /* And set a reasonable full name, namely the name of the font
- file. */
- font->props[FONT_FULLNAME_INDEX]
- = font->props[FONT_FILE_INDEX]
+ /* Set the name of the font file. */
+ font->props[FONT_FILE_INDEX]
= DECODE_FILE (build_unibyte_string (desc->path));
+ /* Encapsulate some information on the font useful while debugging
+ (along with being informative in general) in the font name. */
+
+ AUTO_STRING (format, "%s %s interpreted: %s upem: %s charset: %s"
+ " instance: %s");
+ font->props[FONT_FULLNAME_INDEX]
+ = CALLN (Fformat, format, desc->family, desc->style,
+ font_info->interpreter ? Qt : Qnil,
+ make_fixnum (font_info->head->units_per_em),
+ CHARSET_NAME (charset),
+ make_fixnum (instance));
+
/* All done. */
unblock_input ();
return font_object;
diff --git a/src/sqlite.c b/src/sqlite.c
index fd528f2b0d5..7135cc672bc 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -716,7 +716,9 @@ Only modules on Emacs' list of allowed modules can be
loaded. */)
"rtree",
"sha1",
"uuid",
+ "vector0",
"vfslog",
+ "vss0",
"zipfile",
NULL
};
diff --git a/src/w32fns.c b/src/w32fns.c
index 07b389df84a..01644eff826 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1732,6 +1732,11 @@ w32_change_tab_bar_height (struct frame *f, int height)
leading to the tab bar height being incorrectly set upon the next
call to x_set_font. (bug#59285) */
int lines = height / unit;
+
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
if (lines == 0 && height != 0)
lines = 1;
diff --git a/src/xdisp.c b/src/xdisp.c
index 253db6d9312..6a01c2dfda4 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3766,18 +3766,25 @@ start_display (struct it *it, struct window *w, struct
text_pos pos)
/* Don't reseat to previous visible line start if current start
position is in a string or image. */
- if (it->method == GET_FROM_BUFFER && it->line_wrap != TRUNCATE)
+ if (it->line_wrap != TRUNCATE)
{
- int first_y = it->current_y;
+ enum it_method method = it->method;
- /* If window start is not at a line start, skip forward to POS to
- get the correct continuation lines width. */
+ /* If window start is not at a line start, skip forward to POS
+ from the beginning of physical line to get the correct
+ continuation lines width. */
bool start_at_line_beg_p = (CHARPOS (pos) == BEGV
|| FETCH_BYTE (BYTEPOS (pos) - 1) == '\n');
if (!start_at_line_beg_p)
{
+ int first_y = it->current_y;
+ int continuation_width;
+ void *itdata = NULL;
+ struct it it2;
int new_x;
+ if (method != GET_FROM_BUFFER)
+ SAVE_IT (it2, *it, itdata);
reseat_at_previous_visible_line_start (it);
move_it_to (it, CHARPOS (pos), -1, -1, -1, MOVE_TO_POS);
@@ -3824,6 +3831,17 @@ start_display (struct it *it, struct window *w, struct
text_pos pos)
else if (it->current.dpvec_index >= 0)
it->current.dpvec_index = 0;
+ continuation_width = it->continuation_lines_width;
+ /* If we started from a position in something other than a
+ buffer, restore the original iterator state, keeping only
+ the continuation_lines_width, since we could now be very
+ far from the original position. */
+ if (method != GET_FROM_BUFFER)
+ {
+ RESTORE_IT (it, &it2, itdata);
+ it->continuation_lines_width = continuation_width;
+ }
+
/* We're starting a new display line, not affected by the
height of the continued line, so clear the appropriate
fields in the iterator structure. */
diff --git a/src/xfns.c b/src/xfns.c
index 0b1e94af9f0..eadf46b44c4 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1792,6 +1792,11 @@ x_change_tab_bar_height (struct frame *f, int height)
leading to the tab bar height being incorrectly set upon the next
call to x_set_font. (bug#59285) */
int lines = height / unit;
+
+ /* Even so, HEIGHT might be less than unit if the tab bar face is
+ not so tall as the frame's font height; which if true lines will
+ be set to 0 and the tab bar will thus vanish. */
+
if (lines == 0 && height != 0)
lines = 1;
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 06918f5901c..27056c99a50 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -643,6 +643,16 @@ inner loops respectively."
(funcall (car f) 3)
(list a b))
+ (let ((x (list 1)))
+ (let ((y x)
+ (z (setq x (vector x))))
+ (list x y z)))
+
+ (let ((x (list 1)))
+ (let* ((y x)
+ (z (setq x (vector x))))
+ (list x y z)))
+
(cond)
(mapcar (lambda (x) (cond ((= x 0)))) '(0 1))
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index c21f3935503..bfdf8cd7320 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -294,8 +294,7 @@
(erc-fill-tests--simulate-refill) ; idempotent
(erc-fill-tests--compare "merge-02-right"))))))
-(ert-deftest erc-fill-wrap--merge-action ()
- :tags '(:unstable)
+(defun erc-fill-wrap-tests--merge-action (compare-file)
(unless (>= emacs-major-version 29)
(ert-skip "Emacs version too low, missing `buffer-text-pixel-size'"))
@@ -336,7 +335,23 @@
(should (= erc-fill--wrap-value 27))
(erc-fill-tests--wrap-check-prefixes
"*** " "<alice> " "<bob> " "<bob> " "* bob " "<bob> " "* " "<bob> ")
- (erc-fill-tests--compare "merge-wrap-01"))))
+ (erc-fill-tests--compare compare-file))))
+
+(ert-deftest erc-fill-wrap--merge-action ()
+ :tags '(:unstable)
+ (erc-fill-wrap-tests--merge-action "merge-wrap-01"))
+
+(ert-deftest erc-fill-wrap--merge-action/indicator-pre ()
+ :tags '(:unstable)
+ (let ((erc-fill-wrap-merge-indicator '(pre ?> shadow)))
+ (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-pre-01")))
+
+;; One crucial thing this test asserts is that the indicator is
+;; omitted when the previous line ends in a stamp.
+(ert-deftest erc-fill-wrap--merge-action/indicator-post ()
+ :tags '(:unstable)
+ (let ((erc-fill-wrap-merge-indicator '(post ?~ shadow)))
+ (erc-fill-wrap-tests--merge-action "merge-wrap-indicator-post-01")))
(ert-deftest erc-fill-line-spacing ()
:tags '(:unstable)
diff --git a/test/lisp/erc/erc-nicks-tests.el b/test/lisp/erc/erc-nicks-tests.el
index 3e5804734ec..35264a23caa 100644
--- a/test/lisp/erc/erc-nicks-tests.el
+++ b/test/lisp/erc/erc-nicks-tests.el
@@ -493,7 +493,7 @@
(should (equal (erc-nicks--gen-key-from-format-spec "bob")
"bob@Libera.Chat/tester"))))
-(ert-deftest erc-nicks--create-pool ()
+(ert-deftest erc-nicks--create-culled-pool ()
(let ((erc-nicks--bg-luminance 1.0)
(erc-nicks--bg-mode-value 'light)
(erc-nicks--fg-rgb '(0.0 0.0 0.0))
@@ -502,37 +502,70 @@
(erc-nicks--colors-rejects '(t)))
;; Reject
- (should-not (erc-nicks--create-pool '(erc-nicks-invert) '("white")))
+ (should-not (erc-nicks--create-culled-pool '(erc-nicks-invert) '("white")))
(should (equal (pop erc-nicks--colors-rejects) "white")) ; too close
- (should-not (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("black")))
+ (should-not
+ (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast) '("black")))
(should (equal (pop erc-nicks--colors-rejects) "black")) ; too far
- (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("white")))
+ (should-not
+ (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("white")))
(should (equal (pop erc-nicks--colors-rejects) "white")) ; lacks color
- (should-not (erc-nicks--create-pool '(erc-nicks-ensaturate) '("red")))
+ (should-not
+ (erc-nicks--create-culled-pool '(erc-nicks-ensaturate) '("red")))
(should (equal (pop erc-nicks--colors-rejects) "red")) ; too much color
;; Safe
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-invert) '("black"))
- '("black")))
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-add-contrast) '("black"))
- '("black")))
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-cap-contrast) '("white"))
- '("white")))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-invert)
+ '("black"))
+ '("black")))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-add-contrast)
+ '("black"))
+ '("black")))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-cap-contrast)
+ '("white"))
+ '("white")))
(let ((erc-nicks-saturation-range '(0.5 . 1.0)))
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("green"))
- '("green"))))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+ '("green"))
+ '("green"))))
(let ((erc-nicks-saturation-range '(0.0 . 0.5)))
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("gray"))
- '("gray"))))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+ '("gray"))
+ '("gray"))))
(unless noninteractive
- (should
- (equal (erc-nicks--create-pool '(erc-nicks-ensaturate) '("firebrick"))
- '("firebrick"))))
+ (should (equal (erc-nicks--create-culled-pool '(erc-nicks-ensaturate)
+ '("firebrick"))
+ '("firebrick"))))
+ (should (equal erc-nicks--colors-rejects '(t)))))
+
+(ert-deftest erc-nicks--create-coerced-pool ()
+ (let ((erc-nicks--bg-luminance 1.0)
+ (erc-nicks--bg-mode-value 'light)
+ (erc-nicks--fg-rgb '(0.0 0.0 0.0))
+ (erc-nicks-bg-color "white")
+ (num-colors (length (defined-colors)))
+ ;;
+ (erc-nicks--colors-rejects '(t)))
+
+ ;; Deduplication.
+ (when (= 8 num-colors)
+ (should (equal (erc-nicks--create-coerced-pool '(erc-nicks-ensaturate)
+ '("#ee0000" "#f80000"))
+ '("red")))
+ (should (equal (pop erc-nicks--colors-rejects) "#f80000")))
+
+ ;; "Coercion" in Xterm.
+ (unless noninteractive
+ (when (= 665 num-colors)
+ (pcase-dolist (`(,adjustments ,candidates ,result)
+ '(((erc-nicks-invert) ("white") ("gray10"))
+ ((erc-nicks-cap-contrast) ("black") ("gray20"))
+ ((erc-nicks-ensaturate) ("white") ("lavenderblush2"))
+ ((erc-nicks-ensaturate) ("red") ("firebrick"))))
+ (should (equal (erc-nicks--create-coerced-pool adjustments
+ candidates)
+ result)))))
+
(should (equal erc-nicks--colors-rejects '(t)))))
;;; erc-nicks-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-chan-modes.el
b/test/lisp/erc/erc-scenarios-base-chan-modes.el
new file mode 100644
index 00000000000..9c63d8aff8e
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-chan-modes.el
@@ -0,0 +1,84 @@
+;;; erc-scenarios-base-chan-modes.el --- Channel mode scenarios -*-
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-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; This asserts that a bug present in ERC 5.4+ is now absent.
+;; Previously, ERC would attempt to parse a nullary channel mode as if
+;; it were a status prefix update, which led to a wrong-type error.
+;; This test does not address similar collisions with unary modes,
+;; such as "MODE +q foo!*@*", but it should.
+(ert-deftest erc-scenarios-base-chan-modes--plus-q ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'chan-changed))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to Libera.Chat")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "changed mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+
+ (ert-info ("Receive notice that mode has changed")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ (erc-scenarios-common-say "ready before")
+ (funcall expect 10 "<Chad> before")
+ (funcall expect 10 " has changed mode for #chan to +Qu")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Key stored locally")
+ (erc-scenarios-common-say "ready key")
+ (funcall expect 10 "<Chad> doing key")
+ (funcall expect 10 " has changed mode for #chan to +k hunter2")
+ (should (equal erc-channel-key "hunter2")))
+
+ (ert-info ("Limit stored locally")
+ (erc-scenarios-common-say "ready limit")
+ (funcall expect 10 "<Chad> doing limit")
+ (funcall expect 10 " has changed mode for #chan to +l 3")
+ (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
+ (should (equal erc-channel-modes '("Q" "n" "t" "u"))))
+
+ (ert-info ("Modes removed and local state deletion succeeds")
+ (erc-scenarios-common-say "ready drop")
+ (funcall expect 10 "<Chad> dropping")
+ (funcall expect 10 " has changed mode for #chan to -lu")
+ (funcall expect 10 " has changed mode for #chan to -Qk *")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t"))))
+
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+ (funcall expect 10 "<Chad> after"))))
+
+;;; erc-scenarios-base-chan-modes.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-misc-regressions.el
b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
index 42d7653d3ec..85b2c03b6a4 100644
--- a/test/lisp/erc/erc-scenarios-base-misc-regressions.el
+++ b/test/lisp/erc/erc-scenarios-base-misc-regressions.el
@@ -124,48 +124,4 @@ Originally from scenario rebuffed/gapless as explained in
Bug#48598:
(with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
(erc-d-t-search-for 10 "and be prosperous")))))
-;; This defends against a partial regression in which an /MOTD caused
-;; 376 and 422 handlers in erc-networks to run.
-
-(ert-deftest erc-cmd-MOTD ()
- :tags '(:expensive-test)
- (erc-scenarios-common-with-cleanup
- ((erc-scenarios-common-dialog "base/commands")
- (erc-server-flood-penalty 0.1)
- (dumb-server (erc-d-run "localhost" t 'motd))
- (port (process-contact dumb-server :service))
- (expect (erc-d-t-make-expecter)))
-
- (ert-info ("Connect to server")
- (with-current-buffer (erc :server "127.0.0.1"
- :port port
- :nick "tester"
- :full-name "tester")
- (funcall expect 10 "This is the default Ergo MOTD")
- (funcall expect 10 "debug mode")))
-
- (ert-info ("Send plain MOTD")
- (with-current-buffer "foonet"
- (erc-cmd-MOTD)
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "This is the default Ergo MOTD")))
-
- (ert-info ("Send MOTD with known target")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/MOTD irc1.foonet.org")
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "This is the default Ergo MOTD")))
-
- (ert-info ("Send MOTD with erroneous target")
- (with-current-buffer "foonet"
- (erc-scenarios-common-say "/MOTD fake.foonet.org")
- (funcall expect -0.2 "Unexpected state detected")
- (funcall expect 10 "No such server")
- ;; Message may show up before the handler runs.
- (erc-d-t-wait-for 10
- (not (local-variable-p 'erc-server-402-functions)))
- (should-not (local-variable-p 'erc-server-376-functions))
- (should-not (local-variable-p 'erc-server-422-functions))
- (erc-cmd-QUIT "")))))
-
;;; erc-scenarios-base-misc-regressions.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-send-message.el
b/test/lisp/erc/erc-scenarios-base-send-message.el
new file mode 100644
index 00000000000..bf9e0f5ae3a
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-base-send-message.el
@@ -0,0 +1,126 @@
+;;; erc-scenarios-base-send-message.el --- `send-message' scenarios -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2022-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-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; So-called "noncommands" are those that massage input submitted at
+;; the prompt and send it on behalf of the user.
+
+(ert-deftest erc-scenarios-base-send-message--noncommands ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/send-message")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'noncommands))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-autojoin-channels-alist '((foonet "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "debug mode")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (ert-info ("Send CTCP ACTION")
+ (funcall expect 10 "<bob> alice: For hands, to do Rome")
+ (erc-scenarios-common-say "/me sad")
+ (funcall expect 10 "* tester sad"))
+
+ (ert-info ("Send literal command")
+ (funcall expect 10 "<alice> bob: Spotted, detested")
+ (erc-scenarios-common-say "/say /me sad")
+ (funcall expect 10 "<tester> /me sad"))
+
+ (ert-info ("\"Nested\" `noncommands'")
+
+ (ert-info ("Send version via /SV")
+ (funcall expect 10 "<bob> Marcus, my brother!")
+ (erc-scenarios-common-say "/sv")
+ (funcall expect 10 "<tester> I'm using ERC"))
+
+ (ert-info ("Send module list via /SM")
+ (funcall expect 10 "<bob> alice: You still wrangle")
+ (erc-scenarios-common-say "/sm")
+ (funcall expect 10 "<tester> I'm using the following modules: ")
+ (funcall expect 10 "<alice> No, not till Thursday;"))))))
+
+
+;; This asserts that the `command-indicator' module only inserts
+;; prompt-like prefixes for normal slash commands, like /JOIN.
+
+(ert-deftest erc-scenarios-base-send-message--command-indicator ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/send-message")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'noncommands))
+ (erc-modules `(command-indicator fill-wrap ,@erc-modules))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to foonet")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "debug mode")
+ (erc-scenarios-common-say "/join #chan")
+ (funcall expect 10 "ERC> /join #chan")))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (ert-info ("Prompt absent for CTCP ACTION")
+ (funcall expect 10 "<bob> alice: For hands, to do Rome")
+ (erc-scenarios-common-say "/me sad")
+ (funcall expect -0.1 "ERC> /me sad")
+ (funcall expect 10 "* tester sad"))
+
+ (ert-info ("Prompt absent for literal command")
+ (funcall expect 10 "<alice> bob: Spotted, detested")
+ (erc-scenarios-common-say "/say /me sad")
+ (funcall expect -0.1 "ERC> /say /me sad")
+ (funcall expect 10 "<tester> /me sad"))
+
+ (ert-info ("Prompt absent for /SV")
+ (funcall expect 10 "<bob> Marcus, my brother!")
+ (erc-scenarios-common-say "/sv")
+ (funcall expect -0.1 "ERC> /sv")
+ (funcall expect 10 "<tester> I'm using ERC"))
+
+ (ert-info ("Prompt absent module list via /SM")
+ (funcall expect 10 "<bob> alice: You still wrangle")
+ (erc-scenarios-common-say "/sm")
+ (funcall expect -0.1 "ERC> /sm")
+ (funcall expect 10 "<tester> I'm using the following modules: ")
+ (funcall expect 10 "<alice> No, not till Thursday;"))
+
+ (ert-info ("Prompt present for /QUIT in issuing buffer")
+ (erc-scenarios-common-say "/quit")
+ (funcall expect 10 "ERC> /quit"))
+
+ (with-current-buffer "foonet"
+ (funcall expect 10 "ERC finished")))))
+
+;;; erc-scenarios-base-send-message.el ends here
diff --git a/test/lisp/erc/erc-scenarios-display-message.el
b/test/lisp/erc/erc-scenarios-display-message.el
index 51bdf305ad5..5751a32212d 100644
--- a/test/lisp/erc/erc-scenarios-display-message.el
+++ b/test/lisp/erc/erc-scenarios-display-message.el
@@ -59,6 +59,4 @@
(erc-cmd-QUIT "")))
-(eval-when-compile (require 'erc-join))
-
;;; erc-scenarios-display-message.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc-commands.el
b/test/lisp/erc/erc-scenarios-misc-commands.el
new file mode 100644
index 00000000000..2a36d52b835
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-misc-commands.el
@@ -0,0 +1,94 @@
+;;; erc-scenarios-misc-commands.el --- Misc commands for ERC -*-
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-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+;; This defends against a partial regression in which an /MOTD caused
+;; 376 and 422 handlers in erc-networks to run.
+
+(ert-deftest erc-scenarios-misc-commands--MOTD ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "commands")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'motd))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to server")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "This is the default Ergo MOTD")
+ (funcall expect 10 "debug mode")))
+
+ (ert-info ("Send plain MOTD")
+ (with-current-buffer "foonet"
+ (erc-cmd-MOTD)
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "This is the default Ergo MOTD")))
+
+ (ert-info ("Send MOTD with known target")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/MOTD irc1.foonet.org")
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "This is the default Ergo MOTD")))
+
+ (ert-info ("Send MOTD with erroneous target")
+ (with-current-buffer "foonet"
+ (erc-scenarios-common-say "/MOTD fake.foonet.org")
+ (funcall expect -0.2 "Unexpected state detected")
+ (funcall expect 10 "No such server")
+ ;; Message may show up before the handler runs.
+ (erc-d-t-wait-for 10
+ (not (local-variable-p 'erc-server-402-functions)))
+ (should-not (local-variable-p 'erc-server-376-functions))
+ (should-not (local-variable-p 'erc-server-422-functions))
+ (erc-cmd-QUIT "")))))
+
+
+(ert-deftest erc-scenarios-misc-commands--SQUERY ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "commands")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'squery))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect to server")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 10 "Your connection is secure")))
+
+ (ert-info ("Send SQUERY")
+ (with-current-buffer "IRCnet"
+ (erc-scenarios-common-say "/SQUERY alis help list")
+ (funcall expect -0.1 "Incorrect arguments")
+ (funcall expect 10 "See also: HELP EXAMPLES")))))
+
+;;; erc-scenarios-misc-commands.el ends here
diff --git a/test/lisp/erc/erc-scenarios-prompt-format.el
b/test/lisp/erc/erc-scenarios-prompt-format.el
new file mode 100644
index 00000000000..7eccb859dbc
--- /dev/null
+++ b/test/lisp/erc/erc-scenarios-prompt-format.el
@@ -0,0 +1,117 @@
+;;; erc-scenarios-prompt-format.el --- erc-prompt-format-mode -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (ert-resource-directory) load-path)))
+ (require 'erc-scenarios-common)))
+
+(defvar erc-fill-wrap-align-prompt)
+(defvar erc-fill-wrap-use-pixels)
+
+(defun erc-scenarios-prompt-format--assert (needle &rest props)
+ (save-excursion
+ (goto-char erc-insert-marker)
+ (should (search-forward needle nil t))
+ (pcase-dolist (`(,k . ,v) props)
+ (should (equal (get-text-property (point) k) v)))))
+
+;; This makes assertions about the option `erc-fill-wrap-align-prompt'
+;; as well as the standard value of `erc-prompt-format'. One minor
+;; omission is that this doesn't check behavior in query buffers.
+(ert-deftest erc-scenarios-prompt-format ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/modes")
+ (erc-server-flood-penalty 0.1)
+ (dumb-server (erc-d-run "localhost" t 'chan-changed))
+ (erc-modules (cons 'fill-wrap erc-modules))
+ (erc-fill-wrap-align-prompt t)
+ (erc-fill-wrap-use-pixels nil)
+ (erc-prompt #'erc-prompt-format)
+ (erc-autojoin-channels-alist '((Libera.Chat "#chan")))
+ (expect (erc-d-t-make-expecter))
+ ;; Collect samples of `line-prefix' to verify deltas as the
+ ;; prompt grows and shrinks.
+ (line-prefixes nil)
+ (stash-pfx (lambda ()
+ (pcase (get-text-property erc-insert-marker 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (car (push n line-prefixes)))))))
+
+ (ert-info ("Connect to Libera.Chat")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port (process-contact dumb-server :service)
+ :nick "tester"
+ :full-name "tester")
+ (funcall expect 5 "Welcome to the Libera.Chat")
+ (funcall stash-pfx)
+ (funcall expect 5 "changed mode")
+ ;; New prompt is shorter than default with placeholders, like
+ ;; "(foo?)(bar?)" (assuming we win the inherent race).
+ (should (>= (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "user-" '(display . ("Ziw")))))
+
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+
+ (ert-info ("Receive notice that mode has changed")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ (funcall stash-pfx)
+ (erc-scenarios-common-say "ready before")
+ (funcall expect 10 " has changed mode for #chan to +Qu")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("Q" "n" "t" "u")))
+ ;; Prompt is longer now, so too is the `line-prefix' subtrahend.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qntu")
+ (erc-scenarios-prompt-format--assert "#chan>"))
+
+ (ert-info ("Key stored locally")
+ (erc-scenarios-common-say "ready key")
+ (funcall expect 10 " has changed mode for #chan to +k hunter2")
+ ;; Prompt has grown by 1.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qkntu"))
+
+ (ert-info ("Limit stored locally")
+ (erc-scenarios-common-say "ready limit")
+ (funcall expect 10 " has changed mode for #chan to +l 3")
+ (erc-d-t-wait-for 10 (eql erc-channel-user-limit 3))
+ (should (equal erc-channel-modes '("Q" "n" "t" "u")))
+ ;; Prompt has grown by 1 again.
+ (should (< (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "Qklntu"))
+
+ (ert-info ("Modes removed and local state deletion succeeds")
+ (erc-scenarios-common-say "ready drop")
+ (funcall expect 10 " has changed mode for #chan to -lu")
+ (funcall expect 10 " has changed mode for #chan to -Qk *")
+ (erc-d-t-wait-for 10 (equal erc-channel-modes '("n" "t")))
+ ;; Prompt has shrunk.
+ (should (> (car line-prefixes) (funcall stash-pfx)))
+ (erc-scenarios-prompt-format--assert "nt"))
+
+ (should-not erc-channel-key)
+ (should-not erc-channel-user-limit)
+ (funcall expect 10 "<Chad> after"))))
+
+;;; erc-scenarios-prompt-format.el ends here
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 916b394c8ff..980928aceac 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -115,14 +115,20 @@
(setq erc-away 1)
(erc-tests--set-fake-server-process "sleep" "1")
- (let (calls)
- (advice-add 'buffer-local-value :after (lambda (&rest r) (push r calls))
+ (let (mockingp calls)
+ (advice-add 'buffer-local-value :after
+ (lambda (&rest r) (when mockingp (push r calls)))
'((name . erc-with-server-buffer)))
- (should (= 1 (erc-with-server-buffer erc-away)))
+ (should (= 1 (prog2 (setq mockingp t)
+ (erc-with-server-buffer erc-away)
+ (setq mockingp nil))))
+
(should (equal (pop calls) (list 'erc-away (current-buffer))))
- (should (= 1 (erc-with-server-buffer (ignore 'me) erc-away)))
+ (should (= 1 (prog2 (setq mockingp t)
+ (erc-with-server-buffer (ignore 'me) erc-away)
+ (setq mockingp nil))))
(should-not calls)
(advice-remove 'buffer-local-value 'erc-with-server-buffer)))
@@ -181,101 +187,101 @@
(with-current-buffer "ServNet"
(should (= (point) erc-insert-marker))
(erc--hide-prompt erc-server-process)
- (should (string= ">" (get-text-property (point) 'display))))
+ (should (string= ">" (get-char-property (point) 'display))))
(with-current-buffer "#chan"
(goto-char erc-insert-marker)
- (should (string= ">" (get-text-property (point) 'display)))
+ (should (string= ">" (get-char-property (point) 'display)))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(goto-char erc-input-marker)
(ert-simulate-command '(self-insert-command 1 ?/))
(goto-char erc-insert-marker)
- (should-not (get-text-property (point) 'display))
+ (should-not (get-char-property (point) 'display))
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook)))
(with-current-buffer "bob"
(goto-char erc-insert-marker)
- (should (string= ">" (get-text-property (point) 'display)))
+ (should (string= ">" (get-char-property (point) 'display)))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(goto-char erc-input-marker)
(ert-simulate-command '(self-insert-command 1 ?/))
(goto-char erc-insert-marker)
- (should-not (get-text-property (point) 'display))
+ (should-not (get-char-property (point) 'display))
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook)))
(with-current-buffer "ServNet"
- (should (get-text-property erc-insert-marker 'display))
+ (should (get-char-property erc-insert-marker 'display))
(should (memq #'erc--unhide-prompt-on-self-insert pre-command-hook))
(erc--unhide-prompt)
(should-not (memq #'erc--unhide-prompt-on-self-insert
pre-command-hook))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: server")
(setq erc-hide-prompt '(server))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
- (should (string= ">" (get-text-property erc-insert-marker 'display))))
+ (should (string= ">" (get-char-property erc-insert-marker 'display))))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "ServNet"
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: channel")
(setq erc-hide-prompt '(channel))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (string= ">" (get-char-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: query")
(setq erc-hide-prompt '(query))
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should (string= ">" (get-text-property erc-insert-marker 'display)))
+ (should (string= ">" (get-char-property erc-insert-marker 'display)))
(should (eq (get-text-property erc-insert-marker 'erc-prompt) 'hidden))
(erc--unhide-prompt)
(should (eq (get-text-property erc-insert-marker 'erc-prompt) t))
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(ert-info ("Value: nil")
(setq erc-hide-prompt nil)
(with-current-buffer "ServNet"
(erc--hide-prompt erc-server-process)
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "bob"
- (should-not (get-text-property erc-insert-marker 'display)))
+ (should-not (get-char-property erc-insert-marker 'display)))
(with-current-buffer "#chan"
- (should-not (get-text-property erc-insert-marker 'display))
+ (should-not (get-char-property erc-insert-marker 'display))
(erc--unhide-prompt) ; won't blow up when prompt already showing
- (should-not (get-text-property erc-insert-marker 'display))))
+ (should-not (get-char-property erc-insert-marker 'display))))
(when noninteractive
(kill-buffer "#chan")
@@ -317,7 +323,7 @@
(insert "Howdy")
(erc-send-current-line)
(save-excursion (forward-line -1)
- (should (looking-at "No target"))
+ (should (looking-at (rx "*** No target")))
(forward-line -1)
(should (looking-at "<tester> Howdy")))
(should (looking-back "ServNet 6> "))
@@ -643,6 +649,247 @@
(should (equal '("de" "" "fg@xy") (erc-parse-user "abc\nde!fg@xy"))))))
+(ert-deftest erc--parsed-prefix ()
+ (erc-mode)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (setq erc--isupport-params (make-hash-table))
+
+ ;; Uses fallback values when no PREFIX parameter yet received, thus
+ ;; ensuring caller can use slot accessors immediately intead of
+ ;; checking if null beforehand.
+ (should-not erc--parsed-prefix)
+ (should (equal (erc--parsed-prefix)
+ #s(erc--parsed-prefix nil "qaohv" "~&@%+"
+ ((?q . ?~) (?a . ?&)
+ (?o . ?@) (?h . ?%) (?v . ?+)))))
+ (let ((cached (should erc--parsed-prefix)))
+ (should (eq (erc--parsed-prefix) cached)))
+
+ ;; Cache broken. (Notice not setting `erc--parsed-prefix' to nil).
+ (setq erc-server-parameters '(("PREFIX" . "(Yqaohv)!~&@%+")))
+
+ (let ((proc erc-server-process)
+ (expected '((?Y . ?!) (?q . ?~) (?a . ?&)
+ (?o . ?@) (?h . ?%) (?v . ?+)))
+ cached)
+
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-server-process proc)
+ (should (equal expected
+ (erc--parsed-prefix-alist (erc--parsed-prefix)))))
+
+ (should (equal expected (erc--parsed-prefix-alist erc--parsed-prefix)))
+ (setq cached erc--parsed-prefix)
+ (should (equal cached
+ #s(erc--parsed-prefix ("(Yqaohv)!~&@%+") "Yqaohv" "!~&@%+"
+ ((?Y . ?!) (?q . ?~) (?a . ?&)
+ (?o . ?@) (?h . ?%) (?v . ?+)))))
+ ;; Second target buffer reuses cached value.
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-server-process proc)
+ (should (eq cached (erc--parsed-prefix))))
+
+ ;; New value computed when cache broken.
+ (puthash 'PREFIX (list "(Yqaohv)!~&@%+") erc--isupport-params)
+ (with-temp-buffer
+ (erc-mode)
+ (setq erc-server-process proc)
+ (should-not (eq cached (erc--parsed-prefix)))
+ (should (equal (erc--parsed-prefix-alist
+ (erc-with-server-buffer erc--parsed-prefix))
+ expected)))))
+
+;; This exists as a reference to assert legacy behavior in order to
+;; preserve and incorporate it as a fallback in the 5.6+ replacement.
+(ert-deftest erc-parse-modes ()
+ (with-suppressed-warnings ((obsolete erc-parse-modes))
+ (should (equal (erc-parse-modes "+u") '(("u") nil nil)))
+ (should (equal (erc-parse-modes "-u") '(nil ("u") nil)))
+ (should (equal (erc-parse-modes "+o bob") '(nil nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "-o bob") '(nil nil (("o" off "bob")))))
+ (should (equal (erc-parse-modes "+uo bob") '(("u") nil (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+o-u bob") '(nil ("u") (("o" on "bob")))))
+ (should (equal (erc-parse-modes "+uo-tv bob alice")
+ '(("u") ("t") (("o" on "bob") ("v" off "alice")))))
+
+ (ert-info ("Modes of type B are always grouped as unary")
+ (should (equal (erc-parse-modes "+k h2") '(nil nil (("k" on "h2")))))
+ ;; Channel key args are thrown away.
+ (should (equal (erc-parse-modes "-k *") '(nil nil (("k" off nil))))))
+
+ (ert-info ("Modes of type C are grouped as unary even when disabling")
+ (should (equal (erc-parse-modes "+l 3") '(nil nil (("l" on "3")))))
+ (should (equal (erc-parse-modes "-l") '(nil nil (("l" off nil))))))))
+
+(ert-deftest erc--update-channel-modes ()
+ (erc-mode)
+ (setq erc-channel-users (make-hash-table :test #'equal)
+ erc-server-users (make-hash-table :test #'equal)
+ erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test"))
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (let ((orig-handle-fn (symbol-function 'erc--handle-channel-mode))
+ calls)
+ (cl-letf (((symbol-function 'erc--handle-channel-mode)
+ (lambda (&rest r) (push r calls) (apply orig-handle-fn r)))
+ ((symbol-function 'erc-update-mode-line) #'ignore))
+
+ (ert-info ("Unknown user not created")
+ (erc--update-channel-modes "+o" "bob")
+ (should-not (erc-get-channel-user "bob")))
+
+ (ert-info ("Status updated when user known")
+ (puthash "bob" (cons (erc-add-server-user
+ "bob" (make-erc-server-user :nickname "bob"))
+ (make-erc-channel-user))
+ erc-channel-users)
+ ;; Also asserts fallback behavior for traditional prefixes.
+ (should-not (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "+o" "bob")
+ (should (erc-channel-user-op-p "bob"))
+ (erc--update-channel-modes "-o" "bob") ; status revoked
+ (should-not (erc-channel-user-op-p "bob")))
+
+ (ert-info ("Unknown nullary added and removed")
+ (should-not erc--channel-modes)
+ (should-not erc-channel-modes)
+ (erc--update-channel-modes "+u")
+ (should (equal erc-channel-modes '("u")))
+ (should (eq t (gethash ?u erc--channel-modes)))
+ (should (equal (pop calls) '(?d ?u t nil)))
+ (erc--update-channel-modes "-u")
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
+ (should-not erc-channel-modes)
+ (should-not calls))
+
+ (ert-info ("Fallback for Type B includes mode letter k")
+ (erc--update-channel-modes "+k" "h2")
+ (should (equal (pop calls) '(?b ?k t "h2")))
+ (should-not erc-channel-modes)
+ (should (equal "h2" (gethash ?k erc--channel-modes)))
+ (erc--update-channel-modes "-k" "*")
+ (should (equal (pop calls) '(?b ?k nil "*")))
+ (should-not calls)
+ (should-not (gethash ?k erc--channel-modes))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Fallback for Type C includes mode letter l")
+ (erc--update-channel-modes "+l" "3")
+ (should (equal (pop calls) '(?c ?l t "3")))
+ (should-not erc-channel-modes)
+ (should (equal "3" (gethash ?l erc--channel-modes)))
+ (erc--update-channel-modes "-l" nil)
+ (should (equal (pop calls) '(?c ?l nil nil)))
+ (should-not (gethash ?l erc--channel-modes))
+ (should-not erc-channel-modes))
+
+ (ert-info ("Advertised supersedes heuristics")
+ (setq erc-server-parameters
+ '(("PREFIX" . "(ov)@+")
+ ;; Add phony 5th type for this CHANMODES value for
+ ;; robustness in case some server gets creative.
+ ("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz,FAKE")))
+ (erc--update-channel-modes "+qu" "fool!*@*")
+ (should (equal (pop calls) '(?d ?u t nil)))
+ (should (equal (pop calls) '(?a ?q t "fool!*@*")))
+ (should (equal 1 (gethash ?q erc--channel-modes)))
+ (should (eq t (gethash ?u erc--channel-modes)))
+ (should (equal erc-channel-modes '("u")))
+ (should-not (erc-channel-user-owner-p "bob"))
+
+ ;; Remove fool!*@* from list mode "q".
+ (erc--update-channel-modes "-uq" "fool!*@*")
+ (should (equal (pop calls) '(?a ?q nil "fool!*@*")))
+ (should (equal (pop calls) '(?d ?u nil nil)))
+ (should-not (gethash ?u erc--channel-modes))
+ (should-not erc-channel-modes)
+ (should (equal 0 (gethash ?q erc--channel-modes))))
+
+ (should-not calls))))
+
+(ert-deftest erc--channel-modes ()
+ (setq erc--isupport-params (make-hash-table)
+ erc--target (erc--target-from-string "#test")
+ erc-server-parameters
+ '(("CHANMODES" . "eIbq,k,flj,CFLMPQRSTcgimnprstuz")))
+
+ (erc-tests--set-fake-server-process "sleep" "1")
+
+ (cl-letf (((symbol-function 'erc-update-mode-line) #'ignore))
+ (erc--update-channel-modes "+bltk" "fool!*@*" "3" "h2"))
+
+ (should (equal (erc--channel-modes 'string) "klt"))
+ (should (equal (erc--channel-modes 'strings) '("k" "l" "t")))
+ (should (equal (erc--channel-modes) '((?k . "h2") (?l . "3") (?t))))
+ (should (equal (erc--channel-modes 3 ",") "klt h2,3"))
+
+ ;; 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"))))
+ (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)
+ (eq (pcase first-run (`((,k . ,_)) k))
+ (pcase second-run (`((,k . ,_)) k)))))))
+
+ (should (equal (erc--channel-modes 0 ",") "klt ,"))
+ (should (equal (erc--channel-modes 2) "klt h2 3"))
+ (should (equal (erc--channel-modes 1) "klt h 3"))
+ (should (equal (erc--channel-modes 0) "klt "))) ; 2 spaces
+
+(ert-deftest erc--update-user-modes ()
+ (let ((erc--user-modes (list ?a)))
+ (should (equal (erc--update-user-modes "+a") '(?a)))
+ (should (equal (erc--update-user-modes "-b") '(?a)))
+ (should (equal erc--user-modes '(?a))))
+
+ (let ((erc--user-modes (list ?b)))
+ (should (equal (erc--update-user-modes "+ac") '(?a ?b ?c)))
+ (should (equal (erc--update-user-modes "+a-bc") '(?a)))
+ (should (equal erc--user-modes '(?a)))))
+
+(ert-deftest erc--user-modes ()
+ (let ((erc--user-modes '(?a ?b)))
+ (should (equal (erc--user-modes) '(?a ?b)))
+ (should (equal (erc--user-modes 'string) "ab"))
+ (should (equal (erc--user-modes 'strings) '("a" "b")))))
+
+(ert-deftest erc--parse-user-modes ()
+ (should (equal (erc--parse-user-modes "a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+a" '()) '((?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '()) '(() ())))
+ (should (equal (erc--parse-user-modes "-a" '(?a)) '(() (?a))))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a)) '(() ())))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b)) '((?a) (?b))))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b)) '((?a) ())))
+ (should (equal (erc--parse-user-modes "+ab-c" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "+a-c+b" '(?b ?c)) '((?a) (?c))))
+ (should (equal (erc--parse-user-modes "-c+ab" '(?b ?c)) '((?a) (?c))))
+
+ ;; Param `extrap' returns groups of redundant chars.
+ (should (equal (erc--parse-user-modes "+a" '() t) '((?a) () () ())))
+ (should (equal (erc--parse-user-modes "+a" '(?a) t) '(() () (?a) ())))
+ (should (equal (erc--parse-user-modes "-a" '() t) '(() () () (?a))))
+ (should (equal (erc--parse-user-modes "-a" '(?a) t) '(() (?a) () ())))
+
+ (should (equal (erc--parse-user-modes "+a-b" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "-b+a" '(?a) t) '(() () (?a) (?b))))
+ (should (equal (erc--parse-user-modes "+a-b" '(?b) t) '((?a) (?b) () ())))
+ (should (equal (erc--parse-user-modes "-b+a" '(?b) t) '((?a) (?b) () ()))))
+
(ert-deftest erc--parse-isupport-value ()
(should (equal (erc--parse-isupport-value "a,b") '("a" "b")))
(should (equal (erc--parse-isupport-value "a,b,c") '("a" "b" "c")))
@@ -1634,6 +1881,18 @@
(buffer-substring 1 4)
#("ghi" 0 1 (erc-test (w x)) 1 2 (erc-test (w x y z)))))
+ ;; Flag `erc--merge-prop-behind-p'.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (erc--merge-prop 2 3 'erc-test '(y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 1 2 (erc-test (y z)))))
+ (let ((erc--merge-prop-behind-p t))
+ (erc--merge-prop 1 3 'erc-test '(w x)))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4)
+ #("jkl" 0 1 (erc-test (w x)) 1 2 (erc-test (y z w x)))))
+
(when noninteractive
(kill-buffer))))
@@ -2543,7 +2802,8 @@
(kill-buffer "#chan")))
(defconst erc-tests--modules
- '( autoaway autojoin bufbar button capab-identify completion dcc fill identd
+ '( autoaway autojoin bufbar button capab-identify
+ command-indicator completion dcc fill identd
imenu irccontrols keep-place list log match menu move-to-prompt netsplit
networks nickbar nicks noncommands notifications notify page readonly
replace ring sasl scrolltobottom services smiley sound
diff --git a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld
b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld
index f916fea2374..15bcca2a623 100644
--- a/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/reconplay/foonet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0.0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
diff --git a/test/lisp/erc/resources/base/display-message/multibuf.eld
b/test/lisp/erc/resources/base/display-message/multibuf.eld
index e49a654cd06..424a687e749 100644
--- a/test/lisp/erc/resources/base/display-message/multibuf.eld
+++ b/test/lisp/erc/resources/base/display-message/multibuf.eld
@@ -37,7 +37,7 @@
(0.07 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :Would all themselves laugh
mortal.")
(0.04 ":dummy!~u@rdjcgiwfuwqmc.irc PRIVMSG tester :hi")
(0.06 ":bob!~u@uee7kge7ua5sy.irc PRIVMSG #chan :alice: It hath pleased the
devil drunkenness to give place to the devil wrath; one unperfectness shows me
another, to make me frankly despise myself.")
- (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.6-git (IRC client
for GNU Emacs 30.0.50)")
+ (0.05 ":dummy!~u@rdjcgiwfuwqmc.irc QUIT :Quit: \2ERC\2 5.x (IRC client for
GNU Emacs)")
(0.08 ":alice!~u@uee7kge7ua5sy.irc PRIVMSG #chan :You speak of him when he
was less furnished than now he is with that which makes him both without and
within."))
((quit 10 "QUIT :\2ERC\2")
diff --git a/test/lisp/erc/resources/base/modes/chan-changed.eld
b/test/lisp/erc/resources/base/modes/chan-changed.eld
new file mode 100644
index 00000000000..6cf6596b0b2
--- /dev/null
+++ b/test/lisp/erc/resources/base/modes/chan-changed.eld
@@ -0,0 +1,55 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.03 ":cadmium.libera.chat 001 tester :Welcome to the Libera.Chat Internet
Relay Chat Network tester")
+ (0.02 ":cadmium.libera.chat 002 tester :Your host is
cadmium.libera.chat[103.196.37.95/6697], running version solanum-1.0-dev")
+ (0.01 ":cadmium.libera.chat 003 tester :This server was created Wed Jan 25
2023 at 10:22:45 UTC")
+ (0.01 ":cadmium.libera.chat 004 tester cadmium.libera.chat solanum-1.0-dev
DGMQRSZaghilopsuwz CFILMPQRSTbcefgijklmnopqrstuvz bkloveqjfI")
+ (0.00 ":cadmium.libera.chat 005 tester CALLERID=g WHOX ETRACE FNC SAFELIST
ELIST=CMNTU KNOCK MONITOR=100 CHANTYPES=# EXCEPTS INVEX
CHANMODES=eIbq,k,flj,CFLMPQRSTcgimnprstuz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 005 tester CHANLIMIT=#:250 PREFIX=(ov)@+
MAXLIST=bqeI:100 MODES=4 NETWORK=Libera.Chat STATUSMSG=@+ CASEMAPPING=rfc1459
NICKLEN=16 MAXNICKLEN=16 CHANNELLEN=50 TOPICLEN=390 DEAF=D :are supported by
this server")
+ (0.01 ":cadmium.libera.chat 005 tester
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,PRIVMSG:4,NOTICE:4,ACCEPT:,MONITOR:
EXTBAN=$,ajrxz :are supported by this server")
+ (0.01 ":cadmium.libera.chat 251 tester :There are 70 users and 42996
invisible on 28 servers")
+ (0.02 ":cadmium.libera.chat 252 tester 38 :IRC Operators online")
+ (0.01 ":cadmium.libera.chat 253 tester 57 :unknown connection(s)")
+ (0.01 ":cadmium.libera.chat 254 tester 22912 :channels formed")
+ (0.01 ":cadmium.libera.chat 255 tester :I have 2499 clients and 1 servers")
+ (0.01 ":cadmium.libera.chat 265 tester 2499 4187 :Current local users 2499,
max 4187")
+ (0.01 ":cadmium.libera.chat 266 tester 43066 51827 :Current global users
43066, max 51827")
+ (0.01 ":cadmium.libera.chat 250 tester :Highest connection count: 4188 (4187
clients) (319420 connections received)")
+ (0.01 ":cadmium.libera.chat 375 tester :- cadmium.libera.chat Message of the
Day - ")
+ (0.01 ":cadmium.libera.chat 372 tester :- This server kindly provided by Mach
Dilemma (www.m-d.net)")
+ (0.01 ":cadmium.libera.chat 372 tester :- Welcome to Libera Chat, the IRC
network for")
+ (0.00 ":cadmium.libera.chat 372 tester :- Email:
support@libera.chat")
+ (0.00 ":cadmium.libera.chat 376 tester :End of /MOTD command.")
+ (0.00 ":tester MODE tester :+Ziw"))
+
+((mode-tester 10 "MODE tester +i"))
+
+((join-chan 10 "JOIN #chan")
+ (0.09 ":tester!~tester@127.0.0.1 JOIN #chan"))
+
+((mode-chan 10 "MODE #chan")
+ (0.03 ":cadmium.libera.chat 353 tester = #chan :tester @Chad dummy")
+ (0.02 ":cadmium.libera.chat 366 tester #chan :End of /NAMES list.")
+ (0.00 ":cadmium.libera.chat 324 tester #chan +nt")
+ (0.01 ":cadmium.libera.chat 329 tester #chan 1621432263"))
+
+((privmsg-before 10 "PRIVMSG #chan :ready before")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan before")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +Qu"))
+
+((privmsg-key 10 "PRIVMSG #chan :ready key")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing key")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +k hunter2"))
+
+((privmsg-limit 10 "PRIVMSG #chan :ready limit")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan :doing limit")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan +l 3"))
+
+((privmsg-drop 10 "PRIVMSG #chan :ready drop")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan dropping")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -lu")
+ (0.00 ":Chad!~u@ggpg6r3a68wak.irc MODE #chan -Qk *")
+ (0.02 ":Chad!~u@ggpg6r3a68wak.irc PRIVMSG #chan after"))
+
+((drop 0 DROP))
diff --git a/test/lisp/erc/resources/base/send-message/noncommands.eld
b/test/lisp/erc/resources/base/send-message/noncommands.eld
new file mode 100644
index 00000000000..ba210bfff6f
--- /dev/null
+++ b/test/lisp/erc/resources/base/send-message/noncommands.eld
@@ -0,0 +1,52 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.00 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
+ (0.01 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running
version ergo-v2.11.1")
+ (0.01 ":irc.foonet.org 003 tester :This server was created Sun, 12 Nov 2023
17:40:20 UTC")
+ (0.01 ":irc.foonet.org 004 tester irc.foonet.org ergo-v2.11.1 BERTZios
CEIMRUabefhiklmnoqstuv Iabefhkloqv")
+ (0.00 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
CHATHISTORY=1000 ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX :are supported by
this server")
+ (0.02 ":irc.foonet.org 005 tester KICKLEN=390 MAXLIST=beI:60 MAXTARGETS=4
MODES MONITOR=100 NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8ONLY WHOX :are supported by this server")
+ (0.01 ":irc.foonet.org 005 tester draft/CHATHISTORY=1000 :are supported by
this server")
+ (0.01 ":irc.foonet.org 251 tester :There are 0 users and 4 invisible on 1
server(s)")
+ (0.01 ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0.01 ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0.01 ":irc.foonet.org 254 tester 2 :channels formed")
+ (0.01 ":irc.foonet.org 255 tester :I have 4 clients and 0 servers")
+ (0.01 ":irc.foonet.org 265 tester 4 4 :Current local users 4, max 4")
+ (0.01 ":irc.foonet.org 266 tester 4 4 :Current global users 4, max 4")
+ (0.02 ":irc.foonet.org 422 tester :MOTD File is missing")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":irc.foonet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
+
+((mode-tester 10 "MODE tester +i"))
+
+((join-chan 10 "JOIN #chan")
+ (0.00 ":irc.foonet.org 221 tester +i")
+ (0.01 ":tester!~u@ggpg6r3a68wak.irc JOIN #chan")
+ (0.03 ":irc.foonet.org 353 tester = #chan :@fsbot bob alice tester")
+ (0.01 ":irc.foonet.org 366 tester #chan :End of NAMES list")
+ (0.00 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!")
+ (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :tester, welcome!"))
+
+((mode-chan 10 "MODE #chan")
+ (0.00 ":irc.foonet.org 324 tester #chan +Cnt")
+ (0.02 ":irc.foonet.org 329 tester #chan 1699810829")
+ (0.01 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: To prove him false
that says I love thee not.")
+ (0.02 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: For hands, to do Rome
service, are but vain."))
+
+((privmsg-action 10 "PRIVMSG #chan :\1ACTION sad\1")
+ (0.07 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :bob: Spotted, detested, and
abominable."))
+
+((privmsg-me 10 "PRIVMSG #chan :/me sad")
+ (0.03 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :Marcus, my brother! 'tis sad
Titus calls."))
+
+((privmsg-sv 10 "PRIVMSG #chan :I'm using ERC " (+ (not " ")) " with GNU
Emacs")
+ (0.07 ":bob!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :alice: You still wrangle with
her, Boyet, and she strikes at the brow."))
+
+((privmsg-sm 10 "PRIVMSG #chan :I'm using the following modules:
`erc-autojoin-mode', ")
+ (0.04 ":alice!~u@cjn7mjwx57gbi.irc PRIVMSG #chan :No, not till Thursday;
there is time enough."))
+
+((quit 10 "QUIT :\2ERC\2")
+ (0.05 ":tester!~u@ggpg6r3a68wak.irc QUIT :Quit: \2ERC\2 5.x (IRC client for
GNU Emacs)")
+ (0.02 "ERROR :Quit: \2ERC\2 5.x (IRC client for GNU Emacs)"))
diff --git a/test/lisp/erc/resources/base/commands/motd.eld
b/test/lisp/erc/resources/commands/motd.eld
similarity index 100%
rename from test/lisp/erc/resources/base/commands/motd.eld
rename to test/lisp/erc/resources/commands/motd.eld
diff --git a/test/lisp/erc/resources/commands/squery.eld
b/test/lisp/erc/resources/commands/squery.eld
new file mode 100644
index 00000000000..bcd176e515b
--- /dev/null
+++ b/test/lisp/erc/resources/commands/squery.eld
@@ -0,0 +1,31 @@
+;; -*- mode: lisp-data; -*-
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
+ (0.07 ":ircnet.hostsailor.com 020 * :Please wait while we process your
connection.")
+ (0.03 ":ircnet.hostsailor.com 001 tester :Welcome to the Internet Relay
Network tester!~user@93.184.216.34")
+ (0.02 ":ircnet.hostsailor.com 002 tester :Your host is ircnet.hostsailor.com,
running version 2.11.2p3+0PNv1.06")
+ (0.03 ":ircnet.hostsailor.com 003 tester :This server was created Thu May 20
2021 at 17:13:24 EDT")
+ (0.01 ":ircnet.hostsailor.com 004 tester ircnet.hostsailor.com
2.11.2p3+0PNv1.06 aoOirw abeiIklmnoOpqrRstv")
+ (0.00 ":ircnet.hostsailor.com 005 tester RFC2812 PREFIX=(ov)@+ CHANTYPES=#&!+
MODES=3 CHANLIMIT=#&!+:42 NICKLEN=15 TOPICLEN=255 KICKLEN=255 MAXLIST=beIR:64
CHANNELLEN=50 IDCHAN=!:5 CHANMODES=beIR,k,l,imnpstaqrzZ :are supported by this
server")
+ (0.01 ":ircnet.hostsailor.com 005 tester PENALTY FNC EXCEPTS=e INVEX=I
CASEMAPPING=ascii NETWORK=IRCnet :are supported by this server")
+ (0.01 ":ircnet.hostsailor.com 042 tester 0PNHANAWX :your unique ID")
+ (0.01 ":ircnet.hostsailor.com 251 tester :There are 18711 users and 2
services on 26 servers")
+ (0.01 ":ircnet.hostsailor.com 252 tester 63 :operators online")
+ (0.01 ":ircnet.hostsailor.com 253 tester 4 :unknown connections")
+ (0.01 ":ircnet.hostsailor.com 254 tester 10493 :channels formed")
+ (0.01 ":ircnet.hostsailor.com 255 tester :I have 933 users, 0 services and 1
servers")
+ (0.01 ":ircnet.hostsailor.com 265 tester 933 1328 :Current local users 933,
max 1328")
+ (0.01 ":ircnet.hostsailor.com 266 tester 18711 25625 :Current global users
18711, max 25625")
+ (0.02 ":ircnet.hostsailor.com 375 tester :- ircnet.hostsailor.com Message of
the Day - ")
+ (0.01 ":ircnet.hostsailor.com 372 tester :- 17/11/2023 3:08")
+ (0.02 ":ircnet.hostsailor.com 376 tester :End of MOTD command."))
+
+((mode 10 "MODE tester +i")
+ (0.00 ":ircnet.hostsailor.com NOTICE tester :Your connection is secure
(SSL/TLS).")
+ (0.01 ":tester MODE tester :+i"))
+
+((squery 10 "SQUERY alis :help list")
+ (0.08 ":Alis@hub.uk NOTICE tester :Searches for a channel")
+ (0.01 ":Alis@hub.uk NOTICE tester :/SQUERY Alis LIST mask [-options]")
+ (0.04 ":Alis@hub.uk NOTICE tester :[...]")
+ (0.01 ":Alis@hub.uk NOTICE tester :See also: HELP EXAMPLES"))
diff --git
a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
new file mode 100644
index 00000000000..893588c028f
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<bob> [...]
\ No newline at end of file
diff --git
a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
new file mode 100644
index 00000000000..2b67cbbf90e
--- /dev/null
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -0,0 +1 @@
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<bob> [...]
\ No newline at end of file
diff --git a/test/lisp/eshell/em-hist-tests.el
b/test/lisp/eshell/em-hist-tests.el
index 0f143355115..466d19cc6f7 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -19,6 +19,9 @@
;;; Code:
+(eval-when-compile
+ (require 'cl-lib))
+
(require 'ert)
(require 'ert-x)
(require 'em-hist)
@@ -29,9 +32,94 @@
(file-name-directory (or load-file-name
default-directory))))
+(cl-defun em-hist-test/check-history-file (file-name expected &optional
+ (expected-ring t))
+ "Check that the contents of FILE-NAME match the EXPECTED history entries.
+Additonally, check that after loading the file, the history ring
+matches too. If EXPECTED-RING is a list, compare the ring
+elements against that; if t (the default), check against EXPECTED."
+ (when (eq expected-ring t) (setq expected-ring expected))
+ ;; First check the actual file.
+ (should (equal (with-temp-buffer
+ (insert-file-contents file-name)
+ (buffer-string))
+ (mapconcat (lambda (i) (concat i "\n")) expected)))
+ ;; Now read the history ring and check that too.
+ (let (eshell-history-ring eshell-history-index eshell-hist--new-items)
+ (eshell-read-history file-name)
+ (should (equal (nreverse (ring-elements eshell-history-ring))
+ expected-ring))))
+
;;; Tests:
-(ert-deftest em-hist-test/write-readonly-history ()
+(ert-deftest em-hist-test/write-history/append ()
+ "Test appending new history to history file."
+ (ert-with-temp-file histfile
+ (with-temp-eshell
+ (em-hist-test/check-history-file histfile nil)
+ (eshell-insert-command "echo hi")
+ (eshell-write-history histfile 'append)
+ (em-hist-test/check-history-file histfile '("echo hi"))
+ (eshell-insert-command "echo bye")
+ (eshell-write-history histfile 'append)
+ (em-hist-test/check-history-file histfile '("echo hi" "echo bye")))))
+
+(ert-deftest em-hist-test/write-history/append-multiple-eshells ()
+ "Test appending new history to history file from multiple Eshells."
+ (ert-with-temp-file histfile
+ (with-temp-eshell
+ (with-temp-eshell
+ ;; Enter some commands and save them.
+ (eshell-insert-command "echo foo")
+ (eshell-insert-command "echo bar")
+ (eshell-write-history histfile 'append)
+ (em-hist-test/check-history-file histfile '("echo foo" "echo bar")))
+ ;; Now do the same in the first Eshell buffer.
+ (eshell-insert-command "echo goat")
+ (eshell-insert-command "echo panda")
+ (eshell-write-history histfile 'append)
+ (em-hist-test/check-history-file
+ histfile '("echo foo" "echo bar" "echo goat" "echo panda")))))
+
+(ert-deftest em-hist-test/write-history/overwrite ()
+ "Test overwriting history file."
+ (ert-with-temp-file histfile
+ (with-temp-eshell
+ (em-hist-test/check-history-file histfile nil)
+ (eshell-insert-command "echo hi")
+ (eshell-insert-command "echo bye")
+ (eshell-insert-command "echo bye")
+ (eshell-insert-command "echo hi")
+ (eshell-write-history histfile)
+ (em-hist-test/check-history-file
+ histfile '("echo hi" "echo bye" "echo bye" "echo hi"))
+ (let ((eshell-hist-ignoredups t))
+ (em-hist-test/check-history-file
+ histfile '("echo hi" "echo bye" "echo bye" "echo hi")
+ '("echo hi" "echo bye" "echo hi")))
+ (let ((eshell-hist-ignoredups 'erase))
+ (em-hist-test/check-history-file
+ histfile '("echo hi" "echo bye" "echo bye" "echo hi")
+ '("echo bye" "echo hi"))))))
+
+(ert-deftest em-hist-test/write-history/overwrite-multiple-shells ()
+ "Test overwriting history file from multiple Eshells."
+ (ert-with-temp-file histfile
+ (with-temp-eshell
+ (with-temp-eshell
+ ;; Enter some commands and save them.
+ (eshell-insert-command "echo foo")
+ (eshell-insert-command "echo bar")
+ (eshell-write-history histfile)
+ (em-hist-test/check-history-file histfile '("echo foo" "echo bar")))
+ ;; Now do the same in the first Eshell buffer.
+ (eshell-insert-command "echo goat")
+ (eshell-insert-command "echo panda")
+ (eshell-write-history histfile)
+ (em-hist-test/check-history-file
+ histfile '("echo goat" "echo panda")))))
+
+(ert-deftest em-hist-test/write-history/read-only ()
"Test that having read-only strings in history is okay."
(ert-with-temp-file histfile
(let ((eshell-history-ring (make-ring 2)))
@@ -39,7 +127,8 @@
(propertize "echo foo" 'read-only t))
(ring-insert eshell-history-ring
(propertize "echo bar" 'read-only t))
- (eshell-write-history histfile))))
+ (eshell-write-history histfile)
+ (em-hist-test/check-history-file histfile '("echo foo" "echo bar")))))
(ert-deftest em-hist-test/add-to-history/allow-dups ()
"Test adding to history, allowing dups."
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 3492bd701b2..3e499fff468 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1656,6 +1656,31 @@ The door of all subtleties!
(should (equal (file-name-base "foo") "foo"))
(should (equal (file-name-base "foo/bar") "bar")))
+(defun files-tests--check-shebang (shebang expected-mode)
+ "Assert that mode for SHEBANG derives from EXPECTED-MODE."
+ (let ((actual-mode
+ (ert-with-temp-file script-file
+ :text shebang
+ (find-file script-file)
+ (if (derived-mode-p expected-mode)
+ expected-mode
+ major-mode))))
+ ;; Tuck all the information we need in the `should' form: input
+ ;; shebang, expected mode vs actual.
+ (should
+ (equal (list shebang actual-mode)
+ (list shebang expected-mode)))))
+
+(ert-deftest files-tests-auto-mode-interpreter ()
+ "Test that `set-auto-mode' deduces correct modes from shebangs."
+ (files-tests--check-shebang "#!/bin/bash" 'sh-mode)
+ (files-tests--check-shebang "#!/usr/bin/env bash" 'sh-mode)
+ (files-tests--check-shebang "#!/usr/bin/env python" 'python-base-mode)
+ (files-tests--check-shebang "#!/usr/bin/env python3" 'python-base-mode)
+ (files-tests--check-shebang "#!/usr/bin/env -S awk -v FS=\"\\t\" -v
OFS=\"\\t\" -f" 'awk-mode)
+ (files-tests--check-shebang "#!/usr/bin/env -S make -f" 'makefile-mode)
+ (files-tests--check-shebang "#!/usr/bin/make -f" 'makefile-mode))
+
(ert-deftest files-test-dir-locals-auto-mode-alist ()
"Test an `auto-mode-alist' entry in `.dir-locals.el'"
(find-file (ert-resource-file "whatever.quux"))
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index e71f0a5785f..693f15336f2 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -39,6 +39,157 @@
(isearch-done))
+;; Search invisible.
+
+(declare-function outline-hide-sublevels "outline")
+
+(ert-deftest isearch--test-invisible ()
+ (require 'outline)
+ (with-temp-buffer
+ (set-window-buffer nil (current-buffer))
+ (insert "\n1\n"
+ (propertize "2" 'invisible t)
+ (propertize "3" 'inhibit-isearch t)
+ "\n* h\n4\n\n")
+ (outline-mode)
+ (outline-hide-sublevels 1)
+ (goto-char (point-min))
+
+ (let ((isearch-lazy-count nil)
+ (search-invisible t)
+ (inhibit-message t))
+
+ (isearch-forward-regexp nil 1)
+ (isearch-process-search-string "[0-9]" "[0-9]")
+ (should (eq (point) 3))
+
+ (isearch-lazy-highlight-start)
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2)))
+
+ (isearch-repeat-forward)
+ (should (eq (point) 5))
+ (should (get-char-property 4 'invisible))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should (get-char-property 11 'invisible))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+
+ (isearch-forward-regexp nil 1)
+ (setq isearch-invisible nil) ;; isearch-toggle-invisible
+ (isearch-process-search-string "[0-9]" "[0-9]")
+
+ (isearch-lazy-highlight-start)
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2)))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+
+ (isearch-forward-regexp nil 1)
+ (setq isearch-invisible 'open) ;; isearch-toggle-invisible
+ (isearch-process-search-string "[0-9]" "[0-9]")
+ (should (eq (point) 3))
+
+ (isearch-lazy-highlight-start)
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2 11)))
+
+ (let ((isearch-hide-immediately t))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should-not (get-char-property 11 'invisible))
+ (isearch-delete-char)
+ (should (get-char-property 11 'invisible)))
+
+ (let ((isearch-hide-immediately nil))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should-not (get-char-property 11 'invisible))
+ (isearch-delete-char)
+ (should-not (get-char-property 11 'invisible)))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+ (isearch-clean-overlays)
+ (should (get-char-property 11 'invisible)))
+
+ (let ((isearch-lazy-count t)
+ (search-invisible t)
+ (inhibit-message t))
+
+ (isearch-forward-regexp nil 1)
+ (isearch-process-search-string "[0-9]" "[0-9]")
+ (should (eq (point) 3))
+
+ (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil)
+ (isearch-lazy-highlight-start)
+ (isearch-lazy-highlight-buffer-update)
+ (should (eq isearch-lazy-count-invisible nil))
+ (should (eq isearch-lazy-count-total 3))
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2)))
+
+ (isearch-repeat-forward)
+ (should (eq (point) 5))
+ (should (get-char-property 4 'invisible))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should (get-char-property 11 'invisible))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+
+ (isearch-forward-regexp nil 1)
+ (setq isearch-invisible nil) ;; isearch-toggle-invisible
+ (isearch-process-search-string "[0-9]" "[0-9]")
+
+ (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil)
+ (isearch-lazy-highlight-start)
+ (isearch-lazy-highlight-buffer-update)
+ (should (eq isearch-lazy-count-invisible 2))
+ (should (eq isearch-lazy-count-total 1))
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2)))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+
+ (isearch-forward-regexp nil 1)
+ (setq isearch-invisible 'open) ;; isearch-toggle-invisible
+ (isearch-process-search-string "[0-9]" "[0-9]")
+ (should (eq (point) 3))
+
+ (setq isearch-lazy-count-invisible nil isearch-lazy-count-total nil)
+ (isearch-lazy-highlight-start)
+ (isearch-lazy-highlight-buffer-update)
+ (should (eq isearch-lazy-count-invisible 1))
+ (should (eq isearch-lazy-count-total 2))
+ (should (equal (seq-uniq (mapcar #'overlay-start
isearch-lazy-highlight-overlays))
+ '(2 11)))
+
+ (let ((isearch-hide-immediately t))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should-not (get-char-property 11 'invisible))
+ (isearch-delete-char)
+ (should (get-char-property 11 'invisible)))
+
+ (let ((isearch-hide-immediately nil))
+ (isearch-repeat-forward)
+ (should (eq (point) 12))
+ (should-not (get-char-property 11 'invisible))
+ (isearch-delete-char)
+ (should-not (get-char-property 11 'invisible)))
+
+ (goto-char isearch-opoint)
+ (isearch-done t)
+ (isearch-clean-overlays)
+ (should (get-char-property 11 'invisible)))))
+
+
;; Search functions.
(defun isearch--test-search-within-boundaries (pairs)
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 27d71805502..28bca60b189 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -33,14 +33,13 @@
(ert-deftest completion-test1 ()
(with-temp-buffer
- (cl-flet* ((test/completion-table (_string _pred action)
- (if (eq action 'lambda)
- nil
- "test: "))
+ (cl-flet* ((test/completion-table (string pred action)
+ (let ((completion-ignore-case t))
+ (complete-with-action action '("test: ") string pred)))
(test/completion-at-point ()
- (list (copy-marker (point-min))
- (copy-marker (point))
- #'test/completion-table)))
+ (list (copy-marker (point-min))
+ (copy-marker (point))
+ #'test/completion-table)))
(let ((completion-at-point-functions (list #'test/completion-at-point)))
(insert "TEST")
(completion-at-point)
@@ -190,7 +189,8 @@
(defun completion--pcm-score (comp)
"Get `completion-score' from COMP."
- (get-text-property 0 'completion-score comp))
+ ;; FIXME, uses minibuffer.el implementation details
+ (completion--flex-score comp completion-pcm--regexp))
(defun completion--pcm-first-difference-pos (comp)
"Get `completions-first-difference' from COMP."
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a2460686e96..726403f193c 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4881,6 +4881,7 @@ This tests also `make-symbolic-link', `file-truename' and
`add-name-to-file'."
(if (tramp--test-expensive-test-p)
;; It doesn't work for `initials' and `shorthand'
;; completion styles. Should it?
+ ;; `orderless' passes the tests, but it is an ELPA package.
'(emacs21 emacs22 basic partial-completion substring flex)
'(basic)))
@@ -5193,10 +5194,11 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(defun tramp--test-timeout-handler (&rest _ignore)
"Timeout handler, reporting a failed test."
(interactive)
- (let ((proc (get-buffer-process (current-buffer))))
- (when (processp proc)
- (tramp--test-message
- "cmd: %s\nbuf:\n%s\n---" (process-command proc) (buffer-string))))
+ (tramp--test-message "proc: %s" (get-buffer-process (current-buffer)))
+ (when-let ((proc (get-buffer-process (current-buffer)))
+ ((processp proc)))
+ (tramp--test-message "cmd: %s" (process-command proc)))
+ (tramp--test-message "buf: %s\n%s\n---" (current-buffer) (buffer-string))
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
(ert-deftest tramp-test29-start-file-process ()
diff --git a/test/lisp/progmodes/bug-reference-tests.el
b/test/lisp/progmodes/bug-reference-tests.el
index 790582aed4c..e5b207748bf 100644
--- a/test/lisp/progmodes/bug-reference-tests.el
+++ b/test/lisp/progmodes/bug-reference-tests.el
@@ -25,6 +25,7 @@
(require 'bug-reference)
(require 'ert)
+(require 'ert-x)
(defun test--get-github-entry (url)
(and (string-match
@@ -125,4 +126,18 @@
(test--get-gitea-entry "https://gitea.com/magit/magit/";)
"magit/magit")))
+(ert-deftest test-thing-at-point ()
+ "Ensure that (thing-at-point 'url) returns the bug URL."
+ (ert-with-test-buffer (:name "thingatpt")
+ (setq-local bug-reference-url-format "https://debbugs.gnu.org/%s";)
+ (insert "bug#1234")
+ (bug-reference-mode)
+ (jit-lock-fontify-now (point-min) (point-max))
+ (goto-char (point-min))
+ ;; Make sure we get the URL when `bug-reference-mode' is active...
+ (should (equal (thing-at-point 'url) "https://debbugs.gnu.org/1234";))
+ (bug-reference-mode -1)
+ ;; ... and get nil when `bug-reference-mode' is inactive.
+ (should-not (thing-at-point 'url))))
+
;;; bug-reference-tests.el ends here
diff --git a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
index 146ee76574e..20f423259b4 100644
--- a/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/typescript-ts-mode-resources/indent.erts
@@ -23,6 +23,28 @@ const foo = () => {
}
=-=-=
+Name: Statement indentation without braces
+
+=-=
+const foo = () => {
+ if (true)
+ console.log("if_statement");
+ else if (false)
+ console.log("if_statement");
+ else
+ console.log("else_clause");
+ for (let i = 0; i < 1; i++)
+ console.log("for_statement");
+ for (let i of [true])
+ console.log("for_in_statement");
+ while (false)
+ console.log("while_statement");
+ do
+ console.log("do_statement");
+ while (false)
+};
+=-=-=
+
Code:
(lambda ()
(setq indent-tabs-mode nil)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index db327056533..f485328aa7a 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -345,8 +345,7 @@
;;;; Mode hooks.
-(defalias 'subr-tests--parent-mode
- (if (fboundp 'prog-mode) 'prog-mode 'fundamental-mode))
+(defalias 'subr-tests--parent-mode #'prog-mode)
(define-derived-mode subr-tests--derived-mode-1 prog-mode "test")
(define-derived-mode subr-tests--derived-mode-2 subr-tests--parent-mode "test")
@@ -360,6 +359,41 @@
'subr-tests--parent-mode))
(should (provided-mode-derived-p 'subr-tests--derived-mode-2 'prog-mode)))
+
+(define-derived-mode subr-tests--mode-A subr-tests--derived-mode-1 "t")
+(define-derived-mode subr-tests--mode-B subr-tests--mode-A "t")
+(defalias 'subr-tests--mode-C #'subr-tests--mode-B)
+(derived-mode-add-parents 'subr-tests--mode-A '(subr-tests--mode-C))
+
+(ert-deftest subr-tests--derived-mode-add-parents ()
+ ;; The Right Answer is somewhat unclear in the presence of cycles,
+ ;; but let's make sure we get tolerable answers.
+ ;; FIXME: Currently `prog-mode' doesn't always end up at the end :-(
+ (let ((set-equal (lambda (a b)
+ (not (or (cl-set-difference a b)
+ (cl-set-difference b a))))))
+ (dolist (mode '(subr-tests--mode-A subr-tests--mode-B subr-tests--mode-C))
+ (should (eq (derived-mode-all-parents mode)
+ (derived-mode-all-parents mode)))
+ (should (eq mode (car (derived-mode-all-parents mode))))
+ (should (funcall set-equal
+ (derived-mode-all-parents mode)
+ '(subr-tests--mode-A subr-tests--mode-B prog-mode
+ subr-tests--mode-C subr-tests--derived-mode-1))))))
+
+(ert-deftest subr-tests--merge-ordered-lists ()
+ (should (equal (merge-ordered-lists
+ '((B A) (C A) (D B) (E D C))
+ (lambda (_) (error "cycle")))
+ '(E D B C A)))
+ (should (equal (merge-ordered-lists
+ '((E D C) (B A) (C A) (D B))
+ (lambda (_) (error "cycle")))
+ '(E D C B A)))
+ (should-error (merge-ordered-lists
+ '((E C D) (B A) (A C) (D B))
+ (lambda (_) (error "cycle")))))
+
(ert-deftest number-sequence-test ()
(should (= (length
(number-sequence (1- most-positive-fixnum) most-positive-fixnum))
diff --git a/test/src/search-tests.el b/test/src/search-tests.el
index 293a715f5dc..32dc8a72a86 100644
--- a/test/src/search-tests.el
+++ b/test/src/search-tests.el
@@ -39,4 +39,42 @@
(replace-match "bcd"))
(should (= (point) 10)))))
+(ert-deftest search-test--replace-match-update-data ()
+ (with-temp-buffer
+ (pcase-dolist (`(,pre ,post) '(("" "")
+ ("a" "")
+ ("" "b")
+ ("a" "b")))
+ (erase-buffer)
+ (insert "hello ")
+ (save-excursion (insert pre post " world"))
+ (should (looking-at
+ (concat "\\(\\)" pre "\\(\\)\\(\\(\\)\\)\\(\\)" post "\\(\\)")))
+ (let* ((beg0 (match-beginning 0))
+ (beg4 (+ beg0 (length pre)))
+ (end4 (+ beg4 (length "BOO")))
+ (end0 (+ end4 (length post))))
+ (replace-match "BOO" t t nil 4)
+ (should (equal (match-beginning 0) beg0))
+ (should (equal (match-beginning 1) beg0))
+ (should (equal (match-beginning 2) beg4))
+ (should (equal (match-beginning 3) beg4))
+ (should (equal (match-beginning 4) beg4))
+ (should (equal (match-end 6) end0))
+ (should (equal (match-end 5) end4))
+ (should (equal (match-end 4) end4))
+ (should (equal (match-end 3) end4))
+ (should (equal (match-end 0) end0))
+ ;; `update_search_regs' doesn't have enough information to get
+ ;; the ones below correctly in all cases.
+ (when (> (length post) 0)
+ (should (equal (match-beginning 6) end0)))
+ (when (> (length pre) 0)
+ (should (equal (match-end 1) beg0)))
+ ;; `update_search_regs' doesn't have enough information to get
+ ;; the ones below correctly at all.
+ ;;(should (equal (match-beginning 5) end4))
+ ;;(should (equal (match-end 2) beg4))
+ ))))
+
;;; search-tests.el ends here