[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/pkg e7125f90096: Merge remote-tracking branch 'origin/master' in
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/pkg e7125f90096: Merge remote-tracking branch 'origin/master' into scratch/pkg |
|
Date: |
Sat, 14 Oct 2023 04:13:35 -0400 (EDT) |
branch: scratch/pkg
commit e7125f90096c32ff1a904a53eeb8e0c3aba00a15
Merge: a74d63d871e 03f5a06a052
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into scratch/pkg
---
.clang-format | 5 +-
ChangeLog.4 | 2 +-
admin/git-bisect-start | 16 +-
admin/make-tarball.txt | 5 +
configure.ac | 14 +-
doc/emacs/android.texi | 135 +++--
doc/emacs/building.texi | 14 +
doc/emacs/custom.texi | 1 +
doc/emacs/display.texi | 2 +-
doc/emacs/emacs.texi | 5 +-
doc/emacs/frames.texi | 17 +-
doc/emacs/macos.texi | 5 +-
doc/emacs/maintaining.texi | 312 ++++++-----
doc/emacs/misc.texi | 2 +-
doc/lispref/commands.texi | 21 +-
doc/lispref/frames.texi | 6 +-
doc/lispref/functions.texi | 4 +-
doc/lispref/os.texi | 3 +-
doc/lispref/processes.texi | 6 +-
doc/misc/calc.texi | 8 +-
doc/misc/cl.texi | 155 ++++++
doc/misc/ediff.texi | 6 +-
doc/misc/erc.texi | 35 ++
doc/misc/eshell.texi | 2 -
doc/misc/gnus.texi | 2 +-
doc/misc/viper.texi | 7 +-
etc/ERC-NEWS | 71 ++-
etc/NEWS | 86 ++-
etc/emacs_lldb.py | 76 ++-
etc/refcards/orgcard.tex | 2 +-
java/AndroidManifest.xml.in | 7 +-
java/INSTALL | 16 +-
java/org/gnu/emacs/EmacsActivity.java | 7 +-
java/org/gnu/emacs/EmacsInputConnection.java | 15 +
java/org/gnu/emacs/EmacsNative.java | 15 +
java/org/gnu/emacs/EmacsSdk7FontDriver.java | 2 +
java/org/gnu/emacs/EmacsService.java | 34 +-
java/org/gnu/emacs/EmacsView.java | 54 +-
java/org/gnu/emacs/EmacsWindow.java | 268 +++++++++-
lisp/arc-mode.el | 20 +-
lisp/bindings.el | 1 +
lisp/calc/calc-units.el | 39 +-
lisp/calendar/timeclock.el | 10 +-
lisp/cedet/ede/base.el | 3 +-
lisp/cedet/pulse.el | 4 +-
lisp/cedet/srecode/map.el | 3 +-
lisp/dnd.el | 10 +-
lisp/doc-view.el | 4 +-
lisp/emacs-lisp/bytecomp.el | 20 +-
lisp/emacs-lisp/cl-print.el | 105 ++--
lisp/emacs-lisp/disass.el | 17 +
lisp/emacs-lisp/elint.el | 9 +-
lisp/emacs-lisp/let-alist.el | 15 +-
lisp/emacs-lisp/macroexp.el | 20 +-
lisp/emacs-lisp/package-vc.el | 55 +-
lisp/erc/erc-backend.el | 14 +-
lisp/erc/erc-common.el | 1 +
lisp/erc/erc-compat.el | 15 +
lisp/erc/erc-fill.el | 271 +++++++---
lisp/erc/erc-goodies.el | 211 +++-----
lisp/erc/erc-ibuffer.el | 16 +-
lisp/erc/erc-match.el | 31 +-
lisp/erc/erc-networks.el | 5 +-
lisp/erc/erc-stamp.el | 234 +++++---
lisp/erc/erc-truncate.el | 2 +-
lisp/erc/erc.el | 534 +++++++++++++------
lisp/eshell/em-cmpl.el | 2 +-
lisp/eshell/em-script.el | 7 +-
lisp/eshell/em-smart.el | 2 +-
lisp/eshell/esh-cmd.el | 181 ++++---
lisp/eshell/esh-mode.el | 7 +-
lisp/eshell/esh-proc.el | 53 +-
lisp/eshell/esh-util.el | 8 +
lisp/eshell/eshell.el | 5 +-
lisp/filenotify.el | 14 +-
lisp/files.el | 3 +-
lisp/gnus/gnus-sum.el | 40 +-
lisp/help.el | 12 +-
lisp/ido.el | 4 +-
lisp/image-mode.el | 18 +-
lisp/leim/quail/cyrillic.el | 4 +-
lisp/ls-lisp.el | 5 +-
lisp/menu-bar.el | 17 +-
lisp/net/dictionary.el | 54 +-
lisp/net/mairix.el | 5 +-
lisp/net/rcirc.el | 3 +-
lisp/net/tramp-gvfs.el | 9 +-
lisp/net/tramp-sh.el | 34 +-
lisp/net/tramp-smb.el | 3 +
lisp/net/tramp-sudoedit.el | 3 +
lisp/net/tramp.el | 21 +-
lisp/org/org-agenda.el | 3 +-
lisp/org/org-colview.el | 3 +-
lisp/org/org-version.el | 4 +-
lisp/org/org.el | 2 +-
lisp/pcomplete.el | 36 +-
lisp/printing.el | 4 +-
lisp/progmodes/cc-engine.el | 13 +-
lisp/progmodes/compile.el | 7 +-
lisp/progmodes/cperl-mode.el | 125 +++--
lisp/progmodes/elisp-mode.el | 6 +-
lisp/progmodes/fortran.el | 2 +-
lisp/progmodes/gud.el | 60 ++-
lisp/progmodes/project.el | 42 +-
lisp/progmodes/ruby-mode.el | 4 +-
lisp/progmodes/verilog-mode.el | 5 +-
lisp/progmodes/xref.el | 14 +
lisp/simple.el | 8 +-
lisp/subr.el | 22 +-
lisp/term.el | 9 +-
lisp/term/android-win.el | 58 ++
lisp/term/bobcat.el | 4 +-
lisp/touch-screen.el | 8 +-
lisp/treesit.el | 4 +-
lisp/type-break.el | 6 +-
lisp/vc/ediff.el | 6 +-
lisp/vc/smerge-mode.el | 6 +-
lisp/vc/vc.el | 52 +-
lisp/woman.el | 10 +-
src/android.c | 223 +++++++-
src/android.h | 2 +-
src/androidfns.c | 49 +-
src/androidgui.h | 52 ++
src/androidmenu.c | 16 +-
src/androidselect.c | 10 +-
src/androidterm.c | 93 +++-
src/androidvfs.c | 38 +-
src/frame.h | 1 +
src/gfilenotify.c | 8 +-
src/image.c | 84 ++-
src/inotify.c | 7 +
src/keyboard.c | 9 +
src/kqueue.c | 10 +-
src/nsfns.m | 7 +-
src/nsmenu.m | 4 +
src/nsterm.m | 44 +-
src/process.c | 16 +-
src/regex-emacs.c | 41 +-
src/sfntfont-android.c | 37 +-
src/textconv.c | 168 +++++-
src/textconv.h | 3 +
src/xdisp.c | 14 +-
src/xterm.c | 54 +-
test/lisp/erc/erc-fill-tests.el | 78 ++-
test/lisp/erc/erc-scenarios-log.el | 1 +
test/lisp/erc/erc-scenarios-match.el | 272 ++++++++--
.../erc/erc-scenarios-scrolltobottom-relaxed.el | 5 +-
test/lisp/erc/erc-scenarios-scrolltobottom.el | 4 +-
test/lisp/erc/erc-stamp-tests.el | 2 +-
test/lisp/erc/erc-tests.el | 587 +++++++++++++++++----
.../erc/resources/base/assoc/multi-net/barnet.eld | 12 +-
.../erc/resources/base/assoc/multi-net/foonet.eld | 12 +-
.../resources/base/netid/bouncer/barnet-drop.eld | 4 +-
.../resources/base/netid/bouncer/foonet-drop.eld | 6 +-
test/lisp/erc/resources/erc-d/erc-d.el | 50 +-
.../resources/erc-d/resources/dynamic-foonet.eld | 2 +-
test/lisp/erc/resources/erc-scenarios-common.el | 3 +-
.../resources/fill/snapshots/merge-01-start.eld | 2 +-
.../resources/fill/snapshots/merge-02-right.eld | 2 +-
.../erc/resources/fill/snapshots/merge-wrap-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../resources/fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../resources/fill/snapshots/spacing-01-mono.eld | 2 +-
.../resources/fill/snapshots/stamps-left-01.eld | 2 +-
.../foonet.eld => match/fools/fill-wrap.eld} | 30 +-
test/lisp/erc/resources/sasl/scram-sha-1.eld | 2 +-
test/lisp/erc/resources/sasl/scram-sha-256.eld | 2 +-
test/lisp/eshell/em-script-tests.el | 13 +
test/lisp/eshell/esh-cmd-tests.el | 29 +-
test/lisp/eshell/eshell-tests.el | 33 +-
test/lisp/filenotify-tests.el | 68 ++-
test/lisp/net/tramp-tests.el | 11 +
test/lisp/progmodes/compile-tests.el | 26 +-
.../cperl-mode-resources/cperl-bug-66145.pl | 62 +++
.../cperl-mode-resources/cperl-bug-66161.pl | 13 +
test/lisp/progmodes/cperl-mode-tests.el | 37 ++
test/src/regex-emacs-tests.el | 9 +-
179 files changed, 4817 insertions(+), 1713 deletions(-)
diff --git a/.clang-format b/.clang-format
index 5c987536b0c..7929a7435f2 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,4 +1,3 @@
-Language: Cpp
BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
AlignOperands: Align
@@ -35,6 +34,10 @@ PenaltyBreakBeforeFirstCallParameter: 2000
SpaceAfterCStyleCast: true
SpaceBeforeParens: Always
UseTab: Always
+---
+Language: Cpp
+---
+Language: ObjC
# Local Variables:
# mode: yaml
diff --git a/ChangeLog.4 b/ChangeLog.4
index 372b03b32b2..1c9b8f43377 100644
--- a/ChangeLog.4
+++ b/ChangeLog.4
@@ -79829,7 +79829,7 @@
Some adjustments to last change
* src/gtkutil.c (xg_set_undecorated): Only set ARGB visual on
- Cairo builds wtihout PGTK.
+ Cairo builds without PGTK.
* src/xfns.c (select_visual): Likewise.
2022-01-29 Håkon Flatval <hkon20@hotmail.com>
diff --git a/admin/git-bisect-start b/admin/git-bisect-start
index 8eb5328a1a1..30a738267fa 100755
--- a/admin/git-bisect-start
+++ b/admin/git-bisect-start
@@ -2,7 +2,9 @@
### Start a git bisection, ensuring that commits in branches that are
### the result of merging external trees into the Emacs repository, as
-### well as certain commits on which Emacs fails to build, are skipped.
+### well as certain commits on which Emacs fails to build (with the
+### default options, on a GNU/Linux computer and with GCC; see below),
+### are skipped.
## Copyright (C) 2022-2023 Free Software Foundation, Inc.
@@ -82,7 +84,7 @@ done
# SKIP-BRANCH 58cc931e92ece70c3e64131ee12a799d65409100
## The list below is the exhaustive list of all commits between Dec 1
-## 2016 and Aug 10 2023 on which building Emacs with the default
+## 2016 and Oct 2 2023 on which building Emacs with the default
## options, on a GNU/Linux computer and with GCC, fails. It is
## possible (though unlikely) that building Emacs with non-default
## options, with other compilers, or on other platforms, would succeed
@@ -1776,3 +1778,13 @@ $REAL_GIT bisect skip $(cat $0 | grep '^# SKIP-SINGLE '
| sed 's/^# SKIP-SINGLE
# SKIP-SINGLE 2752573dfb76873dbe783e89a1fbf01d157c54e3
# SKIP-SINGLE 62e990db7a2fad16756e019b331c28ad5a5a89fe
# SKIP-SINGLE 6253e7e74249c7cdfa86723f0b91a1d207cb143e
+# SKIP-SINGLE 1f7113e68988fa0bcbdeca5ae364cba8d6db3637
+# SKIP-SINGLE 6e44d6e18438ea2665ae6252a6ec090963dd7e42
+# SKIP-SINGLE 168cc0aff0bfbc1d67a7e8a72b88a1bf10ad019e
+# SKIP-SINGLE efb276fef1f580eafa8458fc262a4b35eb3abd5e
+# SKIP-SINGLE cc0d7d7a3867e4554f89262e4641c9845ee0d647
+# SKIP-SINGLE 012f9c28053d06b6d527d77530605aedbd55d5b4
+# SKIP-SINGLE e61a03984335b4ffb164280b2df80668b2a92c23
+# SKIP-SINGLE f7fd21b06865d20a16c11e20776e843db24d4b14
+# SKIP-SINGLE 35fbf6f15830f576fd1909f4a8d30e7ba1d777bd
+# SKIP-SINGLE 0e44ab5f061c81874dd8298a0f3318f14ef95a24
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 505d3469d3c..5704e8e8922 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -22,6 +22,11 @@ Steps to take before starting on the first pretest in any
release sequence:
You can use 'gnupload --delete' (see below for more gnupload details).
(We currently don't bother with this.)
+4. Check that all new Lisp libraries belong to sensible packages.
+ Run "make -C lisp finder-data" and check the diff of the generated
+ file against the previously released Emacs version to see what has
+ changed.
+
General steps (for each step, check for possible errors):
1. git pull # fetch from the repository
diff --git a/configure.ac b/configure.ac
index 9ae0dec3867..4456cd89b7a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -941,7 +941,7 @@ a valid path to android.jar. See config.log for more
details.])
fi
AC_CACHE_CHECK([whether android.jar is new enough],
- [emacs_cv_android_s_or_later],
+ [emacs_cv_android_u_or_later],
AS_IF([rm -f conftest.class
cat << EOF > conftest.java
@@ -949,18 +949,18 @@ import android.os.Build;
class conftest
{
- private static int test = Build.VERSION_CODES.TIRAMISU;
+ private static int test = Build.VERSION_CODES.UPSIDE_DOWN_CAKE;
}
EOF
("$JAVAC" -classpath "$with_android" -target 1.7 -source 1.7 conftest.java \
-d . >&AS_MESSAGE_LOG_FD 2>&1) && test -s conftest.class && rm -f
conftest.class],
- [emacs_cv_android_s_or_later=yes],
- [emacs_cv_android_s_or_later=no]))
+ [emacs_cv_android_u_or_later=yes],
+ [emacs_cv_android_u_or_later=no]))
- if test "$emacs_cv_android_s_or_later" = "no"; then
+ if test "$emacs_cv_android_u_or_later" = "no"; then
AC_MSG_ERROR([Emacs must be built with an android.jar file produced for \
-Android 13 (Tiramisu) or later.])
+Android 14 (Upside Down Cake) or later.])
fi
dnl See if the Java compiler supports the `--release' option which
@@ -1152,6 +1152,8 @@ main (void)
foo = "emacs_api_32";
#elif __ANDROID_API__ < 34
foo = "emacs_api_33";
+#elif __ANDROID_API__ < 35
+ foo = "emacs_api_34";
#else
foo = "emacs_api_future";
#endif
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 9f3cca2b137..d4ce762e7a0 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -333,7 +333,7 @@ time.
From the perspective of users, Android is mostly a single user
operating system; however, from the perspective of applications and
-Emacs, the system has an overwhelming number of users.
+Emacs, the system is host to an overwhelming number of users.
Each application runs in its own user, with its home directory set
to its app data directory (@pxref{Android File
@@ -360,12 +360,12 @@ consult the values of the variables
@code{ctags-program-name},
@xref{Subprocess Creation,,, elisp, the Emacs Lisp Reference Manual}.
The @file{/assets} directory containing Emacs start-up files is
-supposed to be inaccessible to processes not directly created by
+meant to be inaccessible to processes not directly created by
@code{zygote}, the system service responsible for starting
applications. Since required Lisp is found in the @file{/assets}
directory, it would thus follow that it is not possible for Emacs to
start itself as a subprocess. A special binary named
-@command{libandroid-emacs.so} is provided with Emacs, and does its
+@command{libandroid-emacs.so} is provided with Emacs, which tries its
best to start Emacs for the purpose of running Lisp in batch mode.
However, the approach it takes was devised by reading Android source
code, and is not sanctioned by the Android compatibility definition
@@ -419,25 +419,31 @@ system. When all Emacs frames move to the background,
Emacs might be
terminated by the system at any time, for the purpose of saving system
resources.
- On Android 7.1 and earlier, Emacs tells the system to treat it as a
-``background service''. The system will try to avoid killing Emacs
-unless the system is stressed for memory.
+ On Android 7.1 and earlier, Emacs designates itself a ``background
+service'', which impels the system to avoid killing Emacs unless it is
+stressed for memory.
Android 8.0 removed the ability for background services to receive
such special treatment. However, Emacs applies a workaround: the
system considers applications that create a permanent notification to
be performing active work, and will avoid killing such applications.
Thus, on those systems, Emacs displays a permanent notification for as
-long as it is running. Once the notification is displayed, it can be
-safely hidden through the system settings without resulting in Emacs
-being killed.
-
- However, it is not guaranteed that the system will not kill Emacs
-even if a notification is being displayed. While the Open Handset
-Alliance's sample implementation of Android behaves correctly, many
-manufacturers place additional restrictions on program execution in
-the background in their proprietary versions of Android. There is a
-list of such troublesome manufacturers and sometimes workarounds at
+long as it is running.
+
+ Before Android 13, Emacs does not require rights to display
+notifications. Under Android 13 or later, the notification is hidden
+until the user accords Emacs such rights. In spite of that, merely
+attempting to display the notification suffices to avert sudden death;
+whether the notification is displayed has no bearing on Emacs's
+capacity to execute in the background, and it may be disabled without
+any adverse consequences.
+
+ However, it is not guaranteed that the system will not kill Emacs.
+Although the Open Handset Alliance's sample implementation of Android
+behaves correctly, many manufacturers institute additional
+restrictions on program execution in the background in their
+proprietary versions of Android. There is a list of such troublesome
+manufacturers and sometimes workarounds at
@url{https://dontkillmyapp.com/}.
@cindex permissions under android
@@ -469,6 +475,10 @@ installation:
@code{android.permission.TRANSMIT_IR}
@item
@code{android.permission.WAKE_LOCK}
+@item
+@code{android.permission.FOREGROUND_SERVICE}
+@item
+@code{android.permission.FOREGROUND_SERVICE_SPECIAL_USE}
@end itemize
Other permissions must be granted by the user through the system
@@ -544,18 +554,18 @@ example, the permission to access contacts may be useful
for EUDC.
@node Android Windowing
@section The Android Window System
- Android has an unusual window system; there, all windows are
+ Android's window system is unusual, in that all windows are
maximized or full-screen, and only one window can be displayed at a
-time. On larger devices, the system allows up to four windows to be
-tiled on the screen at any time.
+time. On larger devices, the system permits simultaneously tiling up
+to four windows on the screen.
- Windows on Android do not continue to exist indefinitely after they
-are created. Instead, the system may choose to close windows that are
-not on screen in order to save memory, with the assumption that the
-program will save its contents to disk and restore them later, when
-the user asks for it to be opened again. As this is obviously not
-possible with Emacs, Emacs separates the resources associated with a
-frame from its system window.
+ Windows on Android do not exist indefinitely after they are created.
+Instead, the system may choose to close windows that are not on screen
+in order to conserve memory, with the assumption that the program will
+save its contents to disk and restore them later, when the user asks
+for it to be opened again. As this is obviously not possible with
+Emacs, Emacs separates the resources associated with a frame from its
+system window.
Each system window created (including the initial window created
during Emacs startup) is appended to a list of windows that do not
@@ -669,7 +679,7 @@ System -> Apps -> Emacs -> More -> Display over other apps
modifiers (@pxref{Modifier Keys}) reported within key events, subject
to a single exception: if @key{Alt} on your keyboard is depressed,
then the @key{Meta} modifier will be reported by Emacs in its place,
-and vice versa. This irregularity is since most keyboards posses no
+and vice versa. This irregularity is since most keyboards possess no
special @key{Meta} key, and the @key{Alt} modifier is seldom employed
in Emacs.
@@ -703,8 +713,8 @@ and @code{1000}.
@section Font Backends and Selection under Android
@cindex fonts, android
- Emacs supports two font backends under Android: they are respectively
-named @code{sfnt-android} and @code{android}.
+ Emacs supports two font backends under Android: they are
+respectively named @code{sfnt-android} and @code{android}.
Upon startup, Emacs enumerates all the TrueType format fonts in the
directories @file{/system/fonts} and @file{/product/fonts}, and the
@@ -713,17 +723,17 @@ home directory. Emacs assumes there will always be a
font named
``Droid Sans Mono'', and then defaults to using this font. These
fonts are then displayed by the @code{sfnt-android} font driver.
- When running on Android, Emacs currently lacks support for OpenType
-fonts. This means that only a subset of the fonts installed on the
-system are currently available to Emacs. If you are interested in
-lifting this limitation, please contact @email{emacs-devel@@gnu.org}.
+ This font driver is presently without support for OpenType fonts;
+hence, only a subset of the fonts installed on any given system are
+available to Emacs. If you are interested in lifting this limitation,
+please contact @email{emacs-devel@@gnu.org}.
If the @code{sfnt-android} font driver fails to find any fonts at
all, Emacs falls back to the @code{android} font driver. This is a
-very lousy font driver, because of limitations and inaccuracies in the
-font metrics provided by the Android platform. In that case, Emacs
-uses the ``Monospace'' typeface configured on your system; this should
-always be Droid Sans Mono.
+very poor font driver, consequent upon limitations and inaccuracies in
+the font metrics provided by the Android platform. In that case,
+Emacs uses the ``Monospace'' typeface configured on your system; this
+should always be Droid Sans Mono.
@cindex TrueType GX fonts, android
@cindex distortable fonts, android
@@ -731,7 +741,7 @@ always be Droid Sans Mono.
As on X systems, Emacs supports distortable fonts under Android.
These fonts (also termed ``TrueType GX fonts'', ``variable fonts'',
and ``multiple master fonts'') provide multiple different styles
-(``Bold'', ``Italic'', etc) using a single font file.
+(``Bold'', ``Italic'', and the like) using a single font file.
When a user-installed distortable font is found, each style that a
previously discovered font provided will no longer be used. In
@@ -743,6 +753,22 @@ conventional font with the same style and family will be
removed;
distortable fonts with the same family will no longer be used to
provide that style.
+@cindex default font families, Android
+@vindex sfnt-default-family-alist
+
+ Emacs generally assumes the presence of font families named
+@samp{Monospace}, @samp{Monospace Serif}, @samp{Sans Serif}, and
+@samp{DejaVu Serif}. Since Android does not provide any fonts by
+these names, Emacs modifies requests for them to request one of a
+corresponding set of font families distributed with Android.
+
+ To change either the set of font families subject to replacement, or
+that by which they are replaced, modify the variable
+@code{sfnt-default-family-alist}; then, restart Emacs. Bear in mind
+that this is usually unwarranted, with customizations to the default
+or @code{variable-pitch} faces better made through modifying their
+definitions (@pxref{Face Customization}).
+
@node Android Troubleshooting
@section Troubleshooting Startup Problems on Android
@cindex troubleshooting, android
@@ -752,8 +778,8 @@ provide that style.
Since Android has no command line, there is normally no way to
specify command-line arguments when starting Emacs. This is very
nasty when you make a mistake in your Emacs initialization files that
-prevents Emacs from starting up at all, as the system normally
-prevents other programs from accessing Emacs's home directory.
+prevents Emacs from starting up at all, as the system generally
+prohibits other programs from accessing Emacs's home directory.
@xref{Initial Options}.
However, Emacs can be started with the equivalent of either the
@@ -796,11 +822,12 @@ your initialization or dump files from there instead.
@cindex installing extra software on Android
@cindex installing Unix software on Android
- Android includes an extremely limited set of Unix-like command line
-tools in a default installation. Several projects exist to argument
-this selection, providing options that range from improved
-reproductions of Unix command-line utilities to package repositories
-containing extensive collections of free GNU and Unix software.
+ An exceptionally limited set of Unix-like command line tools is
+distributed alongside default installations of Android. Several
+projects exist to augment this selection, providing options that range
+from improved reproductions of Unix command-line utilities to package
+repositories providing extensive collections of free GNU and Unix
+software.
@uref{http://busybox.net, Busybox} provides Unix utilities and
limited replicas of certain popular GNU programs such as
@@ -812,17 +839,17 @@ on the Debian project's @command{dpkg} system and a set
of package
repositories containing substantial amounts of free software for Unix
systems, including compilers, debuggers, and runtimes for languages
such as C, C++, Java, Python and Common Lisp. These packages are
-normally installed from within a purpose-built terminal emulator
-application, but Emacs can access them if it is built with the same
-application signing key as the Termux terminal emulator, and with its
-``shared user ID'' set to the package name of the terminal emulator
-program. The file @file{java/INSTALL} within the Emacs distribution
-explains how to build Emacs in this fashion.
+customarily installed from within a purpose-built terminal emulator
+application, but access is also granted to Emacs when it is built with
+the same application signing key, and its ``shared user ID'' is set to
+the same package name, as that of the terminal emulator program. The
+file @file{java/INSTALL} within the Emacs distribution illustrates how
+to build Emacs in this fashion.
@uref{https://github.com/termux/termux-packages, termux-packages}
-provides the package definitions that are used by Termux to generate
-their package repositories, which may also be independently compiled
-for installation within Emacs's home directory.
+provides the package definitions used by Termux to generate their
+package repositories, which may also be independently compiled for
+installation within Emacs's home directory.
In addition to the projects mentioned above, statically linked
binaries for most Linux kernel-based systems can also be run on
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index d6610099460..2a98bffdc2d 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -698,6 +698,20 @@ which edited source line corresponds to the line reported
by the
debugger subprocess. To update this information, you typically have
to recompile and restart the program.
+@cindex GUD and hl-line-mode
+@cindex highlighting execution lines in GUD
+@vindex gud-highlight-current-line
+ Moreover, GUD is capable of visually demarcating the current
+execution line within the window text itself in one of two fashions:
+the first takes effect when the user option
+@code{gud-highlight-current-line} is enabled, and displays that line
+in an overlay whose appearance is provided by the face
+@code{gud-highlight-current-line-face}. The other takes effect when
+HL Line Mode (@pxref{Cursor Display}) is enabled, and moves the
+overlay introduced by HL Line Mode briefly to the execution line,
+until a subsequent editing command repositions it back beneath the
+cursor.
+
@cindex GUD Tooltip mode
@cindex mode, GUD Tooltip
@findex gud-tooltip-mode
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index 23dcc44a928..8c30f26bbf7 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -2924,6 +2924,7 @@ Type @kbd{C-q}, followed by the key you want to bind, to
insert @var{char}.
@node Early Init File
@subsection The Early Init File
@cindex early init file
+@cindex @file{early-init.el} file
Most customizations for Emacs should be put in the normal init file.
@xref{Init File}. However, it is sometimes necessary
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index fa8ca4cbf17..cc178dbe99f 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -740,7 +740,7 @@ frame:
This is the base face used for the mode lines, as well as header lines
and for menu bars when toolkit menus are not used. By default, it's
drawn with shadows for a raised effect on graphical displays, and
-drawn as the inverse of the default face on non-windowed terminals.
+drawn as the inverse of the default face on text terminals.
The @code{mode-line-active} and @code{mode-line-inactive} faces (which
are the ones used on the mode lines) inherit from this face.
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 7a21eb49e24..f9096557c24 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -20,8 +20,7 @@ This is the @cite{GNU Emacs Manual},
@end ifclear
updated for Emacs version @value{EMACSVER}.
-Copyright @copyright{} 1985--1987, 1993--2023 Free Software Foundation,
-Inc.
+Copyright @copyright{} 1985--2023 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -553,7 +552,7 @@ Frames and Graphical Displays
* Dialog Boxes:: Controlling use of dialog boxes.
* Tooltips:: Displaying information at the current mouse position.
* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
-* Non-Window Terminals:: Multiple frames on terminals that show only one.
+* Text Terminals:: Multiple frames on terminals that show only one.
* Text-Only Mouse:: Using the mouse in text terminals.
International Character Set Support
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index 2a9567a7bcd..e2e30408a65 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1,6 +1,5 @@
@c This is part of the Emacs manual.
-@c Copyright (C) 1985--1987, 1993--1995, 1997, 1999--2023 Free Software
-@c Foundation, Inc.
+@c Copyright (C) 1985--2023 Free Software Foundation, Inc.
@c See file emacs.texi for copying conditions.
@node Frames
@chapter Frames and Graphical Displays
@@ -30,9 +29,9 @@ displays (@pxref{Exiting}). To close just the selected
frame, type
frames. On text terminals, many of these features are unavailable.
However, it is still possible to create multiple frames on text
terminals; such frames are displayed one at a time, filling the entire
-terminal screen (@pxref{Non-Window Terminals}). It is also possible
-to use the mouse on some text terminals (@pxref{Text-Only Mouse}, for
-doing so on GNU and Unix systems; and
+terminal screen (@pxref{Text Terminals}). It is also possible to use
+the mouse on some text terminals (@pxref{Text-Only Mouse}, for doing
+so on GNU and Unix systems; and
@iftex
@pxref{MS-DOS Mouse,,,emacs-xtra,Specialized Emacs Features},
@end iftex
@@ -62,7 +61,7 @@ for doing so on MS-DOS). Menus are supported on all text
terminals.
* Dialog Boxes:: Controlling use of dialog boxes.
* Tooltips:: Displaying information at the current mouse position.
* Mouse Avoidance:: Preventing the mouse pointer from obscuring text.
-* Non-Window Terminals:: Multiple frames on terminals that show only one.
+* Text Terminals:: Multiple frames on terminals that show only one.
* Text-Only Mouse:: Using the mouse in text terminals.
@end menu
@@ -593,7 +592,7 @@ the ordinary, interactive frames are deleted. In this
case, @kbd{C-x
The @kbd{C-x 5 1} (@code{delete-other-frames}) command deletes all
other frames on the current terminal (this terminal refers to either a
-graphical display, or a text terminal; @pxref{Non-Window Terminals}).
+graphical display, or a text terminal; @pxref{Text Terminals}).
If the Emacs session has frames open on other graphical displays or
text terminals, those are not deleted.
@@ -1765,8 +1764,8 @@ You can also use the command @kbd{M-x
mouse-avoidance-mode} to enable
the mode. Whenever Mouse Avoidance mode moves the mouse, it also
raises the frame.
-@node Non-Window Terminals
-@section Non-Window Terminals
+@node Text Terminals
+@section Text Terminals
@cindex text terminal
On a text terminal, Emacs can display only one Emacs frame at a
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index 18811291a9e..c1927a01eb4 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -149,7 +149,10 @@ the corresponding left-hand key.
@vindex ns-use-proxy-icon
@item ns-use-proxy-icon
This variable specifies whether to display the proxy icon in the
-titlebar.
+titlebar. The proxy icon can be used to drag the file associated with
+the current buffer to other applications, a printer, the desktop,
+etc., in the same way you can from Finder. You might have to disable
+@code{tool-bar-mode} to see the proxy icon.
@vindex ns-confirm-quit
@item ns-confirm-quit
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 5f9a5d89bf3..0725d889747 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -482,22 +482,23 @@ system, but is usually not excessive.
@cindex filesets, VC
@cindex VC filesets
Most VC commands operate on @dfn{VC filesets}. A VC fileset is a
-collection of one or more files that a VC operation acts on. When you
-type VC commands in a buffer visiting a version-controlled file, the
-VC fileset is simply that one file. When you type them in a VC
+collection of one or more files that a VC operation acts upon. When
+you type VC commands in a buffer visiting a version-controlled file,
+the VC fileset is simply that one file. When you type them in a VC
Directory buffer, and some files in it are marked, the VC fileset
consists of the marked files (@pxref{VC Directory Mode}). Likewise,
when you invoke a VC command from a Dired buffer, the VC fileset
consists of the marked files (@pxref{Marks vs Flags}), defaulting to
the file shown on the current line if no files are marked.
- On modern changeset-based version control systems (@pxref{VCS
-Changesets}), VC commands handle multi-file VC filesets as a group.
-For example, committing a multi-file VC fileset generates a single
-revision, containing the changes to all those files. On older
-file-based version control systems like CVS, each file in a multi-file
-VC fileset is handled individually; for example, a commit generates
-one revision for each changed file.
+ With modern changeset-based version control systems (@pxref{VCS
+Changesets}), such as Git, Mercurial, and Bazaar, VC commands handle
+multi-file VC filesets as a group. For example, committing a
+multi-file VC fileset generates a single revision, containing the
+changes to all those files. On older file-based version control
+systems like CVS, each file in a multi-file VC fileset is handled
+individually; thus, committing a fileset generates one revision for
+each changed file in the fileset.
@table @kbd
@item C-x v v
@@ -508,14 +509,16 @@ VC fileset.
@findex vc-next-action
@kindex C-x v v
The principal VC command is a multi-purpose command, @kbd{C-x v v}
-(@code{vc-next-action}), which performs the most appropriate
-action on the current VC fileset: either registering it with a version
-control system, or committing it, or unlocking it, or merging changes
-into it. The precise actions are described in detail in the following
-subsections. You can use @kbd{C-x v v} either in a file-visiting
-buffer, in a Dired buffer, or in a VC Directory buffer; in the latter
-two cases the command operates on the fileset consisting of the marked
-files.
+(@code{vc-next-action}), which performs the most appropriate action on
+the current VC fileset: either registering it with a version control
+system, or committing it, or unlocking it, or merging changes into it.
+The precise actions for each situation are described in detail in the
+following subsections. You can use @kbd{C-x v v} either in a
+file-visiting buffer, in a Dired buffer, or in a VC Directory buffer;
+in the latter two cases the command operates on the fileset consisting
+of the marked files. You can also use @kbd{C-x v v}, in a buffer with
+patches under Diff Mode (@pxref{Diff Mode}), in which case the command
+operates on the files whose diffs are shown in the buffer.
Note that VC filesets are distinct from the named filesets used
for viewing and visiting files in functional groups
@@ -523,7 +526,7 @@ for viewing and visiting files in functional groups
and don't persist across sessions.
@menu
-* VC With A Merging VCS:: Without locking: default mode for CVS.
+* VC With A Merging VCS:: Without locking: default mode for Git, Hg, SVN, CVS.
* VC With A Locking VCS:: RCS in its default mode, SCCS, and optionally CVS.
* Advanced C-x v v:: Advanced features available with a prefix argument.
@end menu
@@ -531,44 +534,56 @@ and don't persist across sessions.
@node VC With A Merging VCS
@subsubsection Basic Version Control with Merging
- On a merging-based version control system (i.e., most modern ones;
-@pxref{VCS Merging}), @kbd{C-x v v} does the following:
+ With a modern merging-based version control system (such as Git and Hg;
+@pxref{VCS Merging}), @kbd{C-x v v} does the following when invoked
+from a buffer that visits a version-controlled file or a VC Directory
+or Dired buffer:
@itemize @bullet
@item
If there is more than one file in the VC fileset and the files have
inconsistent version control statuses, signal an error. (Note,
-however, that a fileset is allowed to include both newly-added
-files and modified files; @pxref{Registering}.)
+however, that a fileset is allowed to include both newly-added files
+and modified files; @pxref{Registering}.) Also signal an error if the
+files in the fileset are missing (removed from the filesystem, but
+still tracked by version control), or are ignored by version control.
@item
-If none of the files in the VC fileset are registered with a version
-control system, register the VC fileset, i.e., place it under version
-control. @xref{Registering}. If Emacs cannot find a system to
-register under, it prompts for a repository type, creates a new
-repository, and registers the VC fileset with it.
-
-@item
-If every work file in the VC fileset is unchanged, do nothing.
-
-@item
-If every work file in the VC fileset has been modified, commit the
-changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the
-desired log entry for the new revision, followed by @kbd{C-c C-c} to
-commit. @xref{Log Buffer}.
-
-If committing to a shared repository, the commit may fail if the
-repository has been changed since your last update. In that
-case, you must perform an update before trying again. On a
-decentralized version control system, use @kbd{C-x v +}
-(@pxref{Pulling / Pushing}) or @kbd{C-x v m} (@pxref{Merging}).
-On a centralized version control system, type @kbd{C-x v v} again to
-merge in the repository changes.
+If every file in the VC fileset is registered and unchanged with
+respect to the last revision, do nothing.
@item
-Finally, if you are using a centralized version control system, check
-if each work file in the VC fileset is up-to-date. If any file has
-been changed in the repository, offer to update it.
+If none of the files in the VC fileset are registered with a version
+control system, register the newly-added files in the VC fileset,
+i.e., place them under version control. @xref{Registering}. If Emacs
+cannot find a system to register under, it prompts for a repository
+type, creates a new repository, and registers the VC fileset with it.
+You can also specify the system explicitly, see @ref{Advanced C-x v
+v}. Note that registering the files doesn't commit them; you must
+invoke @w{@kbd{C-x v v}} again to commit, see below.
+
+@item
+If every file in the VC fileset has been either newly-added or
+modified, commit the changed files. To do this, Emacs pops up a
+@file{*vc-log*} buffer; type the desired log entry for the changes,
+followed by @kbd{C-c C-c} to commit. @xref{Log Buffer}.
+
+With modern decentralized version control systems (Git, Mercurial,
+etc.), the changes are committed locally and not automatically
+propagated to the upstream repository (which is usually on a remote
+host). In these cases, if the repository has been changed since your
+last update, the commit may fail. In that case, you must update from
+upstream and then try again. Use @kbd{C-x v +} (@pxref{Pulling /
+Pushing}) or @kbd{C-x v m} (@pxref{Merging}) for that.
+
+With a centralized version control system, if the commit fails due to
+upstream changes, type @kbd{C-x v v} again to merge in the upstream
+repository changes.
+
+@item
+Finally, if you are using a centralized version control system, if any
+file in the VC fileset is outdated with respect to the upstream
+repository, offer to update the fileset from the repository.
@end itemize
These rules also apply when you use RCS in its non-locking mode,
@@ -582,43 +597,60 @@ changes. In addition, locking is possible with RCS even
in this mode:
@kbd{C-x v v} with an unmodified file locks the file, just as it does
with RCS in its normal locking mode (@pxref{VC With A Locking VCS}).
+ If @kbd{C-x v v} is invoked from a buffer under Diff Mode, the
+command assumes the buffer holds a set of patches for one or more
+files. It then applies the changes to the respective files and
+commits the changes after popping up the @file{*vc-log*} buffer to
+allow you to type a suitable commit log message.
+
@node VC With A Locking VCS
@subsubsection Basic Version Control with Locking
- On a locking-based version control system (such as SCCS, and RCS in
+ With a locking-based version control system (such as SCCS, and RCS in
its default mode), @kbd{C-x v v} does the following:
@itemize @bullet
@item
If there is more than one file in the VC fileset and the files have
-inconsistent version control statuses, signal an error.
+inconsistent version control statuses, signal an error. Also signal
+an error if the files in the fileset are missing (removed from the
+filesystem, but still tracked by version control).
@item
If each file in the VC fileset is not registered with a version
-control system, register the VC fileset. @xref{Registering}. If
-Emacs cannot find a system to register under, it prompts for a
-repository type, creates a new repository, and registers the VC
-fileset with it.
+control system, register the newly-added files in the fileset.
+@xref{Registering}. If Emacs cannot find a system to register under,
+it prompts for a repository type, creates a new repository, and
+registers the VC fileset with it. You can also specify the system
+explicitly, see @ref{Advanced C-x v v}.
@item
-If each file is registered and unlocked, lock it and make it writable,
-so that you can begin to edit it.
+If each file is registered and unlocked, check the files out: lock
+each one and make it writable, so that you can begin to edit it.
@item
-If each file is locked by you and contains changes, commit the
-changes. To do this, Emacs pops up a @file{*vc-log*} buffer; type the
-desired log entry for the new revision, followed by @kbd{C-c C-c} to
-commit (@pxref{Log Buffer}).
+If each file is locked by you and contains changes, commit (a.k.a.@:
+``check-in'') the changes. To do this, Emacs pops up a
+@file{*vc-log*} buffer; type the desired log entry for the new
+revision, followed by @kbd{C-c C-c} to commit (@pxref{Log Buffer}).
@item
If each file is locked by you, but you have not changed it, release
-the lock and make the file read-only again.
+the lock and make the file read-only again. This undoes previous
+check-out operation for files that were not changed since the
+checkout.
@item
If each file is locked by another user, ask whether you want to
steal the lock. If you say yes, the file becomes locked by you,
and a warning message is sent to the user who had formerly locked the
file.
+
+@item
+If files in the fileset are unlocked, but have changes with respect to
+their last revision, offer to claim the lock for each such file or to
+revert the file to the last checked-in revision. (This situation is
+exceptional and should not normally happen.)
@end itemize
These rules also apply when you use CVS in locking mode, except
@@ -643,19 +675,21 @@ and Emacs fails to detect the correct one.
@item
Otherwise, if using CVS, RCS or SRC, you can specify a revision ID.
-If the fileset is modified (or locked), this makes Emacs commit with
-that revision ID@. You can create a new branch by supplying an
-appropriate revision ID (@pxref{Branches}).
-
-If the fileset is unmodified (and unlocked), this checks the specified
-revision into the working tree. You can also specify a revision on
-another branch by giving its revision or branch ID (@pxref{Switching
-Branches}). An empty argument (i.e., @kbd{C-u C-x v v @key{RET}})
-checks out the latest (head) revision on the current branch.
-
-This is silently ignored on a decentralized version control system.
-Those systems do not let you specify your own revision IDs, nor do
-they use the concept of checking out individual files.
+If the fileset is modified (or locked), this makes Emacs commit the
+files with that revision ID@. You can create a new branch by
+supplying an appropriate revision ID (@pxref{Branches}).
+
+If the fileset is unmodified (and unlocked), this checks out the
+specified revision into the working tree. You can also specify a
+revision on another branch by giving its revision or branch ID
+(@pxref{Switching Branches}). An empty argument (i.e., @kbd{C-u C-x v
+v @key{RET}}) checks out the latest (a.k.a.@: ``head'') revision on
+the current branch.
+
+Specifying revision ID in this manner is silently ignored by a
+decentralized version control system. Those systems do not let you
+specify your own revision IDs, nor do they use the concept of checking
+out individual files.
@end itemize
@node Log Buffer
@@ -789,17 +823,21 @@ If Emacs cannot find a version control system to register
the file
under, it prompts for a repository type, creates a new repository, and
registers the file into that repository.
- On most version control systems, registering a file with @kbd{C-x v
-i} or @kbd{C-x v v} adds it to the working tree but not to the
-repository. Such files are labeled as @samp{added} in the VC
-Directory buffer, and show a revision ID of @samp{@@@@} in the mode
-line. To make the registration take effect in the repository, you
-must perform a commit (@pxref{Basic VC Editing}). Note that a single
-commit can include both file additions and edits to existing files.
-
- On a locking-based version control system (@pxref{VCS Merging}),
+@cindex added files, VC
+@cindex files added to VCS
+ With most version control systems, registering a file with
+@w{@kbd{C-x v i}} or @w{@kbd{C-x v v}} adds it to the working tree,
+but does not commit it, i.e., doesn't add it to the repository. Such
+files are labeled as @dfn{added} in the VC Directory buffer, and the
+mode line of the buffers visiting such files shows a revision ID of
+@samp{@@@@}. To make the registration take effect in the repository,
+you must commit the newly-added files (@pxref{Basic VC Editing}).
+Note that a single commit can include both file additions and edits to
+files already known to the VCS.
+
+ With a locking-based version control system (@pxref{VCS Merging}),
registering a file leaves it unlocked and read-only. Type @kbd{C-x v
-v} to start editing it.
+v} to check-out the file and start editing it.
@node Old Revisions
@subsection Examining And Comparing Old Revisions
@@ -1564,32 +1602,39 @@ commit will be committed to that specific branch.
@subsubsection Pulling/Pushing Changes into/from a Branch
@table @kbd
+@cindex push changes to upstream (VC)
@item C-x v P
-On a decentralized version control system, update another location
-with changes from the current branch (a.k.a. ``push'' changes). This
-concept does not exist for centralized version control systems
+With a decentralized version control system, update another repository
+with locally-committed changes from the current branch (a.k.a.@:
+@dfn{push} changes). This concept does not exist for centralized
+version control systems
+@cindex pull changes from upstream (VC)
@item C-x v +
-On a decentralized version control system, update the current branch
-by ``pulling in'' changes from another location.
+With a decentralized version control system, update the current branch
+of the local repository by @dfn{pulling in} changes from another
+repository.
-On a centralized version control system, update the current VC
-fileset.
+With a centralized version control system, update the current VC
+fileset from the repository.
@end table
@kindex C-x v P
@findex vc-push
+@cindex upstream repository
On a decentralized version control system, the command @kbd{C-x v P}
-(@code{vc-push}) updates another location with changes from the
+(@code{vc-push}) updates another location, commonly known as the
+@dfn{upstream repository}, with locally-committed changes from the
current branch. With a prefix argument, it prompts for the exact
version control command to run, which lets you specify where to push
-changes; the default is @kbd{bzr push} with Bazaar, @kbd{git
-push} with Git, and @kbd{hg push} with Mercurial. The default
-commands always push to a default location determined by the version
-control system from your branch configuration.
+changes; the default is @kbd{bzr push} with Bazaar, @kbd{git push}
+with Git, and @kbd{hg push} with Mercurial. The default commands
+always push to the repository in the default location determined by
+the version control system from your branch configuration.
Prior to pushing, you can use @kbd{C-x v O} (@code{vc-log-outgoing})
-to view a log buffer of the changes to be sent. @xref{VC Change Log}.
+to view a log buffer of the changes to be sent upstream. @xref{VC
+Change Log}.
@cindex bound branch (Bazaar VCS)
This command is currently supported only by Bazaar, Git, and Mercurial.
@@ -1603,13 +1648,15 @@ bound.
@kindex C-x v +
@findex vc-pull
- On a decentralized version control system, the command @kbd{C-x v +}
-(@code{vc-pull}) updates the current branch and working tree. It is
-typically used to update a copy of a remote branch. If you supply a
-prefix argument, the command prompts for the exact version control
-command to use, which lets you specify where to pull changes from.
-Otherwise, it pulls from a default location determined by the version
-control system.
+ With a decentralized version control system, the command @kbd{C-x v
++} (@code{vc-pull}) updates the current branch of the local repository
+and it working tree with changes made in the upstream repository. It
+is typically used to update a copy (a.k.a.@: @dfn{clone}) of a remote
+branch. If you supply a prefix argument, the command prompts for the
+exact version control command to use, which lets you specify where to
+pull changes from. Otherwise, it pulls from the repository in the
+default location determined by the version control system from your
+branch configuration.
Amongst decentralized version control systems, @kbd{C-x v +} is
currently supported only by Bazaar, Git, and Mercurial. With Bazaar,
@@ -1625,7 +1672,7 @@ the working directory.
to view a log buffer of the changes to be applied. @xref{VC Change
Log}.
- On a centralized version control system like CVS, @kbd{C-x v +}
+ With a centralized version control system like CVS, @kbd{C-x v +}
updates the current VC fileset from the repository.
@node Merging
@@ -1634,36 +1681,36 @@ updates the current VC fileset from the repository.
@table @kbd
@item C-x v m
-On a decentralized version control system, merge changes from another
+With a decentralized version control system, merge changes from another
branch into the current one.
-On a centralized version control system, merge changes from another
+With a centralized version control system, merge changes from another
branch into the current VC fileset.
@end table
While developing a branch, you may sometimes need to @dfn{merge} in
changes that have already been made in another branch. This is not a
-trivial operation, as overlapping changes may have been made to the
-two branches.
-
- On a decentralized version control system, merging is done with the
-command @kbd{C-x v m} (@code{vc-merge}). On Bazaar, this prompts for
-the exact arguments to pass to @kbd{bzr merge}, offering a
-sensible default if possible. On Git, this prompts for the name of a
-branch to merge from, with completion (based on the branch names known
-to the current repository). With Mercurial, this prompts for argument
-to pass to @kbd{hg merge}. The output from running the merge
-command is shown in a separate buffer.
-
- On a centralized version control system like CVS, @kbd{C-x v m}
+trivial operation, as overlapping and conflicting changes may have
+been made to the two branches.
+
+ With a decentralized version control system, you merge changes with
+the command @kbd{C-x v m} (@code{vc-merge}). With Bazaar, this
+prompts for the exact arguments to pass to the @command{bzr merge}
+command, offering a sensible default if possible. With Git, this
+prompts for the name of a branch to merge from, with completion (based
+on the branch names known to the current repository). With Mercurial,
+this prompts for argument to pass to @command{hg merge}. The output
+from running the merge command is shown in a separate buffer.
+
+ With a centralized version control system like CVS, @kbd{C-x v m}
prompts for a branch ID, or a pair of revision IDs (@pxref{Switching
Branches}); then it finds the changes from that branch, or the changes
between the two revisions you specified, and merges those changes into
-the current VC fileset. If you just type @kbd{@key{RET}}, Emacs simply
-merges any changes that were made on the same branch since you checked
-the file out.
+the current VC fileset. If you just type @kbd{@key{RET}} at the
+prompt, Emacs simply merges any changes that were made on the same
+branch since you checked the file out.
-@cindex conflicts
+@cindex conflicts, VC
@cindex resolving conflicts
Immediately after performing a merge, only the working tree is
modified, and you can review the changes produced by the merge with
@@ -1672,9 +1719,12 @@ two branches contained overlapping changes, merging
produces a
@dfn{conflict}; a warning appears in the output of the merge command,
and @dfn{conflict markers} are inserted into each affected work file,
surrounding the two sets of conflicting changes. You must then
-resolve the conflict by editing the conflicted files. Once you are
-done, the modified files must be committed in the usual way for the
-merge to take effect (@pxref{Basic VC Editing}).
+resolve the conflict by editing the conflicted files; by default,
+Emacs will place buffers with VC conflicts in the special Smerge mode,
+which provides special commands for resolving the merge conflicts.
+Once you are done with resolving the conflicts and have saved the
+files with resolved conflicts, those files must be committed in the
+usual way for the merge to take effect (@pxref{Basic VC Editing}).
@node Creating Branches
@subsubsection Creating New Branches
@@ -1743,6 +1793,14 @@ project. Also, the VC-aware Project back-end considers
``untracked''
files by default. That behavior is controllable with the variable
@code{project-vc-include-untracked}.
+@cindex current project name on mode line
+@defopt project-mode-line
+If this user option is non-@code{nil}, Emacs displays the name of the
+current project (if any) on the mode line; clicking @kbd{mouse-1} on
+the project name pops up the menu with the project-related commands.
+The default value is @code{nil}.
+@end defopt
+
@menu
* Project File Commands:: Commands for handling project files.
* Project Buffer Commands:: Commands for handling project buffers.
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 7a88b7ef5e0..a05b7f6c6ea 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2146,7 +2146,7 @@ overrides the environment variable.)
Create a new client frame on the current text terminal, instead of
using an existing Emacs frame. This behaves just like the @samp{-c}
option, described above, except that it creates a text terminal frame
-(@pxref{Non-Window Terminals}).
+(@pxref{Text Terminals}).
On MS-Windows, @samp{-t} behaves just like @samp{-c} if the Emacs
server is using the graphical display, but if the Emacs server is
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index a69879c30a9..fdf5ec1d7fe 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -1854,20 +1854,19 @@ represented in Lisp as lists. The lists record both
the starting mouse
position and the final position, like this:
@example
-(@var{event-type}
- (@var{window1} START-POSITION)
- (@var{window2} END-POSITION))
+(@var{event-type} @var{start-position} @var{end-position})
@end example
For a drag event, the name of the symbol @var{event-type} contains the
prefix @samp{drag-}. For example, dragging the mouse with button 2
held down generates a @code{drag-mouse-2} event. The second and third
-elements of the event give the starting and ending position of the
-drag, as mouse position lists (@pxref{Click Events}). You can access
-the second element of any mouse event in the same way. However, the
-drag event may end outside the boundaries of the frame that was
-initially selected. In that case, the third element's position list
-contains that frame in place of a window.
+elements of the event, @var{start-position} and @var{end-position} in
+the foregoing illustration, are set to the start and end positions of
+the drag as mouse position lists (@pxref{Click Events}). You can
+access the second element of any mouse event in the same way.
+However, the drag event may end outside the boundaries of the frame
+that was initially selected. In that case, the third element's
+position list contains that frame in place of a window.
The @samp{drag-} prefix follows the modifier key prefixes such as
@samp{C-} and @samp{M-}.
@@ -3968,10 +3967,6 @@ the timeout elapses).
In batch mode (@pxref{Batch Mode}), @code{sit-for} cannot be
interrupted, even by input from the standard input descriptor. It is
thus equivalent to @code{sleep-for}, which is described below.
-
-It is also possible to call @code{sit-for} with three arguments,
-as @code{(sit-for @var{seconds} @var{millisec} @var{nodisp})},
-but that is considered obsolete.
@end defun
@defun sleep-for seconds &optional millisec
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 5d6e1809286..75bc4de4f61 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -2219,8 +2219,10 @@ resource must also be set to the string
@code{"extended"}.
@item inhibit-double-buffering
If non-@code{nil}, the frame is drawn to the screen without double
buffering. Emacs normally attempts to use double buffering, where
-available, to reduce flicker. Set this property if you experience
-display bugs or pine for that retro, flicker-y feeling.
+available, to reduce flicker; nevertheless, this parameter is provided
+for circumstances where double-buffering induces display corruption,
+and for those eccentrics wistful for the immemorial flicker that once
+beset Emacs.
@vindex skip-taskbar@r{, a frame parameter}
@item skip-taskbar
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 236b823e7e6..ba0d919549b 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -2364,8 +2364,8 @@ accepted three arguments, like this
(sit-for seconds milliseconds nodisp)
@end example
-However, calling @code{sit-for} this way is considered obsolete
-(@pxref{Waiting}). The old calling convention is deprecated like
+During a transition period, the function accepted those three
+arguments, but declared this old calling convention as deprecated like
this:
@example
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 5400d492f0a..f92709f1f9b 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -3355,7 +3355,8 @@ reliably report file attribute changes when watching a
directory.
The @code{stopped} event means that watching the file has been
discontinued. This could be because @code{file-notify-rm-watch} was
called (see below), or because the file being watched was deleted, or
-due to another error reported from the underlying library which makes
+because the filesystem of the file being watched was unmounted, or due
+to another error reported from the underlying library which makes
further watching impossible.
@var{file} and @var{file1} are the name of the file(s) whose event is
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index df5e2139237..3e7872208a2 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1660,8 +1660,10 @@ from previous output.
@defun set-process-buffer process buffer
This function sets the buffer associated with @var{process} to
@var{buffer}. If @var{buffer} is @code{nil}, the process becomes
-associated with no buffer; if non-@code{nil}, the process mark will be
-set to point to the end of @var{buffer}.
+associated with no buffer; if non-@code{nil} and different from the
+buffer associated with the process, the process mark will be set to
+point to the end of @var{buffer} (unless the process mark is already
+associated with @var{buffer}).
@end defun
@defun get-buffer-process buffer-or-name
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 5064f76e7b8..c651b007173 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -1196,7 +1196,7 @@ bent, contributed ideas and algorithms for a number of
Calc features
including modulo forms, primality testing, and float-to-fraction conversion.
Units were added at the eager insistence of Mass Sivilotti. Later,
-Ulrich Mueller at CERN and Przemek Klosowski at NIST provided invaluable
+Ulrich Müller at CERN and Przemek Klosowski at NIST provided invaluable
expert assistance with the units table. As far as I can remember, the
idea of using algebraic formulas and variables to represent units dates
back to an ancient article in Byte magazine about muMath, an early
@@ -28032,7 +28032,7 @@ unit name on the stack and then reduce it to base units
with @kbd{u b}.
The @kbd{u e} (@code{calc-explain-units}) command displays an English
description of the units of the expression on the stack. For example,
for the expression @samp{62 km^2 g / s^2 mol K}, the description is
-``Square-Kilometer Gram per (Second-squared Mole Degree-Kelvin).'' This
+``Square-Kilometer Gram per (Second-squared Mole Kelvin).'' This
command uses the English descriptions that appear in the righthand
column of the Units Table.
@@ -28066,8 +28066,8 @@ Canadian (@code{galC}), and British (@code{galUK})
definitions. Also,
note that @code{oz} is a standard ounce of mass, @code{ozt} is a Troy
ounce, and @code{ozfl} is a fluid ounce.
-The temperature units corresponding to degrees Kelvin and Centigrade
-(Celsius) are the same in this table, since most units commands treat
+The temperature units corresponding to Kelvin and degree Celsius
+are the same in this table, since most units commands treat
temperatures as being relative. The @code{calc-convert-temperature}
command has special rules for handling the different absolute magnitudes
of the various temperature scales.
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 5de33350f4f..e5a29cbcffb 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -55,6 +55,7 @@ modify this GNU manual.''
@menu
* Overview:: Basics, usage, organization, naming conventions.
+* Printing:: Human friendly printing with @code{cl-prin1}.
* Program Structure:: Arglists, @code{cl-eval-when}.
* Predicates:: Type predicates and equality predicates.
* Control Structure:: Assignment, conditionals, blocks, looping.
@@ -258,6 +259,160 @@ and @code{:key} is not used.
@noindent
[3] Only for one sequence argument or two list arguments.
+@node Printing
+@chapter Printing
+
+@noindent
+This chapter describes some enhancements to Emacs Lisp's
+@dfn{printing}, the action of representing Lisp objects in text form.
+The functions documented here are intended to produce output more for
+human readers than the standard printing functions such as
+@code{prin1} and @code{princ} (@pxref{Output Functions,,,elisp,GNU
+Emacs Lisp Reference Manual}).
+
+Several of these functions have a parameter @var{stream}; this
+specifies what to do with the characters printing produces. For
+example, it might be a buffer, a marker, @code{nil} (meaning use
+standard output), or @code{t} (use the echo area). @xref{Output
+Streams,,,elisp,GNU Emacs Lisp Reference Manual}, for a full
+description.
+
+@defvar cl-print-readably
+When this variable is non-@code{nil}, @code{cl-prin1} and other
+functions described here try to produce output which can later be read
+by the Lisp reader (@pxref{Input Functions,,,elisp,GNU Emacs Lisp
+Reference Manual}).
+@end defvar
+
+@defvar cl-print-compiled
+This variable controls how to print byte-compiled functions. Valid
+values are:
+@table @code
+@item nil
+The default: Just an internal hex identifier is printed.
+@item static
+The internal hex identifier together with the function's constant
+vector are printed.
+@item disassemble
+The byte code gets disassembled.
+@item raw
+The raw form of the function is printed by @code{prin1}.
+@end table
+
+Sometimes, a button is set on the output to allow you to disassemble
+the function. See @code{cl-print-compile-button}.
+@end defvar
+
+@defvar cl-print-compile-button
+When this variable is non-@code{nil} and a byte-compiled function has
+been printed to a buffer, you can click with the mouse or type
+@key{RET} on that output to disassemble the code. This doesn't apply
+when @code{cl-print-compiled} is set to @code{disassemble}.
+@end defvar
+
+@defvar cl-print-string-length
+The maximum length of a string to print before abbreviating it. A
+value of @code{nil}, the default, means no limit.
+
+When the CL printing functions abbreviate a string, they print the
+first @code{cl-print-string-length} characters of the string, followed
+by ``@enddots{}''. When the printing is to a buffer, you can click
+with the mouse or type @key{RET} on this ellipsis to expand the
+string.
+
+This variable has effect only in the @code{cl-prin*} functions, not in
+primitives such as @code{prin1}.
+@end defvar
+
+@defun cl-prin1 object &option stream
+@code{cl-print1} prints @var{object} on @var{stream} (see above)
+according to its type and the settings described above. The variables
+@code{print-length} and @code{print-level} and the other standard
+Emacs settings also affect the printing (@pxref{Output
+Variables,,,elisp,GNU Emacs Lisp Reference Manual}).
+@end defun
+
+@defun cl-prin1-to-string object
+This function is like @code{cl-prin1}, except the output characters
+are returned as a string from this function rather than being passed
+to a stream.
+@end defun
+
+@defun cl-print-to-string-with-limit print-function value limit
+This function returns a string containing a printed representation of
+@var{value}. It attempts to get the length of the returned string
+under @var{limit} characters with successively more restrictive
+settings of @code{print-level}, @code{print-length}, and
+@code{cl-print-string-length}. It uses @var{print-function} to print,
+a function which should take the arguments @var{value} and a stream
+(see above), and which should respect @code{print-length},
+@code{print-level}, and @code{cl-print-string-length}. @var{limit}
+may be @code{nil} or zero, in which case @var{print-function} will be
+called with these settings bound to @code{nil}; it can also be
+@code{t}, in which case @var{print-function} will be called with their
+current values.
+
+Use this function with @code{cl-prin1} to print an object, possibly
+abbreviating it with one or more ellipses to fit within the size
+limit.
+@end defun
+
+@defun cl-print-object object stream
+This function prints @var{object} on @var{stream} (see above). It is
+actually a @code{cl-defgeneric} (@pxref{Generic Functions,,,elisp,GNU
+Emacs Lisp Reference Manual}), which is defined for several types of
+@var{object}. Normally, you just call @code{cl-prin1} to print an
+@var{object} rather than calling this function directly.
+
+You can write @code{cl-print-object} @code{cl-defmethod}s for other
+types of @var{object}, thus extending @code{cl-prin1}. If such a
+method uses ellipses, you should also write a
+@code{cl-print-object-contents} method for the same type. For
+examples of these methods, see @file{emacs-lisp/cl-print.el} in the
+Emacs source directory.
+@end defun
+
+@defun cl-print-object-contents object start stream
+This function replaces an ellipsis in @var{stream} beginning at
+@var{start} with the text from the partially printed @var{object} it
+represents. It is also a @code{cl-defgeneric} defined for several
+types of @var{object}. @var{stream} is a buffer containing the text
+with the ellipsis. @var{start} specifies the starting position of the
+ellipsis in a manner dependent on the type; it will have been obtained
+from a text property on the ellipsis, having been put there by
+@code{cl-print-insert-ellipsis}.
+@end defun
+
+@defun cl-print-insert-ellipsis object start stream
+This function prints an ellipsis (``@dots{}'') to @var{stream} (see
+above). When @var{stream} is a buffer, the ellipsis will be given the
+@code{cl-print-ellipsis} text property. The value of the text
+property will contain state (including @var{start}) in order to print
+the elided part of @var{object} later. @var{start} should be nil if
+the whole @var{object} is being elided, otherwise it should be an
+index or other pointer into the internals of @var{object} which can be
+passed to `cl-print-object-contents' at a later time.
+@end defun
+
+@defvar cl-print-expand-ellipsis-function
+This variable holds a function which expands an ellipsis in the
+current buffer. The function takes four arguments: @var{begin} and
+@var{end}, which are the bounds of the ellipsis; @var{value}, which is
+the value of the @code{cl-print-ellipsis} text property on the
+ellipsis (typically set earlier by @code{cl-prin1}); and
+@var{line-length}, the desired maximum length of the output. Its
+return value is the buffer position after the expanded text.
+@end defvar
+
+@deffn Command cl-print-expand-ellipsis &optional button
+This command expands the ellipsis at point. Non-interactively, if
+@var{button} is non-@code{nil}, it should be either a buffer position
+or a button made by @code{cl-print-insert-ellipsis}
+(@pxref{Buttons,,,elisp,GNU Emacs Lisp Reference Manual}), which
+indicates the position of the ellipsis. The return value is the
+buffer position after the expanded text.
+@end deffn
+
@node Program Structure
@chapter Program Structure
diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi
index ce6cb8c9bd6..f3c671635eb 100644
--- a/doc/misc/ediff.texi
+++ b/doc/misc/ediff.texi
@@ -1368,13 +1368,13 @@ the variable @code{ediff-help-message}, which is local
to
@node Window and Frame Configuration
@section Window and Frame Configuration
-On a non-windowing display, Ediff sets things up in one frame, splitting
+On a non-graphical display, Ediff sets things up in one frame, splitting
it between a small control window and the windows for buffers A, B, and C@.
The split between these windows can be horizontal or
vertical, which can be changed interactively by typing @kbd{|} while the
cursor is in the control window.
-On a window display, Ediff sets up a dedicated frame for Ediff Control
+On a graphical display, Ediff sets up a dedicated frame for Ediff Control
Panel and then it chooses windows as follows: If one of the buffers
is invisible, it is displayed in the currently selected frame. If
a buffer is visible, it is displayed in the frame where it is visible.
@@ -1477,7 +1477,7 @@ The multiframe setup is done by the
@code{ediff-setup-windows-multiframe} function, which is the default on
windowing displays. The plain setup, one where all windows are always
in one frame, is done by @code{ediff-setup-windows-plain}, which is the
-default on a non-windowing display (or in an xterm window). In fact,
+default on a non-graphical display (or in an xterm window). In fact,
under Emacs, you can switch freely between these two setups by executing
the command @code{ediff-toggle-multiframe} using the Minibuffer of the
Menubar.
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 3297d8b17f0..3bfa240cacc 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -653,6 +653,41 @@ And unlike global toggles, none of these ever mutates
@code{erc-modules}.
+@anchor{Module Loading}
+@subheading Module Loading
+@cindex module loading
+
+ERC loads internal modules in alphabetical order and third-party
+modules as they appear in @code{erc-modules}. When defining your own
+module, take care to ensure ERC can find it. An easy way to do that
+is by mimicking the example in the doc string for
+@code{define-erc-module}. For historical reasons, ERC also falls back
+to @code{require}ing features. For example, if some module
+@code{<mymod>} in @code{erc-modules} lacks a corresponding
+@code{erc-<mymod>-mode} command, ERC will attempt to load the library
+@code{erc-<mymod>} prior to connecting. If this fails, ERC signals an
+error. Users wanting to define modules in an init files should
+@code{(provide 'erc-<my-mod>)} somewhere to placate ERC. Dynamically
+generating modules on the fly is not supported.
+
+Sometimes, packages attempt to autoload a module's definition instead
+of its minor-mode command, which breaks the link between the library
+and the module. This means that enabling the mode by invoking its
+command toggle isn't enough to load its defining library. Such
+packages should instead only supply autoload cookies featuring an
+explicit @code{autoload} form for their module's minor-mode command.
+As mentioned above, packages can also usually avoid autoload cookies
+entirely so long as their module's prefixed name matches that of its
+defining library and the latter's provided feature.
+
+Packages have also been seen to specify unnecessary top-level
+@code{eval-after-load} forms, which end up being ineffective in most
+cases. Another unfortunate practice is mutating @code{erc-modules}
+itself in an autoloaded form. Doing this tricks Customize into
+displaying the widget for @code{erc-modules} incorrectly, with
+built-in modules moved from the predefined checklist to the
+user-provided free-form area.
+
@c PRE5_4: Document every option of every module in its own subnode
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 8b3eb72aa66..cc94f610615 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -2568,8 +2568,6 @@ A special associate array, which can take references of
the form
@samp{$=[REGEXP]}. It indexes into the directory ring.
@end table
-@item Eshell scripts can't execute in the background
-
@item Support zsh's ``Parameter Expansion'' syntax, i.e.,
@samp{$@{@var{name}:-@var{val}@}}
@item Create a mode @code{eshell-browse}
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 7ebd82c5bed..8a50f064326 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -24841,7 +24841,7 @@ ends such as Bogofilter (@pxref{Bogofilter}) and the
Spam Statistics
package (@pxref{Spam Statistics Filtering}).
The spam and ham processors that apply to each group are determined by
-the group's@code{spam-process} group parameter. If this group
+the group's @code{spam-process} group parameter. If this group
parameter is not defined, they are determined by the variable
@code{gnus-spam-process-newsgroups}.
diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi
index 3e038520287..e0ab563ca33 100644
--- a/doc/misc/viper.texi
+++ b/doc/misc/viper.texi
@@ -8,8 +8,7 @@
@include docstyle.texi
@copying
-Copyright @copyright{} 1995--1997, 2001--2023 Free Software Foundation,
-Inc.
+Copyright @copyright{} 1995--2023 Free Software Foundation, Inc.
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -1700,7 +1699,7 @@ a text-formatting function, @code{indent-for-tab-command}
(which facilitates
programming and document writing). Instead, the tab is inserted via the
command @code{viper-insert-tab}, which is bound to @kbd{S-tab} (shift + tab).
-On some non-windowing terminals, Shift doesn't modify the @key{TAB} key, so
+On some text terminals, Shift doesn't modify the @key{TAB} key, so
@kbd{S-tab} behaves as if it were @key{TAB}. In such a case, you will have
to bind @code{viper-insert-tab} to some other convenient key.
@@ -2232,7 +2231,7 @@ For this reason, Viper doesn't change the standard Emacs
binding of
(except for users at level 1). Instead, in Viper, the key
@kbd{S-tab} (shift+ tab) is chosen to emulate Vi's @key{TAB}.
-We should note that on some non-windowing terminals, Shift doesn't modify
+We should note that on some text terminals, Shift doesn't modify
the @key{TAB} key, so @kbd{S-tab} behaves as if it were @key{TAB}. In such
a case, you will have to bind @code{viper-insert-tab} to some other
convenient key.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 05e933930e2..2e56539f210 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -149,7 +149,7 @@ minor-mode maps, and new third-party modules should do the
same.
** Option 'erc-timestamp-format-right' deprecated.
Having to account for this option prevented other ERC modules from
-easily determining what right-hand stamps would look like before
+easily determining what right-sided stamps would look like before
insertion, which is knowledge needed for certain UI decisions. The
way ERC has chosen to address this is imperfect and boils down to
asking users who've customized this option to switch to
@@ -178,14 +178,13 @@ 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'.
-** Module 'scrolltobottom' can attempt to be more aggressive.
-Enabling the experimental option 'erc-scrolltobottom-all' tells
-'scrolltobottom' to be more vigilant about staking down the input area
-and to do so in all ERC windows. The dependent option
-'erc-scrolltobottom-relaxed', also experimental, makes ERC's prompt
-stationary wherever it happens to reside instead of forcing it to the
-bottom of a window. That is, new input appears above the prompt,
-scrolling existing messages upward to compensate.
+** 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.
+And the option's 'relaxed' variant makes ERC's prompt stationary
+wherever it happens to reside instead of forcing it to the bottom of a
+window, meaning new input appears above the prompt, scrolling existing
+messages upward to compensate.
** Subtle changes in two fundamental faces.
Users of the default theme may notice that 'erc-action-face' and
@@ -221,6 +220,20 @@ atop any message. The new companion option
'erc-echo-timestamp-zone'
determines the default timezone when not specified with a prefix
argument.
+** Option 'erc-remove-parsed-property' deprecated.
+This option's nil behavior serves no practical purpose yet has the
+potential to degrade the user experience by competing for space with
+forthcoming features powered by next generation extensions. Anyone
+with a legitimate use for this option likely also possesses the
+knowledge to rig up a suitable analog with minimal effort. That said,
+the road to removal is long.
+
+** Option 'erc-warn-about-blank-lines' is more informative.
+Enabled by default, this option now produces more useful feedback
+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.
+
** 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
@@ -263,13 +276,12 @@ 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
'erc-insert-modify-hook' and 'erc-send-modify-hook'. So far, this
-includes the functions 'erc-button-add-buttons', 'erc-fill',
-'erc-match-message', and 'erc-add-timestamp', which now appear in that
-order, when present, at depths beginning at 20 and ending below 80.
-Of most interest to module authors is the new relative positioning of
-the first two, 'erc-button-add-buttons' and 'erc-fill', which have
-been swapped with respect to their previous places in recent ERC
-versions.
+includes the functions 'erc-button-add-buttons', 'erc-match-message',
+'erc-fill', and 'erc-add-timestamp', which now appear in that order,
+when present, at depths beginning at 20 and ending below 80. Of most
+interest to module authors is the new relative positioning of the
+first three, which have been rotated leftward with respect to their
+previous places in recent ERC versions (fill, button, match ,stamp).
ERC also provisionally reserves the same depth interval for
'erc-insert-pre-hook' and possibly other, similar hooks, but will
@@ -277,11 +289,13 @@ continue to modify non-ERC hooks locally whenever
possible, especially
in new code.
*** ERC now manages timestamp-related properties a bit differently.
-For starters, the 'cursor-sensor-functions' property no longer
+For starters, the 'cursor-sensor-functions' text property is absent by
+default unless the option 'erc-echo-timestamps' is already enabled on
+module init. And when present, the property's value no longer
contains unique closures and thus no longer proves effective for
-traversing messages. To compensate, a new property, 'erc-timestamp',
-now spans message bodies but not the newlines delimiting them. Also
-affecting the `stamp' module is the deprecation of the function
+traversing inserted messages. For now, ERC only provides an internal
+means of visiting messages, but a public interface is forthcoming.
+Also affecting the 'stamp' module is the deprecation of the function
'erc-insert-aligned' and its removal from client code. Additionally,
the module now merges its 'invisible' property with existing ones and
includes all white space around stamps when doing so.
@@ -296,6 +310,23 @@ 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.
+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
+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'.
+
*** The role of a module's Custom group is now more clearly defined.
Associating built-in modules with Custom groups and provided library
features has improved. More specifically, a module's group now enjoys
diff --git a/etc/NEWS b/etc/NEWS
index b3c7d3a8693..3bd47a0112b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -144,26 +144,37 @@ can use this to distinguish between buffers visiting
files with the
same base name that belong to different projects by using the provided
transform function 'project-uniquify-dirname-transform'.
-** 'insert-directory-program' is now a defcustom.
-
-** 'insert-directory-program' prefers "gls" on *BSD and macOS.
+** 'insert-directory-program' is now a user option.
On *BSD and macOS systems, this user option now defaults to the "gls"
executable, if it exists. This should remove the need to change its
value when installing GNU coreutils using something like ports or
Homebrew.
++++
** cl-print
++++
*** You can expand the "..." truncation everywhere.
The code that allowed "..." to be expanded in the "*Backtrace*" buffer
should now work anywhere the data is generated by 'cl-print'.
++++
*** The 'backtrace-ellipsis' button is replaced by 'cl-print-ellipsis'.
++++
*** hash-tables' contents can be expanded via the ellipsis.
++++
*** Modes can control the expansion via 'cl-print-expand-ellipsis-function'.
++++
+*** There is a new setting 'raw' for 'cl-print-compiled' which causes
+byte-compiled functions to be printed in full by 'prin1'. A button on
+this output can be activated to disassemble the function.
+
++++
+*** There is a new chapter in the CL manual documenting cl-print.el.
+
** Modeline elements can now be right-aligned.
Anything following the symbol 'mode-line-format-right-align' in
'mode-line-format' will be right-aligned. Exactly where it is
@@ -186,6 +197,12 @@ displayed on the mode line when 'appt-display-mode-line'
is non-nil.
* Editing Changes in Emacs 30.1
++++
+** New user option 'gud-highlight-current-line'.
+When enabled, Gud will visually emphasize the line being executed upon
+pauses in the debugee's execution, such as those occasioned by
+breakpoints being hit.
+
---
** New global minor mode 'kill-ring-deindent-mode'.
When enabled, text being saved to the kill ring will be de-indented by
@@ -267,6 +284,7 @@ functions in CJK locales.
* Changes in Specialized Modes and Packages in Emacs 30.1
** gdb-mi
+
---
*** Variable order and truncation can now be configured in 'gdb-many-windows'.
The new user option 'gdb-locals-table-row-config' allows users to
@@ -285,7 +303,7 @@ If you want to get back the old behavior, set the user
option to the value
---
*** New user option 'gdb-display-io-buffer'.
-If this is nil, "M-x gdb" will neither create nor display a separate
+If this is nil, 'M-x gdb' will neither create nor display a separate
buffer for the I/O of the program being debugged, but will instead
redirect the program's interaction to the GDB execution buffer. The
default is t, to preserve previous behavior.
@@ -299,6 +317,14 @@ equivalent to the "--heading" option of some tools such as
'git grep'
and 'rg'. The headings are displayed using the new 'grep-heading'
face.
+** Compilation mode
+
+---
+*** The 'omake' matching rule is now disabled by default.
+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'.
+
** VC
---
@@ -307,6 +333,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.
+---
+*** Obsolete command 'vc-switch-backend' re-added as 'vc-change-backend'.
+The command was previously obsoleted and unbound in Emacs 28.
+
** Diff Mode
+++
@@ -536,6 +566,11 @@ buffer must either visit a file, or it must run
'dired-mode'. Another
method but "sudo" can be configured with user option
'tramp-file-name-with-method'.
+** File Notifications
+
++++
+*** All backends except w32notify detect unmounting of a watched filesystem
now.
+
** EWW
+++
@@ -761,6 +796,13 @@ which makes them visually distinct from subroutine
prototypes.
CPerl mode supports the new keywords for exception handling and the
object oriented syntax which were added in Perl 5.36 and 5.38.
+*** New user option 'cperl-fontify-trailer'.
+This user option takes the values "perl-code" or "comment" and treats
+text after an "__END__" or "__DATA__" token accordingly. The default
+value of "perl-code" is useful for trailing POD and for AutoSplit
+modules, the value "comment" makes cperl-mode treat trailers as
+comment, like perl-mode does.
+
** Emacs Sessions (Desktop)
+++
@@ -797,7 +839,8 @@ You can now configure how a thumbnail is named using this
option.
** ERT
-*** New macro `skip-when' to skip 'ert-deftest' tests.
++++
+*** New macro 'skip-when' to skip 'ert-deftest' tests.
This can help avoid some awkward skip conditions. For example
'(skip-unless (not noninteractive))' can be changed to the easier
to read '(skip-when noninteractive)'.
@@ -819,18 +862,19 @@ neither of which have been supported by Emacs since
version 23.1.
The user option 'url-gateway-nslookup-program' and the function
'url-gateway-nslookup-host' are consequently also obsolete.
-+++
** Edmacro
++++
*** New command 'edmacro-set-macro-to-region-lines'.
Bound to 'C-c C-r', this command replaces the macro text with the
lines of the region. If needed, the region is extended to include
whole lines. If the region ends at the beginning of a line, that last
line is excluded.
++++
*** New user option 'edmacro-reverse-macro-lines'.
When this is non-nil, the lines of key sequences are displayed with
-the most recent line fist. This is can be useful when working with
+the most recent line first. This is can be useful when working with
macros with many lines, such as from 'kmacro-edit-lossage'.
@@ -849,8 +893,11 @@ A major mode based on the tree-sitter library for editing
HEEx files.
---
*** New major mode 'elixir-ts-mode'.
-A major mode based on the tree-sitter library for editing Elixir
-files.
+A major mode based on the tree-sitter library for editing Elixir files.
+
+---
+*** New major mode 'lua-ts-mode'.
+A major mode based on the tree-sitter library for editing Lua files.
+++
** New global minor mode 'minibuffer-regexp-mode'.
@@ -859,10 +906,6 @@ 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 major mode 'lua-ts-mode'.
-A major mode based on the tree-sitter library for editing Lua files.
-
---
** The highly accessible Modus themes collection has eight items.
The 'modus-operandi' and 'modus-vivendi' are the main themes that have
@@ -877,6 +920,12 @@ 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
@@ -896,7 +945,7 @@ the file listing's performance is still optimized.
* Incompatible Lisp Changes in Emacs 30.1
-** 'post-gc-hook' runs after updating 'gcs-done' and `'gcs-elapsed'.
+** 'post-gc-hook' runs after updating 'gcs-done' and 'gcs-elapsed'.
---
** The escape sequence '\x' not followed by hex digits is now an error.
@@ -973,10 +1022,13 @@ The compatibility aliases 'x-defined-colors',
'x-color-defined-p',
** 'easy-mmode-define-{minor,global}-mode' aliases are now obsolete.
Use 'define-minor-mode' and 'define-globalized-minor-mode' instead.
+** The obsolete calling convention of 'sit-for' has been removed.
+That convention was: (sit-for SECONDS MILLISEC &optional NODISP)
+
* Lisp Changes in Emacs 30.1
-** New function 're--describe-compiled' to see the innards of a regexp.
+** New function 're-disassemble' to see the innards of a regexp.
If you compiled with '--enable-checking', you can use this to help debug
either your regexp performance problems or the regexp engine.
@@ -1224,6 +1276,10 @@ name 'ignored-return-value'.
The warning will only be issued for calls to functions declared
'important-return-value' or 'side-effect-free' (but not 'error-free').
+---
+*** The warning about wide docstrings can now be disabled separately.
+Its warning name is 'docstrings-wide'.
+
+++
** New function declaration and property 'important-return-value'.
The declaration '(important-return-value t)' sets the
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py
index 120282f5335..c5a472e16cb 100644
--- a/etc/emacs_lldb.py
+++ b/etc/emacs_lldb.py
@@ -89,7 +89,7 @@ class Lisp_Object:
self.init_values()
def init_unsigned(self):
- if self.lisp_obj.GetNumChildren() != 0:
+ if self.lisp_obj.GetType().GetTypeClass() == lldb.eTypeClassStruct:
# Lisp_Object is actually a struct.
lisp_word = self.lisp_obj.GetValueForExpressionPath(".i")
self.unsigned = lisp_word.GetValueAsUnsigned()
@@ -123,19 +123,21 @@ class Lisp_Object:
if self.lisp_type == "Lisp_Symbol":
offset = self.get_lisp_pointer("char").GetValueAsUnsigned()
self.value = self.eval(f"(struct Lisp_Symbol *)"
- f" ((char *) &lispsym + {offset})")
+ f" ((char *) &lispsym + {offset})",
+ True)
elif self.lisp_type == "Lisp_String":
- self.value = self.get_lisp_pointer("struct Lisp_String")
+ self.value = self.get_lisp_pointer("struct Lisp_String", True)
elif self.lisp_type == "Lisp_Vectorlike":
c_type = Lisp_Object.pvec2type[self.pvec_type]
- self.value = self.get_lisp_pointer(c_type)
+ self.value = self.get_lisp_pointer(c_type, True)
elif self.lisp_type == "Lisp_Cons":
- self.value = self.get_lisp_pointer("struct Lisp_Cons")
+ self.value = self.get_lisp_pointer("struct Lisp_Cons", True)
elif self.lisp_type == "Lisp_Float":
- self.value = self.get_lisp_pointer("struct Lisp_Float")
+ self.value = self.get_lisp_pointer("struct Lisp_Float", True)
elif self.lisp_type in ("Lisp_Int0", "Lisp_Int1"):
self.value = self.eval(f"((EMACS_INT) {self.unsigned}) "
- f">> (GCTYPEBITS - 1)")
+ f">> (GCTYPEBITS - 1)",
+ True)
else:
msg = f"Unknown Lisp type {self.lisp_type}"
assert False, msg
@@ -145,14 +147,19 @@ class Lisp_Object:
return self.lisp_obj.CreateValueFromExpression(name, expr)
# Evaluate EXPR in the context of the current frame.
- def eval(self, expr):
- return self.frame.EvaluateExpression(expr)
+ def eval(self, expr, make_var=False):
+ if make_var:
+ return self.frame.EvaluateExpression(expr)
+ options = lldb.SBExpressionOptions()
+ options.SetSuppressPersistentResult(True)
+ return self.frame.EvaluateExpression(expr, options)
# Return an SBValue for this object denoting a pointer of type
# TYP*.
- def get_lisp_pointer(self, typ):
+ def get_lisp_pointer(self, typ, make_var=False):
return self.eval(f"({typ}*) (((EMACS_INT) "
- f"{self.unsigned}) & VALMASK)")
+ f"{self.unsigned}) & VALMASK)",
+ make_var)
# If this is a Lisp_String, return an SBValue for its string data.
# Return None otherwise.
@@ -242,6 +249,41 @@ def xprint(debugger, command, ctx, result, internal_dict):
def type_summary_Lisp_Object(obj, internal_dict):
return Lisp_Object(obj).summary()
+# Don't know at the moment how to use this outside of the LLDB gui
+# command. And it's still incomplete.
+class Lisp_Object_Provider:
+ def __init__(self, valobj, internal_dict):
+ self.valobj = valobj
+ self.lisp_obj = Lisp_Object(valobj)
+ self.child = None
+
+ def update(self):
+ if self.lisp_obj.lisp_type == "Lisp_Symbol":
+ self.child = self.lisp_obj.get_symbol_name().Clone("name")
+ self.child.SetSyntheticChildGenerated(True)
+ elif self.lisp_obj.lisp_type == "Lisp_String":
+ self.child = self.lisp_obj.get_string_data().Clone("data")
+ self.child.SetSyntheticChildGenerated(True)
+ else:
+ self.child = self.lisp_obj.value.Clone("untagged")
+ self.child.SetSyntheticChildGenerated(True)
+
+ def has_children(self):
+ return True
+
+ def num_children(self):
+ return 1
+
+ def get_child_index(self, name):
+ return 0
+
+ # This works insofar as struct frame * works, but it doesn't work
+ # Lisp_Symbol, for example.
+ def get_child_at_index(self, index):
+ if index != 0:
+ return None
+ return self.child
+
########################################################################
# Initialization
@@ -275,6 +317,17 @@ def define_type_summary(debugger, regex, function):
f"--python-function {python_function} "
+ regex)
+# Define Python class CLS as a children provider for the types
+# matching REFEXP. Providers are defined in the category Emacs, and
+# can be seen with 'type synthetic list -w Emacs', and deleted in a
+# similar way.
+def define_type_synthetic(debugger, regex, cls):
+ python_class = __name__ + "." + cls.__name__
+ debugger.HandleCommand(f"type synthetic add "
+ f"--category Emacs "
+ f"--python-class {python_class} "
+ + regex)
+
# Enable a given category of type summary providers.
def enable_type_category(debugger, category):
debugger.HandleCommand(f"type category enable {category}")
@@ -285,6 +338,7 @@ def __lldb_init_module(debugger, internal_dict):
define_command(debugger, xdebug_print)
define_command(debugger, xprint)
define_type_summary(debugger, "Lisp_Object", type_summary_Lisp_Object)
+ define_type_synthetic(debugger, "Lisp_Object", Lisp_Object_Provider)
enable_type_category(debugger, "Emacs")
print('Emacs debugging support has been installed.')
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index 62ba687c19f..240e3366b0b 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,5 +1,5 @@
% Reference Card for Org Mode
-\def\orgversionnumber{9.6.9}
+\def\orgversionnumber{9.6.10}
\def\versionyear{2023} % latest update
\input emacsver.tex
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index 9ba9dabde81..2749f43c245 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -73,8 +73,12 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
<uses-permission android:name="android.permission.POST_NOTIFICATIONS"/>
+ <!-- Under Android 14 or later to run within the background. -->
+
+ <uses-permission
android:name="android.permission.FOREGROUND_SERVICE_SPECIAL_USE"/>
+
<uses-sdk android:minSdkVersion="@ANDROID_MIN_SDK@"
- android:targetSdkVersion="33"/>
+ android:targetSdkVersion="34"/>
<application android:name="org.gnu.emacs.EmacsApplication"
android:label="Emacs"
@@ -190,6 +194,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
android:directBootAware="false"
android:enabled="true"
android:exported="false"
+ android:foregroundServiceType="specialUse"
android:label="GNU Emacs service"/>
</application>
</manifest>
diff --git a/java/INSTALL b/java/INSTALL
index fb235af1346..fb221c5e2b4 100644
--- a/java/INSTALL
+++ b/java/INSTALL
@@ -39,7 +39,7 @@ script like so:
Replacing the paths in the command line above with:
- the path to the `android.jar' headers which come with the Android
- SDK. They must correspond to Android version 13 (API level 33).
+ SDK. They must correspond to Android version 14 (API level 34).
- the path to the C compiler in the Android NDK, for the kind of CPU
you are building Emacs to run on.
@@ -87,13 +87,13 @@ necessary for compiling Emacs.
It is imperative that Emacs is compiled using the headers for the
exact API level that it is written for. This is currently API level
-33, so the correct android.jar archive is located within a directory
-whose name begins with `android-33'. Minor revisions to the headers
+34, so the correct android.jar archive is located within a directory
+whose name begins with `android-34'. Minor revisions to the headers
are inconsequential towards the Emacs compilation process; if there is
-a directory named `android-33-extN' (where N represents a revision to
+a directory named `android-34-extN' (where N represents a revision to
the Android SDK), whether you provide `configure' with that
directory's android.jar or the android.jar contained within the
-directory named `android-33' is of no special importance.
+directory named `android-34' is of no special importance.
The ndk directory contains one subdirectory for each version of the
Android NDK installed. This directory in turn contains the C and C++
@@ -299,6 +299,8 @@ work, along with what has to be patched to make them work:
the following three dependencies.)
libpackagelistparser
https://android.googlesource.com/platform/system/core/+/refs/heads/nougat-mr1-dev/libpackagelistparser/
+ (You must add LOCAL_EXPORT_C_INCLUDE_DIRS := $(LOCAL_PATH)/include before
+ its Android.mk includes $(BUILD_SHARED_LIBRARY))
libpcre - https://android.googlesource.com/platform/external/pcre
libcrypto - https://android.googlesource.com/platform/external/boringssl
(You must apply the patch at the end of this file when building for
@@ -404,14 +406,14 @@ libxml2 before it can be built for Emacs. In addition,
you must also
revert the commit `edb5870767fed8712a9b77ef34097209b61ab2db'.
diff --git a/Android.mk b/Android.mk
-index 07c7b372..24f67e49 100644
+index 07c7b372..2494274f 100644
--- a/Android.mk
+++ b/Android.mk
@@ -80,6 +80,7 @@ LOCAL_SHARED_LIBRARIES := libicuuc
LOCAL_MODULE:= libxml2
LOCAL_CLANG := true
LOCAL_ADDITIONAL_DEPENDENCIES += $(LOCAL_PATH)/Android.mk
-+LOCAL_EXPORT_C_INCLUDES += $(LOCAL_PATH)
++LOCAL_EXPORT_C_INCLUDES += $(LOCAL_PATH)/include
include $(BUILD_SHARED_LIBRARY)
# For the host
diff --git a/java/org/gnu/emacs/EmacsActivity.java
b/java/org/gnu/emacs/EmacsActivity.java
index cecd9c21d99..f9aa261e355 100644
--- a/java/org/gnu/emacs/EmacsActivity.java
+++ b/java/org/gnu/emacs/EmacsActivity.java
@@ -89,8 +89,11 @@ public class EmacsActivity extends Activity
if (window.view.isFocused ())
focusedWindow = window;
- for (EmacsWindow child : window.children)
- invalidateFocus1 (child);
+ synchronized (window.children)
+ {
+ for (EmacsWindow child : window.children)
+ invalidateFocus1 (child);
+ }
}
public static void
diff --git a/java/org/gnu/emacs/EmacsInputConnection.java
b/java/org/gnu/emacs/EmacsInputConnection.java
index c3764a7b29f..7f6331205cb 100644
--- a/java/org/gnu/emacs/EmacsInputConnection.java
+++ b/java/org/gnu/emacs/EmacsInputConnection.java
@@ -628,6 +628,21 @@ public final class EmacsInputConnection implements
InputConnection
batchEditCount = 0;
}
+ @Override
+ public boolean
+ replaceText (int start, int end, CharSequence text,
+ int newCursorPosition, TextAttribute attributes)
+ {
+ if (EmacsService.DEBUG_IC)
+ Log.d (TAG, ("replaceText: " + text + ":: " + start + ","
+ + end + "," + newCursorPosition));
+
+ EmacsNative.replaceText (windowHandle, start, end,
+ text.toString (), newCursorPosition,
+ attributes);
+ return true;
+ }
+
public void
diff --git a/java/org/gnu/emacs/EmacsNative.java
b/java/org/gnu/emacs/EmacsNative.java
index a4b45aafbc1..7d7e1e5d831 100644
--- a/java/org/gnu/emacs/EmacsNative.java
+++ b/java/org/gnu/emacs/EmacsNative.java
@@ -26,6 +26,7 @@ import android.graphics.Bitmap;
import android.view.inputmethod.ExtractedText;
import android.view.inputmethod.ExtractedTextRequest;
import android.view.inputmethod.SurroundingText;
+import android.view.inputmethod.TextAttribute;
import android.view.inputmethod.TextSnapshot;
public final class EmacsNative
@@ -174,6 +175,17 @@ public final class EmacsNative
public static native long sendExpose (short window, int x, int y,
int width, int height);
+ /* Send an ANDROID_DND_DRAG event. */
+ public static native long sendDndDrag (short window, int x, int y);
+
+ /* Send an ANDROID_DND_URI event. */
+ public static native long sendDndUri (short window, int x, int y,
+ String text);
+
+ /* Send an ANDROID_DND_TEXT event. */
+ public static native long sendDndText (short window, int x, int y,
+ String text);
+
/* Return the file name associated with the specified file
descriptor, or NULL if there is none. */
public static native byte[] getProcName (int fd);
@@ -219,6 +231,9 @@ public final class EmacsNative
int leftLength,
int rightLength);
public static native void finishComposingText (short window);
+ public static native void replaceText (short window, int start, int end,
+ String text, int newCursorPosition,
+ TextAttribute attributes);
public static native String getSelectedText (short window, int flags);
public static native String getTextAfterCursor (short window, int length,
int flags);
diff --git a/java/org/gnu/emacs/EmacsSdk7FontDriver.java
b/java/org/gnu/emacs/EmacsSdk7FontDriver.java
index 21ae159d5bd..33d6ee34fa4 100644
--- a/java/org/gnu/emacs/EmacsSdk7FontDriver.java
+++ b/java/org/gnu/emacs/EmacsSdk7FontDriver.java
@@ -99,6 +99,7 @@ public class EmacsSdk7FontDriver extends EmacsFontDriver
/* The typeface. */
public Sdk7Typeface typeface;
+ @SuppressWarnings ("deprecation")
public
Sdk7FontEntity (Sdk7Typeface typeface)
{
@@ -120,6 +121,7 @@ public class EmacsSdk7FontDriver extends EmacsFontDriver
/* The typeface. */
public Sdk7Typeface typeface;
+ @SuppressWarnings ("deprecation")
public
Sdk7FontObject (Sdk7Typeface typeface, int pixelSize)
{
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 997c6923fcc..6fa2ebb3fdb 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -223,6 +223,21 @@ public final class EmacsService extends Service
}
}
+ /* Return the display density, adjusted in accord with the user's
+ text scaling preferences. */
+
+ @SuppressWarnings ("deprecation")
+ private static float
+ getScaledDensity (DisplayMetrics metrics)
+ {
+ /* The scaled density has been made obsolete by the introduction
+ of non-linear text scaling in Android 34, where there is no
+ longer a fixed relation between point and pixel sizes, but
+ remains useful, considering that Emacs does not support
+ non-linear text scaling. */
+ return metrics.scaledDensity;
+ }
+
@Override
public void
onCreate ()
@@ -242,7 +257,7 @@ public final class EmacsService extends Service
metrics = getResources ().getDisplayMetrics ();
pixelDensityX = metrics.xdpi;
pixelDensityY = metrics.ydpi;
- tempScaledDensity = ((metrics.scaledDensity
+ tempScaledDensity = ((getScaledDensity (metrics)
/ metrics.density)
* pixelDensityX);
resolver = getContentResolver ();
@@ -490,15 +505,18 @@ public final class EmacsService extends Service
else
windowList = window.children;
- array = new short[windowList.size () + 1];
- i = 1;
+ synchronized (windowList)
+ {
+ array = new short[windowList.size () + 1];
+ i = 1;
- array[0] = (window == null
- ? 0 : (window.parent != null
- ? window.parent.handle : 0));
+ array[0] = (window == null
+ ? 0 : (window.parent != null
+ ? window.parent.handle : 0));
- for (EmacsWindow treeWindow : windowList)
- array[i++] = treeWindow.handle;
+ for (EmacsWindow treeWindow : windowList)
+ array[i++] = treeWindow.handle;
+ }
return array;
}
diff --git a/java/org/gnu/emacs/EmacsView.java
b/java/org/gnu/emacs/EmacsView.java
index d09dcc7e50d..2d53231fbf9 100644
--- a/java/org/gnu/emacs/EmacsView.java
+++ b/java/org/gnu/emacs/EmacsView.java
@@ -24,6 +24,7 @@ import android.content.Context;
import android.text.InputType;
import android.view.ContextMenu;
+import android.view.DragEvent;
import android.view.View;
import android.view.KeyEvent;
import android.view.MotionEvent;
@@ -566,6 +567,19 @@ public final class EmacsView extends ViewGroup
return window.onTouchEvent (motion);
}
+ @Override
+ public boolean
+ onDragEvent (DragEvent drag)
+ {
+ /* Inter-program drag and drop isn't supported under Android 23
+ and earlier. */
+
+ if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
+ return false;
+
+ return window.onDragEvent (drag);
+ }
+
private void
@@ -581,12 +595,12 @@ public final class EmacsView extends ViewGroup
/* The view at 0 is the surface view. */
attachViewToParent (child, 1,
- child.getLayoutParams());
+ child.getLayoutParams ());
}
}
- /* The following two functions must not be called if the view has no
- parent, or is parented to an activity. */
+ /* The following four functions must not be called if the view has
+ no parent, or is parented to an activity. */
public void
raise ()
@@ -615,6 +629,40 @@ public final class EmacsView extends ViewGroup
parent.moveChildToBack (this);
}
+ public void
+ moveAbove (EmacsView view)
+ {
+ EmacsView parent;
+ int index;
+
+ parent = (EmacsView) getParent ();
+
+ if (parent != view.getParent ())
+ throw new IllegalStateException ("Moving view above non-sibling");
+
+ index = parent.indexOfChild (this);
+ parent.detachViewFromParent (index);
+ index = parent.indexOfChild (view);
+ parent.attachViewToParent (this, index + 1, getLayoutParams ());
+ }
+
+ public void
+ moveBelow (EmacsView view)
+ {
+ EmacsView parent;
+ int index;
+
+ parent = (EmacsView) getParent ();
+
+ if (parent != view.getParent ())
+ throw new IllegalStateException ("Moving view above non-sibling");
+
+ index = parent.indexOfChild (this);
+ parent.detachViewFromParent (index);
+ index = parent.indexOfChild (view);
+ parent.attachViewToParent (this, index, getLayoutParams ());
+ }
+
@Override
protected void
onCreateContextMenu (ContextMenu menu)
diff --git a/java/org/gnu/emacs/EmacsWindow.java
b/java/org/gnu/emacs/EmacsWindow.java
index 1f28d5f4f53..3d2d86624a7 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -22,10 +22,13 @@ package org.gnu.emacs;
import java.lang.IllegalStateException;
import java.util.ArrayList;
import java.util.List;
+import java.util.ListIterator;
import java.util.HashMap;
import java.util.LinkedHashMap;
import java.util.Map;
+import android.content.ClipData;
+import android.content.ClipDescription;
import android.content.Context;
import android.graphics.Rect;
@@ -33,12 +36,15 @@ import android.graphics.Canvas;
import android.graphics.Bitmap;
import android.graphics.PixelFormat;
-import android.view.View;
-import android.view.ViewManager;
+import android.net.Uri;
+
+import android.view.DragEvent;
import android.view.Gravity;
+import android.view.InputDevice;
import android.view.KeyEvent;
import android.view.MotionEvent;
-import android.view.InputDevice;
+import android.view.View;
+import android.view.ViewManager;
import android.view.WindowManager;
import android.util.Log;
@@ -93,7 +99,9 @@ public final class EmacsWindow extends EmacsHandleObject
public EmacsWindow parent;
/* List of all children in stacking order. This must be kept
- consistent with their Z order! */
+ consistent with their Z order!
+
+ Synchronize access to this list with itself. */
public ArrayList<EmacsWindow> children;
/* Map between pointer identifiers and last known position. Used to
@@ -165,7 +173,11 @@ public final class EmacsWindow extends EmacsHandleObject
if (parent != null)
{
- parent.children.add (this);
+ synchronized (parent.children)
+ {
+ parent.children.add (this);
+ }
+
EmacsService.SERVICE.runOnUiThread (new Runnable () {
@Override
public void
@@ -214,7 +226,12 @@ public final class EmacsWindow extends EmacsHandleObject
destroyHandle () throws IllegalStateException
{
if (parent != null)
- parent.children.remove (this);
+ {
+ synchronized (parent.children)
+ {
+ parent.children.remove (this);
+ }
+ }
EmacsActivity.invalidateFocus ();
@@ -1163,10 +1180,20 @@ public final class EmacsWindow extends EmacsHandleObject
/* Reparent this window to the other window. */
if (parent != null)
- parent.children.remove (this);
+ {
+ synchronized (parent.children)
+ {
+ parent.children.remove (this);
+ }
+ }
if (otherWindow != null)
- otherWindow.children.add (this);
+ {
+ synchronized (otherWindow.children)
+ {
+ otherWindow.children.add (this);
+ }
+ }
parent = otherWindow;
@@ -1239,9 +1266,12 @@ public final class EmacsWindow extends EmacsHandleObject
if (parent == null)
return;
- /* Remove and add this view again. */
- parent.children.remove (this);
- parent.children.add (this);
+ synchronized (parent.children)
+ {
+ /* Remove and add this view again. */
+ parent.children.remove (this);
+ parent.children.add (this);
+ }
/* Request a relayout. */
EmacsService.SERVICE.runOnUiThread (new Runnable () {
@@ -1261,9 +1291,12 @@ public final class EmacsWindow extends EmacsHandleObject
if (parent == null)
return;
- /* Remove and add this view again. */
- parent.children.remove (this);
- parent.children.add (this);
+ synchronized (parent.children)
+ {
+ /* Remove and add this view again. */
+ parent.children.remove (this);
+ parent.children.add (this);
+ }
/* Request a relayout. */
EmacsService.SERVICE.runOnUiThread (new Runnable () {
@@ -1276,6 +1309,86 @@ public final class EmacsWindow extends EmacsHandleObject
});
}
+ public synchronized void
+ reconfigure (final EmacsWindow window, final int stackMode)
+ {
+ ListIterator<EmacsWindow> iterator;
+ EmacsWindow object;
+
+ /* This does nothing here. */
+ if (parent == null)
+ return;
+
+ /* If window is NULL, call lower or upper subject to
+ stackMode. */
+
+ if (window == null)
+ {
+ if (stackMode == 1) /* ANDROID_BELOW */
+ lower ();
+ else
+ raise ();
+
+ return;
+ }
+
+ /* Otherwise, if window.parent is distinct from this, return. */
+ if (window.parent != this.parent)
+ return;
+
+ /* Synchronize with the parent's child list. Iterate over each
+ item until WINDOW is encountered, before moving this window to
+ the location prescribed by STACKMODE. */
+
+ synchronized (parent.children)
+ {
+ /* Remove this window from parent.children, for it will be
+ reinserted before or after WINDOW. */
+ parent.children.remove (this);
+
+ /* Create an iterator. */
+ iterator = parent.children.listIterator ();
+
+ while (iterator.hasNext ())
+ {
+ object = iterator.next ();
+
+ if (object == window)
+ {
+ /* Now place this before or after the cursor of the
+ iterator. */
+
+ if (stackMode == 0) /* ANDROID_ABOVE */
+ iterator.add (this);
+ else
+ {
+ iterator.previous ();
+ iterator.add (this);
+ }
+
+ /* Effect the same adjustment upon the view
+ hiearchy. */
+
+ EmacsService.SERVICE.runOnUiThread (new Runnable () {
+ @Override
+ public void
+ run ()
+ {
+ if (stackMode == 0)
+ view.moveAbove (window.view);
+ else
+ view.moveBelow (window.view);
+ }
+ });
+ }
+ }
+
+ /* parent.children does not list WINDOW, which should never
+ transpire. */
+ EmacsNative.emacsAbort ();
+ }
+ }
+
public synchronized int[]
getWindowGeometry ()
{
@@ -1452,4 +1565,131 @@ public final class EmacsWindow extends EmacsHandleObject
rect.width (), rect.height ());
}
}
+
+
+
+ /* Drag and drop.
+
+ Android 7.0 and later permit multiple windows to be juxtaposed
+ on-screen, consequently enabling items selected from one window
+ to be dragged onto another. Data is transferred across program
+ boundaries using ClipData items, much the same way clipboard data
+ is transferred.
+
+ When an item is dropped, Emacs must ascertain whether the clip
+ data represents plain text, a content URI incorporating a file,
+ or some other data. This is implemented by examining the clip
+ data's ``description'', which enumerates each of the MIME data
+ types the clip data is capable of providing data in.
+
+ If the clip data represents plain text, then that text is copied
+ into a string and conveyed to Lisp code. Otherwise, Emacs must
+ solicit rights to access the URI from the system, absent which it
+ is accounted plain text and reinterpreted as such, to cue the
+ user that something has gone awry.
+
+ Moreover, events are regularly sent as the item being dragged
+ travels across the frame, even if it might not be dropped. This
+ facilitates cursor motion and scrolling in response, as provided
+ by the options dnd-indicate-insertion-point and
+ dnd-scroll-margin. */
+
+ /* Register the drag and drop event EVENT. */
+
+ public boolean
+ onDragEvent (DragEvent event)
+ {
+ ClipData data;
+ ClipDescription description;
+ int i, x, y;
+ String type;
+ Uri uri;
+ EmacsActivity activity;
+
+ x = (int) event.getX ();
+ y = (int) event.getY ();
+
+ switch (event.getAction ())
+ {
+ case DragEvent.ACTION_DRAG_STARTED:
+ /* Return true to continue the drag and drop operation. */
+ return true;
+
+ case DragEvent.ACTION_DRAG_LOCATION:
+ /* Send this drag motion event to Emacs. */
+ EmacsNative.sendDndDrag (handle, x, y);
+ return true;
+
+ case DragEvent.ACTION_DROP:
+ /* Judge whether this is plain text, or if it's a file URI for
+ which permissions must be requested. */
+
+ data = event.getClipData ();
+ description = data.getDescription ();
+
+ /* If there are insufficient items within the clip data,
+ return false. */
+
+ if (data.getItemCount () < 1)
+ return false;
+
+ /* Search for plain text data within the clipboard. */
+
+ for (i = 0; i < description.getMimeTypeCount (); ++i)
+ {
+ type = description.getMimeType (i);
+
+ if (type.equals (ClipDescription.MIMETYPE_TEXT_PLAIN)
+ || type.equals (ClipDescription.MIMETYPE_TEXT_HTML))
+ {
+ /* The data being dropped is plain text; encode it
+ suitably and send it to the main thread. */
+ type = (data.getItemAt (0).coerceToText (EmacsService.SERVICE)
+ .toString ());
+ EmacsNative.sendDndText (handle, x, y, type);
+ return true;
+ }
+ else if (type.equals (ClipDescription.MIMETYPE_TEXT_URILIST))
+ {
+ /* The data being dropped is a list of URIs; encode it
+ suitably and send it to the main thread. */
+ type = (data.getItemAt (0).coerceToText (EmacsService.SERVICE)
+ .toString ());
+ EmacsNative.sendDndUri (handle, x, y, type);
+ return true;
+ }
+ else
+ {
+ /* If the item dropped is a URI, send it to the main
+ thread. */
+ uri = data.getItemAt (0).getUri ();
+
+ /* Attempt to acquire permissions for this URI;
+ failing which, insert it as text instead. */
+
+ if (uri.getScheme () != null
+ && uri.getScheme ().equals ("content")
+ && (activity = EmacsActivity.lastFocusedActivity) != null)
+ {
+ if (activity.requestDragAndDropPermissions (event) == null)
+ uri = null;
+ }
+
+ if (uri != null)
+ EmacsNative.sendDndUri (handle, x, y, uri.toString ());
+ else
+ {
+ type = (data.getItemAt (0)
+ .coerceToText (EmacsService.SERVICE)
+ .toString ());
+ EmacsNative.sendDndText (handle, x, y, type);
+ }
+
+ return true;
+ }
+ }
+ }
+
+ return true;
+ }
};
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index 81d3dfc3432..c861c835966 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -231,13 +231,27 @@ Archive and member name will be added."
:group 'archive)
(defcustom archive-zip-extract
- (cond ((executable-find "unzip") '("unzip" "-qq" "-c"))
+ (cond ((executable-find "unzip")
+ (if (and (eq system-type 'android)
+ ;; Mind that the unzip provided by Android
+ ;; does not understand -qq or -c, their
+ ;; functions being assumed by -q and -p
+ ;; respectively. Furthermore, the user
+ ;; might install an unzip executable
+ ;; distinct from the system-provided unzip,
+ ;; and such situations must be detected as
+ ;; well.
+ (member (executable-find "unzip")
+ '("/bin/unzip"
+ "/system/bin/unzip")))
+ '("unzip" "-q" "-p")
+ '("unzip" "-qq" "-c")))
(archive-7z-program `(,archive-7z-program "x" "-so"))
((executable-find "pkunzip") '("pkunzip" "-e" "-o-"))
(t '("unzip" "-qq" "-c")))
"Program and its options to run in order to extract a zip file member.
-Extraction should happen to standard output. Archive and member name will
-be added."
+Extraction should happen to standard output. Archive and member
+name will be added."
:type '(list (string :tag "Program")
(repeat :tag "Options"
:inline t
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 207adb3a2a4..70e4087e131 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -682,6 +682,7 @@ By default, this shows the information specified by
`global-mode-string'.")
'mode-line-buffer-identification
" "
'mode-line-position
+ '(project-mode-line project-mode-line-format)
'(vc-mode vc-mode)
" "
'mode-line-modes
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 988fef2fcd2..3e8f25966ef 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -32,7 +32,7 @@
;;; Units operations.
-;;; Units table last updated 9-Jan-91 by Ulrich Mueller (ulm@vsnhd1.cern.ch)
+;;; Units table last updated 9-Jan-91 by Ulrich Müller (ulm@vsnhd1.cern.ch)
;;; with some additions by Przemek Klosowski (przemek@rrdstrad.nist.gov)
;;; Updated April 2002 by Jochen Küpper
@@ -57,12 +57,13 @@
( ft "12 in" "Foot")
( yd "3 ft" "Yard" )
( mi "5280 ft" "Mile" )
- ( au "149597870691. m" "Astronomical Unit" nil
- "149597870691 m (*)")
- ;; (approx) NASA JPL (https://neo.jpl.nasa.gov/glossary/au.html)
+ ( au "149597870700 m" "Astronomical Unit")
+ ;; "149 597 870 700 m exactly"
+ ;; http://www.iau.org/static/resolutions/IAU2012_English.pdf
( lyr "c yr" "Light Year" )
- ( pc "3.0856775854*10^16 m" "Parsec (**)" nil
- "3.0856775854 10^16 m (*)") ;; (approx) ESUWM
+ ( pc "(648000/pi) au" "Parsec (**)")
+ ;; "The parsec is defined as exactly (648 000/π) au"
+ ;; http://www.iau.org/static/resolutions/IAU2015_English.pdf
( nmi "1852 m" "Nautical Mile" )
( fath "6 ft" "Fathom" )
( fur "660 ft" "Furlong")
@@ -181,9 +182,9 @@
( hpm "75 m kgf/s" "Metric Horsepower") ;;ESUWM
;; Temperature
- ( K nil "*Degree Kelvin" K )
- ( dK "K" "Degree Kelvin" K )
- ( degK "K" "Degree Kelvin" K )
+ ( K nil "*Kelvin" K )
+ ;; FIXME: Add °C and °F, but it requires that we sort out input etc for
+ ;; the ° sign.
( dC "K" "Degree Celsius" C )
( degC "K" "Degree Celsius" C )
( dF "(5/9) K" "Degree Fahrenheit" F )
@@ -307,8 +308,24 @@
"22.710947 10^-3 m^3/mol (*)")
;; Logarithmic units
( Np nil "*Neper")
- ( dB "(ln(10)/20) Np" "decibel")))
-
+ ( dB "(ln(10)/20) Np" "decibel"))
+ "List of predefined units for Calc.
+
+Each element is (NAME DEF DESC TEMP-UNIT HUMAN-DEF), where:
+
+NAME is the unit symbol.
+DEF is a string defining the unit as a Calc expression; nil if base unit.
+DESC is a string describing the unit (to a human reader).
+ A leading asterisk indicates that the unit is first in its group.
+TEMP-UNIT is `K', `C' or `F' for temperature units and is used to identify
+ the unit when doing absolute temperature conversion
+ (`calc-convert-temperature'). For other units, nil.
+HUMAN-DEF is a string defining the unit (to a human reader).
+ If absent or nil, DEF is used.
+
+(*) in HUMAN-DEF means that the definition is approximate, otherwise exact.
+(**) in DESC means that the unit name is different in TeX and LaTeX
+ display modes.")
(defvar math-additional-units nil
"Additional units table for user-defined units.
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index 0cd03c15881..7606805a99b 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -100,19 +100,21 @@ into account any discrepancy of time under-worked or
over-worked on
previous days. This only affects the timeclock mode line display."
:type 'boolean)
-(defcustom timeclock-get-project-function 'timeclock-ask-for-project
+(defcustom timeclock-get-project-function #'timeclock-ask-for-project
"The function used to determine the name of the current project.
When clocking in, and no project is specified, this function will be
called to determine what is the current project to be worked on.
If this variable is nil, no questions will be asked."
- :type 'function)
+ :type '(choice (const :tag "Don't ask" nil)
+ function))
-(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
+(defcustom timeclock-get-reason-function #'timeclock-ask-for-reason
"A function used to determine the reason for clocking out.
When clocking out, and no reason is specified, this function will be
called to determine what is the reason.
If this variable is nil, no questions will be asked."
- :type 'function)
+ :type '(choice (const :tag "Don't ask" nil)
+ function))
(defcustom timeclock-get-workday-function nil
"A function used to determine the length of today's workday.
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 305bf599151..c32d2edd7b7 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -312,7 +312,8 @@ All specific project types must derive from this project."
"File containing the list of projects EDE has viewed.
If set to nil, then the cache is not saved."
:group 'ede
- :type 'file)
+ :type '(choice (const :tag "Don't save the cache" nil)
+ file))
(defvar ede-project-cache-files nil
"List of project files EDE has seen before.")
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 37b41fbe8c3..38ccf5b975f 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -71,7 +71,9 @@ Any other value means to do the default pulsing behavior.
If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then
this flag is ignored."
:group 'pulse
- :type 'boolean)
+ :type '(choice (const :tag "Highlight with unchanging color" nil)
+ (const :tag "No highlight" never)
+ (other :tag "Pulse" t)))
(defface pulse-highlight-start-face
'((((class color) (background dark))
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index 125459d6eeb..004bb7adddb 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -49,7 +49,8 @@
"The save location for SRecode's map file.
If the save file is nil, then the MAP is not saved between sessions."
:group 'srecode
- :type 'file)
+ :type '(choice (const :tag "Don't save" nil)
+ file))
(defclass srecode-map (eieio-persistent)
((fileheaderline :initform ";; SRECODE TEMPLATE MAP")
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 67907ec403e..14581e3d414 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -201,6 +201,11 @@ Return nil if URI is not a local file."
(string-equal sysname-no-dot hostname)))
(concat "file://" (substring uri (+ 7 (length hostname))))))))
+(defvar dnd-unescape-file-uris t
+ "Whether to unescape file: URIs before they are opened.
+Bind this to nil when providing `dnd-get-local-file-name' with a
+file name that may incorporate URI escape sequences.")
+
(defun dnd--unescape-uri (uri)
;; Merge with corresponding code in URL library.
(replace-regexp-in-string
@@ -226,7 +231,10 @@ Return nil if URI is not a local file."
'utf-8
(or file-name-coding-system
default-file-name-coding-system))))
- (and f (setq f (decode-coding-string (dnd--unescape-uri f) coding)))
+ (and f (setq f (decode-coding-string
+ (if dnd-unescape-file-uris
+ (dnd--unescape-uri f) f)
+ coding)))
(when (and f must-exist (not (file-readable-p f)))
(setq f nil))
f))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 210b7ace7d6..fb51661caac 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -661,7 +661,9 @@ Typically \"page-%s.png\".")
'("DocView (edit)"
("Toggle edit/display"
["Edit document" (lambda ()) ; ignore but show no keybinding
- :style radio :selected (eq major-mode 'doc-view--text-view-mode)]
+ ;; This is always selected since its menu is singular to the
+ ;; display minor mode.
+ :style radio :selected t]
["Display document" doc-view-toggle-display
:style radio :selected (eq major-mode 'doc-view-mode)])
["Exit DocView Mode" doc-view-minor-mode]))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c41b123ac2f..19eeb4b5d74 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -295,7 +295,7 @@ The information is logged to `byte-compile-log-buffer'."
'(redefine callargs free-vars unresolved
obsolete noruntime interactive-only
make-local mapcar constants suspicious lexical lexical-dynamic
- docstrings docstrings-non-ascii-quotes not-unused
+ docstrings docstrings-wide docstrings-non-ascii-quotes not-unused
empty-body)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
@@ -322,12 +322,15 @@ Elements of the list may be:
is likely to be a mistake
not-unused warning about using variables with symbol names starting with _.
constants let-binding of, or assignment to, constants/nonvariables.
- docstrings docstrings that are too wide (longer than
- `byte-compile-docstring-max-column' or
- `fill-column' characters, whichever is bigger) or
- have other stylistic issues.
- docstrings-non-ascii-quotes docstrings that have non-ASCII quotes.
- This depends on the `docstrings' warning type.
+ docstrings various docstring stylistic issues, such as incorrect use
+ of single quotes
+ docstrings-wide
+ docstrings that are too wide, containing lines longer than both
+ `byte-compile-docstring-max-column' and `fill-column' characters.
+ Only enabled when `docstrings' also is.
+ docstrings-non-ascii-quotes
+ docstrings that have non-ASCII quotes.
+ Only enabled when `docstrings' also is.
suspicious constructs that usually don't do what the coder wanted.
empty-body body argument to a special form or macro is empty.
mutate-constant
@@ -1756,7 +1759,8 @@ It is too wide if it has any lines longer than the
largest of
(setq docs (nth 2 form))))
(when (and kind docs (stringp docs))
(let ((col (max byte-compile-docstring-max-column fill-column)))
- (when (byte-compile--wide-docstring-p docs col)
+ (when (and (byte-compile-warning-enabled-p 'docstrings-wide)
+ (byte-compile--wide-docstring-p docs col))
(byte-compile-warn-x
name
"%sdocstring wider than %s characters" (funcall prefix) col)))
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index d0bfcab4082..56e35078d39 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -165,6 +165,7 @@ Print the contents hidden by the ellipsis to STREAM."
(defvar cl-print-compiled nil
"Control how to print byte-compiled functions.
Acceptable values include:
+- `raw' to print out the full contents of the function using `prin1'.
- `static' to print the vector of constants.
- `disassemble' to print the disassembly of the code.
- nil to skip printing any details about the code.")
@@ -187,42 +188,54 @@ into a button whose action shows the function's
disassembly.")
(if args
(prin1 args stream)
(princ "()" stream)))
- (pcase (help-split-fundoc (documentation object 'raw) object)
- ;; Drop args which `help-function-arglist' already printed.
- (`(,_usage . ,(and doc (guard (stringp doc))))
- (princ " " stream)
- (prin1 doc stream)))
- (let ((inter (interactive-form object)))
- (when inter
- (princ " " stream)
- (cl-print-object
- (if (eq 'byte-code (car-safe (cadr inter)))
- `(interactive ,(make-byte-code nil (nth 1 (cadr inter))
- (nth 2 (cadr inter))
- (nth 3 (cadr inter))))
- inter)
- stream)))
- (if (eq cl-print-compiled 'disassemble)
- (princ
- (with-temp-buffer
- (insert "\n")
- (disassemble-1 object 0)
- (buffer-string))
- stream)
- (princ " " stream)
- (let ((button-start (and cl-print-compiled-button
- (bufferp stream)
- (with-current-buffer stream (point)))))
- (princ (format "#<bytecode %#x>" (sxhash object)) stream)
- (when (eq cl-print-compiled 'static)
+ (if (eq cl-print-compiled 'raw)
+ (let ((button-start
+ (and cl-print-compiled-button
+ (bufferp stream)
+ (with-current-buffer stream (1+ (point))))))
(princ " " stream)
- (cl-print-object (aref object 2) stream))
- (when button-start
- (with-current-buffer stream
- (make-text-button button-start (point)
- :type 'help-byte-code
- 'byte-code-function object)))))
- (princ ")" stream))
+ (prin1 object stream)
+ (when button-start
+ (with-current-buffer stream
+ (make-text-button button-start (point)
+ :type 'help-byte-code
+ 'byte-code-function object))))
+ (pcase (help-split-fundoc (documentation object 'raw) object)
+ ;; Drop args which `help-function-arglist' already printed.
+ (`(,_usage . ,(and doc (guard (stringp doc))))
+ (princ " " stream)
+ (prin1 doc stream)))
+ (let ((inter (interactive-form object)))
+ (when inter
+ (princ " " stream)
+ (cl-print-object
+ (if (eq 'byte-code (car-safe (cadr inter)))
+ `(interactive ,(make-byte-code nil (nth 1 (cadr inter))
+ (nth 2 (cadr inter))
+ (nth 3 (cadr inter))))
+ inter)
+ stream)))
+ (if (eq cl-print-compiled 'disassemble)
+ (princ
+ (with-temp-buffer
+ (insert "\n")
+ (disassemble-1 object 0)
+ (buffer-string))
+ stream)
+ (princ " " stream)
+ (let ((button-start (and cl-print-compiled-button
+ (bufferp stream)
+ (with-current-buffer stream (point)))))
+ (princ (format "#<bytecode %#x>" (sxhash object)) stream)
+ (when (eq cl-print-compiled 'static)
+ (princ " " stream)
+ (cl-print-object (aref object 2) stream))
+ (when button-start
+ (with-current-buffer stream
+ (make-text-button button-start (point)
+ :type 'help-byte-code
+ 'byte-code-function object)))))
+ (princ ")" stream)))
;; This belongs in oclosure.el, of course, but some load-ordering issues make
it
;; complicated.
@@ -549,14 +562,14 @@ node `(elisp)Output Variables'."
(defun cl-print-to-string-with-limit (print-function value limit)
"Return a string containing a printed representation of VALUE.
Attempt to get the length of the returned string under LIMIT
-characters with appropriate settings of `print-level' and
-`print-length.' Use PRINT-FUNCTION to print, which should take
-the arguments VALUE and STREAM and which should respect
-`print-length' and `print-level'. LIMIT may be nil or zero in
-which case PRINT-FUNCTION will be called with `print-level' and
-`print-length' bound to nil, and it can also be t in which case
-PRINT-FUNCTION will be called with the current values of `print-level'
-and `print-length'.
+characters with appropriate settings of `print-level',
+`print-length', and `cl-print-string-length'. Use
+PRINT-FUNCTION to print, which should take the arguments VALUE
+and STREAM and which should respect `print-length',
+`print-level', and `cl-print-string-length'. LIMIT may be nil or
+zero in which case PRINT-FUNCTION will be called with these
+settings bound to nil, and it can also be t in which case
+PRINT-FUNCTION will be called with their current values.
Use this function with `cl-prin1' to print an object,
abbreviating it with ellipses to fit within a size limit."
@@ -565,17 +578,17 @@ abbreviating it with ellipses to fit within a size limit."
;; limited, if you increase print-level here, add more depth in
;; call_debugger (bug#31919).
(let* ((print-length (cond
- ((null limit) nil)
((eq limit t) print-length)
+ ((or (null limit) (zerop limit)) nil)
(t (min limit 50))))
(print-level (cond
- ((null limit) nil)
((eq limit t) print-level)
+ ((or (null limit) (zerop limit)) nil)
(t (min 8 (truncate (log limit))))))
(cl-print-string-length
(cond
- ((or (null limit) (zerop limit)) nil)
((eq limit t) cl-print-string-length)
+ ((or (null limit) (zerop limit)) nil)
(t (max 0 (- limit 3)))))
(delta-length (when (natnump limit)
(max 1 (truncate (/ print-length print-level))))))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 73777d7e701..d9295686e9f 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -301,6 +301,23 @@ OBJ should be a call to BYTE-CODE generated by the byte
compiler."
(insert "\n")))))
nil)
+(defun re-disassemble (regexp &optional case-table)
+ "Describe the compiled form of REGEXP in a separate window.
+If CASE-TABLE is non-nil, use it as translation table for case-folding.
+
+This function is mainly intended for maintenance of Emacs itself
+and may change at any time. It requires Emacs to be built with
+`--enable-checking'."
+ (interactive "XRegexp (Lisp expression): ")
+ (let ((desc (with-temp-buffer
+ (when case-table
+ (set-case-table case-table))
+ (let ((case-fold-search (and case-table t)))
+ (re--describe-compiled regexp)))))
+ (with-output-to-temp-buffer "*Regexp-disassemble*"
+ (with-current-buffer standard-output
+ (insert desc)))))
+
(provide 'disass)
;;; disass.el ends here
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index 700f007d6b4..d8ab883b58d 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -1,8 +1,9 @@
;;; elint.el --- Lint Emacs Lisp -*- lexical-binding: t -*-
-;; Copyright (C) 1997, 2001-2023 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2023 Free Software Foundation, Inc.
;; Author: Peter Liljenberg <petli@lysator.liu.se>
+;; Maintainer: emacs-devel@gnu.org
;; Created: May 1997
;; Keywords: lisp
@@ -27,7 +28,7 @@
;; misspellings and undefined variables, although it can also catch
;; function calls with the wrong number of arguments.
-;; To use, call `elint-current-buffer' or `elint-defun' to lint a buffer
+;; To use it, call `elint-current-buffer' or `elint-defun' to lint a buffer
;; or defun. The first call runs `elint-initialize' to set up some
;; argument data, which may take a while.
@@ -37,9 +38,9 @@
;;; To do:
-;; * Adding type checking. (Stop that sniggering!)
+;; * Adding type checking. (Stop that sniggering!)
;; * Make eval-when-compile be sensitive to the difference between
-;; funcs and macros.
+;; functions and macros.
;; * Requires within function bodies.
;; * Handle defstruct.
;; * Prevent recursive requires.
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index d9ad46b2af7..ed07aecf338 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -9,8 +9,8 @@
;; Prefix: let-alist
;; Separator: -
-;; This is an Elpa :core package. Don't use functionality that is not
-;; compatible with Emacs 24.1.
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -60,7 +60,7 @@
;; the variables of the outer one. You can, however, access alists
;; inside the original alist by using dots inside the symbol, as
;; displayed in the example above by the `.site.contents'.
-;;
+
;;; Code:
@@ -139,7 +139,14 @@ essentially expands to
If you nest `let-alist' invocations, the inner one can't access
the variables of the outer one. You can, however, access alists
inside the original alist by using dots inside the symbol, as
-displayed in the example above."
+displayed in the example above.
+
+Note that there is no way to differentiate the case where a key
+is missing from when it is present, but its value is nil. Thus,
+the following form evaluates to nil:
+
+ (let-alist \\='((some-key . nil))
+ .some-key)"
(declare (indent 1) (debug t))
(let ((var (make-symbol "alist")))
`(let ((,var ,alist))
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 3ef924a5c73..6eb670d6dc1 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -105,13 +105,21 @@ each clause."
(macroexp--all-forms clause skip)
clause)))
+(defvar macroexp-inhibit-compiler-macros nil
+ "Inhibit application of compiler macros if non-nil.")
+
(defun macroexp--compiler-macro (handler form)
- (condition-case-unless-debug err
- (apply handler form (cdr form))
- (error
- (message "Warning: Optimization failure for %S: Handler: %S\n%S"
- (car form) handler err)
- form)))
+ "Apply compiler macro HANDLER to FORM and return the result.
+Unless `macroexp-inhibit-compiler-macros' is non-nil, in which
+case return FORM unchanged."
+ (if macroexp-inhibit-compiler-macros
+ form
+ (condition-case-unless-debug err
+ (apply handler form (cdr form))
+ (error
+ (message "Warning: Optimization failure for %S: Handler: %S\n%S"
+ (car form) handler err)
+ form))))
(defun macroexp--funcall-if-compiled (_form)
"Pseudo function used internally by macroexp to delay warnings.
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
index a8393cb7e75..9780e4d53de 100644
--- a/lisp/emacs-lisp/package-vc.el
+++ b/lisp/emacs-lisp/package-vc.el
@@ -501,7 +501,8 @@ This includes downloading missing dependencies, generating
autoloads, generating a package description file (used to
identify a package as a VC package later on), building
documentation and marking the package as installed."
- (let (missing)
+ (let ((pkg-spec (package-vc--desc->spec pkg-desc))
+ missing)
;; Remove any previous instance of PKG-DESC from `package-alist'
(let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
(when pkgs
@@ -510,17 +511,29 @@ documentation and marking the package as installed."
;; In case the package was installed directly from source, the
;; dependency list wasn't know beforehand, and they might have
;; to be installed explicitly.
- (let ((deps '()))
+ (let ((ignored-files
+ (if (plist-get pkg-spec :ignored-files)
+ (mapconcat
+ (lambda (ignore)
+ (wildcard-to-regexp
+ (if (string-match-p "\\`/" ignore)
+ (concat pkg-dir ignore)
+ (concat "*/" ignore))))
+ (plist-get pkg-spec :ignored-files)
+ "\\|")
+ regexp-unmatchable))
+ (deps '()))
(dolist (file (directory-files pkg-dir t "\\.el\\'" t))
- (with-temp-buffer
- (insert-file-contents file)
- (when-let* ((require-lines (lm-header-multiline "package-requires")))
- (thread-last
- (mapconcat #'identity require-lines " ")
- package-read-from-string
- package--prepare-dependencies
- (nconc deps)
- (setq deps)))))
+ (unless (string-match-p ignored-files file)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when-let* ((require-lines (lm-header-multiline
"package-requires")))
+ (thread-last
+ (mapconcat #'identity require-lines " ")
+ package-read-from-string
+ package--prepare-dependencies
+ (nconc deps)
+ (setq deps))))))
(dolist (dep deps)
(cl-callf version-to-list (cadr dep)))
(setf missing (package-vc-install-dependencies (delete-dups deps)))
@@ -529,8 +542,7 @@ documentation and marking the package as installed."
missing)))
(let ((default-directory (file-name-as-directory pkg-dir))
- (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir))
- (pkg-spec (package-vc--desc->spec pkg-desc)))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
;; Generate autoloads
(let* ((name (package-desc-name pkg-desc))
(auto-name (format "%s-autoloads.el" name))
@@ -941,18 +953,19 @@ for the last released version of the package."
(find-file directory)))
;;;###autoload
-(defun package-vc-install-from-checkout (dir name)
+(defun package-vc-install-from-checkout (dir &optional name)
"Install the package NAME from its source directory DIR.
+NAME defaults to the base name of DIR.
Interactively, prompt the user for DIR, which should be a directory
under version control, typically one created by `package-vc-checkout'.
If invoked interactively with a prefix argument, prompt the user
-for the NAME of the package to set up. Otherwise infer the package
-name from the base name of DIR."
- (interactive (let ((dir (read-directory-name "Directory: ")))
- (list dir
- (if current-prefix-arg
- (read-string "Package name: ")
- (file-name-base (directory-file-name dir))))))
+for the NAME of the package to set up."
+ (interactive (let* ((dir (read-directory-name "Directory: "))
+ (base (file-name-base (directory-file-name dir))))
+ (list dir (and current-prefix-arg
+ (read-string
+ (format-prompt "Package name" base)
+ nil nil base)))))
(unless (vc-responsible-backend dir)
(user-error "Directory %S is not under version control" dir))
(package-vc--archives-initialize)
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index fb10ee31c78..3d34fc97d00 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -164,7 +164,6 @@
(declare-function erc-is-message-ctcp-p "erc" (message))
(declare-function erc-log-irc-protocol "erc" (string &optional outbound))
(declare-function erc-login "erc" nil)
-(declare-function erc-make-notice "erc" (message))
(declare-function erc-network "erc-networks" nil)
(declare-function erc-networks--id-given "erc-networks" (arg &rest args))
(declare-function erc-networks--id-reload "erc-networks" (arg &rest args))
@@ -511,7 +510,7 @@ It should take same arguments as `open-network-stream'
does."
"Either nil or a list of strings.
Each string is a IRC message type, like PRIVMSG or NOTICE.
All Message types in that list of subjected to duplicate prevention."
- :type '(choice (const nil) (list string)))
+ :type '(repeat string))
(defcustom erc-server-duplicate-timeout 60
"The time allowed in seconds between duplicate messages.
@@ -1718,7 +1717,7 @@ add things to `%s' instead."
(if (string-match "^\\(.*\\)\^g.*$" chnl)
(setq chnl (match-string 1 chnl)))
(save-excursion
- (let* ((str (cond
+ (let ((args (cond
;; If I have joined a channel
((erc-current-nick-p nick)
(let ((erc--display-context
@@ -1735,18 +1734,15 @@ add things to `%s' instead."
(erc-channel-begin-receiving-names))
(erc-update-mode-line)
(run-hooks 'erc-join-hook)
- (erc-make-notice
- (erc-format-message 'JOIN-you ?c chnl)))
+ (list 'JOIN-you ?c chnl))
(t
(setq buffer (erc-get-buffer chnl proc))
- (erc-make-notice
- (erc-format-message
- 'JOIN ?n nick ?u login ?h host ?c chnl))))))
+ (list 'JOIN ?n nick ?u login ?h host ?c chnl)))))
(when buffer (set-buffer buffer))
(erc-update-channel-member chnl nick nick t nil nil nil nil nil host
login)
;; on join, we want to stay in the new channel buffer
;;(set-buffer ob)
- (erc-display-message parsed nil buffer str))))))
+ (apply #'erc-display-message parsed 'notice buffer args))))))
(define-erc-response-handler (KICK)
"Handle kick messages received from the server." nil
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
index 67c2cf8535b..8d896e663b5 100644
--- a/lisp/erc/erc-common.el
+++ b/lisp/erc/erc-common.el
@@ -60,6 +60,7 @@
((obsolete erc-send-this))
erc-send-this))))
(lines nil :type (list-of string))
+ (abortp nil :type (list-of symbol))
(cmdp nil :type boolean))
(cl-defstruct (erc-server-user (:type vector) :named)
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 109b5d245ab..4c376cfbc22 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -444,6 +444,21 @@ If START or END is negative, it counts from the end."
(cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
existing))))))
+;; We can't store (TICKS . HZ) style timestamps on 27 and 28 because
+;; `time-less-p' and friends do
+;;
+;; message("obsolete timestamp with cdr ...", ...)
+;; decode_lisp_time(_, WARN_OBSOLETE_TIMESTAMPS, ...)
+;; lisp_time_struct(...)
+;; time_cmp(...)
+;;
+;; which spams *Messages* (and stderr when running the test suite).
+(defmacro erc-compat--current-lisp-time ()
+ "Return `current-time' as a (TICKS . HZ) pair on 29+."
+ (if (>= emacs-major-version 29)
+ '(let (current-time-list) (current-time))
+ '(current-time)))
+
(provide 'erc-compat)
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index f4835f71278..0048956e075 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -49,8 +49,8 @@ the channel buffers are filled."
;; other modules. Ideally, this module's processing should happen
;; after "morphological" modifications to a message's text but
;; before superficial decorations.
- ((add-hook 'erc-insert-modify-hook #'erc-fill 40)
- (add-hook 'erc-send-modify-hook #'erc-fill 40))
+ ((add-hook 'erc-insert-modify-hook #'erc-fill 60)
+ (add-hook 'erc-send-modify-hook #'erc-fill 60))
((remove-hook 'erc-insert-modify-hook #'erc-fill)
(remove-hook 'erc-send-modify-hook #'erc-fill)))
@@ -86,10 +86,12 @@ function is called.
A third style resembles static filling but \"wraps\" instead of
fills, thanks to `visual-line-mode' mode, which ERC automatically
-enables when this option is `erc-fill-wrap' or when
-`erc-fill-wrap-mode' is active. Set `erc-fill-static-center' to
-your preferred initial \"prefix\" width. For adjusting the width
-during a session, see the command `erc-fill-wrap-nudge'."
+enables when this option is `erc-fill-wrap' or when the module
+`fill-wrap' is active. Use `erc-fill-static-center' to specify
+an initial \"prefix\" width and `erc-fill-wrap-margin-width'
+instead of `erc-fill-column' for influencing initial message
+width. For adjusting these during a session, see the commands
+`erc-fill-wrap-nudge' and `erc-fill-wrap-refill-buffer'."
:type '(choice (const :tag "Variable Filling" erc-fill-variable)
(const :tag "Static Filling" erc-fill-static)
(const :tag "Dynamic word-wrap" erc-fill-wrap)
@@ -110,7 +112,8 @@ https://en.wikipedia.org/wiki/Hanging_indent.";
(defcustom erc-fill-variable-maximum-indentation 17
"Don't indent a line after a long nick more than this many characters.
Set to nil to disable."
- :type 'integer)
+ :type '(choice (const :tag "Disable" nil)
+ integer))
(defcustom erc-fill-column 78
"The column at which a filled paragraph is broken."
@@ -158,9 +161,13 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(when (or erc-fill--function erc-fill-function)
;; skip initial empty lines
(goto-char (point-min))
- (save-match-data
- (while (and (looking-at "[ \t\n]*$")
- (= (forward-line 1) 0))))
+ ;; Note the following search pattern was altered in 5.6 to adapt
+ ;; to a change in Emacs regexp behavior that turned out to be a
+ ;; regression (which has since been fixed). The patterns appear
+ ;; to be equivalent in practice, so this was left as is (wasn't
+ ;; reverted) to avoid additional git-blame(1)-related churn.
+ (while (and (looking-at (rx bol (* (in " \t")) eol))
+ (zerop (forward-line 1))))
(unless (eobp)
(save-restriction
(narrow-to-region (point) (point-max))
@@ -168,12 +175,10 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
(when-let* ((erc-fill-line-spacing)
(p (point-min)))
(widen)
- (when (or (and-let* ((cmd (get-text-property p 'erc-command)))
- (memq cmd erc-fill--spaced-commands))
+ (when (or (erc--check-msg-prop 'erc-cmd erc-fill--spaced-commands)
(and-let* ((cmd (save-excursion
(forward-line -1)
- (get-text-property (point)
- 'erc-command))))
+ (get-text-property (point) 'erc-cmd))))
(memq cmd erc-fill--spaced-commands)))
(put-text-property (1- p) p
'line-spacing erc-fill-line-spacing))))))))
@@ -182,15 +187,17 @@ You can put this on `erc-insert-modify-hook' and/or
`erc-send-modify-hook'."
"Fills a text such that messages start at column `erc-fill-static-center'."
(save-restriction
(goto-char (point-min))
- (looking-at "^\\(\\S-+\\)")
- (let ((nick (match-string 1)))
+ (when-let (((looking-at "^\\(\\S-+\\)"))
+ ((not (erc--check-msg-prop 'erc-msg 'datestamp)))
+ (nick (match-string 1)))
+ (progn
(let ((fill-column (- erc-fill-column (erc-timestamp-offset)))
(fill-prefix (make-string erc-fill-static-center 32)))
(insert (make-string (max 0 (- erc-fill-static-center
(length nick) 1))
32))
(erc-fill-regarding-timestamp))
- (erc-restore-text-properties))))
+ (erc-restore-text-properties)))))
(defun erc-fill-variable ()
"Fill from `point-min' to `point-max'."
@@ -234,11 +241,23 @@ A value of t tells ERC to use movement commands defined by
`visual-line-mode' everywhere in an ERC buffer along with visual
editing commands in the input area. A value of nil means to
never do so. A value of `non-input' tells ERC to act like the
-value is nil in the input area and t elsewhere. This option only
-plays a role when `erc-fill-wrap-mode' is enabled."
+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
:type '(choice (const nil) (const t) (const non-input)))
+(defcustom erc-fill-wrap-force-screen-line-movement '(non-input)
+ "Exceptions for vertical movement by logical line.
+Including a symbol known to `erc-fill-wrap-visual-keys' in this
+set tells `next-line' and `previous-line' to move vertically by
+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
+ :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
@@ -246,13 +265,13 @@ messages less than a day apart."
:package-version '(ERC . "5.6") ; FIXME sync on release
:type 'boolean)
-(defun erc-fill--wrap-move (normal-cmd visual-cmd arg)
- (funcall (pcase erc-fill--wrap-visual-keys
- ('non-input
- (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
- ('t visual-cmd)
- (_ normal-cmd))
- arg))
+(defun erc-fill--wrap-move (normal-cmd visual-cmd &rest args)
+ (apply (pcase erc-fill--wrap-visual-keys
+ ('non-input
+ (if (>= (point) erc-input-marker) normal-cmd visual-cmd))
+ ('t visual-cmd)
+ (_ normal-cmd))
+ args))
(defun erc-fill--wrap-kill-line (arg)
"Defer to `kill-line' or `kill-visual-line'."
@@ -283,17 +302,23 @@ Basically mimic what `move-beginning-of-line' does with
invisible text."
(defun erc-fill--wrap-previous-line (&optional arg try-vscroll)
"Move to ARGth previous logical or screen line."
(interactive "^p\np")
- (if erc-fill--wrap-visual-keys
- (with-no-warnings (previous-line arg try-vscroll))
- (prog1 (previous-logical-line arg try-vscroll)
- (erc-fill--wrap-escape-hidden-speaker))))
+ ;; Return value seems undefined but preserve anyway just in case.
+ (prog1
+ (let ((visp (memq erc-fill--wrap-visual-keys
+ erc-fill-wrap-force-screen-line-movement)))
+ (erc-fill--wrap-move (if visp #'previous-line #'previous-logical-line)
+ #'previous-line
+ arg try-vscroll))
+ (erc-fill--wrap-escape-hidden-speaker)))
(defun erc-fill--wrap-next-line (&optional arg try-vscroll)
"Move to ARGth next logical or screen line."
(interactive "^p\np")
- (if erc-fill--wrap-visual-keys
- (with-no-warnings (next-line arg try-vscroll))
- (next-logical-line arg try-vscroll)))
+ (let ((visp (memq erc-fill--wrap-visual-keys
+ erc-fill-wrap-force-screen-line-movement)))
+ (erc-fill--wrap-move (if visp #'next-line #'next-logical-line)
+ #'next-line
+ arg try-vscroll)))
(defun erc-fill--wrap-end-of-line (arg)
"Defer to `move-end-of-line' or `end-of-visual-line'."
@@ -381,15 +406,19 @@ is 0, reset to value of `erc-fill-wrap-visual-keys'."
(define-erc-module fill-wrap nil
"Fill style leveraging `visual-line-mode'.
This module displays nicks overhanging leftward to a common
-offset, as determined by the option `erc-fill-static-center'. To
-use it, either include `fill-wrap' in `erc-modules' or set
-`erc-fill-function' to `erc-fill-wrap'. Most users will want to
-enable the `scrolltobottom' module as well. Once active, use
+offset, as determined by the option `erc-fill-static-center'.
+And it \"wraps\" messages at a common margin width, as determined
+by the option `erc-fill-wrap-margin-width'. To use it, either
+include `fill-wrap' in `erc-modules' or set `erc-fill-function'
+to `erc-fill-wrap'. Most users will want to enable the
+`scrolltobottom' module as well. Once active, use
\\[erc-fill-wrap-nudge] to adjust the width of the indent and the
stamp margin, and use \\[erc-fill-wrap-toggle-truncate-lines] for
cycling between logical- and screen-line oriented command
-movement. Also see related options `erc-fill-line-spacing' and
-`erc-fill-wrap-merge'.
+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'.
This module imposes various restrictions on the appearance of
timestamps. Most notably, it insists on displaying them in the
@@ -424,8 +453,6 @@ is not recommended."
(eq (default-value 'erc-insert-timestamp-function)
#'erc-insert-timestamp-left)))
(setq erc-fill--function #'erc-fill-wrap)
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date)
(when erc-fill-wrap-merge
(add-hook 'erc-button--prev-next-predicate-functions
#'erc-fill--wrap-merged-button-p nil t))
@@ -437,9 +464,7 @@ is not recommended."
(kill-local-variable 'erc-fill--function)
(kill-local-variable 'erc-fill--wrap-visual-keys)
(remove-hook 'erc-button--prev-next-predicate-functions
- #'erc-fill--wrap-merged-button-p t)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-fill--wrap-stamp-insert-prefixed-date))
+ #'erc-fill--wrap-merged-button-p t))
'local)
(defvar-local erc-fill--wrap-length-function nil
@@ -457,6 +482,9 @@ parties.")
(defvar-local erc-fill--wrap-max-lull (* 24 60 60))
(defun erc-fill--wrap-continued-message-p ()
+ "Return non-nil when the current speaker hasn't changed.
+That is, indicate whether the text just inserted is from the same
+sender as that of the previous \"PRIVMSG\"."
(prog1 (and-let*
((m (or erc-fill--wrap-last-msg
(setq erc-fill--wrap-last-msg (point-min-marker))
@@ -464,45 +492,37 @@ parties.")
((< (1+ (point-min)) (- (point) 2)))
(props (save-restriction
(widen)
- (when (eq 'erc-timestamp (field-at-pos m))
- (set-marker m (field-end m)))
(and-let*
- (((eq 'PRIVMSG (get-text-property m 'erc-command)))
- ((not (eq (get-text-property m 'erc-ctcp)
- 'ACTION)))
+ (((eq 'PRIVMSG (get-text-property m 'erc-cmd)))
+ ((not (eq (get-text-property m 'erc-msg) 'ACTION)))
+ ((not (invisible-p m)))
(spr (next-single-property-change m 'erc-speaker)))
- (cons (get-text-property m 'erc-timestamp)
+ (cons (get-text-property m 'erc-ts)
(get-text-property spr 'erc-speaker)))))
(ts (pop props))
(props)
((not (time-less-p (erc-stamp--current-time) ts)))
((time-less-p (time-subtract (erc-stamp--current-time) ts)
erc-fill--wrap-max-lull))
+ ;; Assume presence of leading angle bracket or hyphen.
(speaker (next-single-property-change (point-min) 'erc-speaker))
- ((not (eq (get-text-property speaker 'erc-ctcp) 'ACTION)))
+ ((not (erc--check-msg-prop 'erc-ctcp 'ACTION)))
(nick (get-text-property speaker 'erc-speaker))
((erc-nick-equal-p props nick))))
(set-marker erc-fill--wrap-last-msg (point-min))))
-(defun erc-fill--wrap-stamp-insert-prefixed-date (&rest args)
- "Apply `line-prefix' property to args."
- (let* ((ts-left (car args))
- (start)
- ;; Insert " " to simulate gap between <speaker> and msg beg.
- (end (save-excursion (skip-chars-backward "\n")
- (setq start (pos-bol))
- (insert " ")
- (point)))
- (width (if (and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction (narrow-to-region start end)
- (list (car (buffer-text-pixel-size))))
- (length (string-trim-left ts-left)))))
- (delete-region (1- end) end)
- ;; Use `point-min' instead of `start' to cover leading newilnes.
- (put-text-property (point-min) (point) 'line-prefix
- `(space :width (- erc-fill--wrap-value ,width))))
- args)
+(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))
+ ;; `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)))))
+ (- end beg)))
;; An escape hatch for third-party code expecting speakers of ACTION
;; messages to be exempt from `line-prefix'. This could be converted
@@ -519,33 +539,110 @@ See `erc-fill-wrap-mode' for details."
(goto-char (point-min))
(let ((len (or (and erc-fill--wrap-length-function
(funcall erc-fill--wrap-length-function))
- (progn
+ (and-let* ((msg-prop (erc--check-msg-prop 'erc-msg)))
(when-let ((e (erc--get-speaker-bounds))
(b (pop e))
((or erc-fill--wrap-action-dedent-p
- (not (eq (get-text-property b 'erc-ctcp)
- 'ACTION)))))
+ (not (erc--check-msg-prop 'erc-ctcp
+ 'ACTION)))))
(goto-char e))
(skip-syntax-forward "^-")
(forward-char)
- ;; Using the `invisible' property might make more
- ;; sense, but that would require coordination
- ;; with other modules, like `erc-match'.
- (cond ((and erc-fill-wrap-merge
+ (cond ((eq msg-prop 'datestamp)
+ (when erc-fill--wrap-last-msg
+ (set-marker erc-fill--wrap-last-msg (point-min)))
+ (save-excursion
+ (goto-char (point-max))
+ (skip-chars-backward "\n")
+ (let ((beg (pos-bol)))
+ (insert " ")
+ (prog1 (erc-fill--wrap-measure beg (point))
+ (delete-region (1- (point)) (point))))))
+ ((and erc-fill-wrap-merge
(erc-fill--wrap-continued-message-p))
(put-text-property (point-min) (point)
'display "")
0)
- ((and erc-fill-wrap-use-pixels
- (fboundp 'buffer-text-pixel-size))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (list (car (buffer-text-pixel-size)))))
- (t (- (point) (point-min))))))))
- (erc-put-text-properties (point-min) (1- (point-max)) ; exclude "\n"
- '(line-prefix wrap-prefix) nil
- `((space :width (- erc-fill--wrap-value ,len))
- (space :width erc-fill--wrap-value))))))
+ (t
+ (erc-fill--wrap-measure (point-min) (point))))))))
+ (add-text-properties
+ (point-min) (1- (point-max)) ; exclude "\n"
+ `( line-prefix (space :width ,(if len
+ `(- erc-fill--wrap-value ,len)
+ 'erc-fill--wrap-value))
+ wrap-prefix (space :width erc-fill--wrap-value))))))
+
+(defvar erc-fill--wrap-rejigger-last-message nil
+ "Temporary working instance of `erc-fill--wrap-last-msg'.")
+
+(defun erc-fill--wrap-rejigger-region (start finish on-next repairp)
+ "Recalculate `line-prefix' from START to FINISH.
+After refilling each message, call ON-NEXT with no args. But
+stash and restore `erc-fill--wrap-last-msg' before doing so, in
+case this module's insert hooks run by way of the process filter.
+With REPAIRP, destructively fill gaps and re-merge speakers."
+ (goto-char start)
+ (cl-assert (null erc-fill--wrap-rejigger-last-message))
+ (let (erc-fill--wrap-rejigger-last-message)
+ (while-let
+ (((< (point) finish))
+ (beg (if (get-text-property (point) 'line-prefix)
+ (point)
+ (next-single-property-change (point) 'line-prefix)))
+ (val (get-text-property beg 'line-prefix))
+ (end (text-property-not-all beg finish 'line-prefix val)))
+ ;; If this is a left-side stamp on its own line.
+ (remove-text-properties beg (1+ end) '(line-prefix nil wrap-prefix nil))
+ (when-let ((repairp)
+ (dbeg (text-property-not-all beg end 'display nil))
+ ((get-text-property (1+ dbeg) 'erc-speaker))
+ (dval (get-text-property dbeg 'display))
+ ((equal "" dval)))
+ (remove-text-properties
+ dbeg (text-property-not-all dbeg end 'display dval) '(display)))
+ (let* ((pos (if (eq 'date-left (get-text-property beg 'erc-stamp-type))
+ (field-beginning beg)
+ beg))
+ (erc--msg-props (map-into (text-properties-at pos) 'hash-table))
+ (erc-stamp--current-time (gethash 'erc-ts erc--msg-props)))
+ (save-restriction
+ (narrow-to-region beg (1+ end))
+ (let ((erc-fill--wrap-last-msg erc-fill--wrap-rejigger-last-message))
+ (erc-fill-wrap)
+ (setq erc-fill--wrap-rejigger-last-message
+ erc-fill--wrap-last-msg))))
+ (when on-next
+ (funcall on-next))
+ ;; Skip to end of message upon encountering accidental gaps
+ ;; introduced by third parties (or bugs).
+ (if-let (((/= ?\n (char-after end)))
+ (next (erc--get-inserted-msg-bounds 'end beg)))
+ (progn
+ (cl-assert (= ?\n (char-after next)))
+ (when repairp ; eol <= next
+ (put-text-property end (pos-eol) 'line-prefix val))
+ (goto-char next))
+ (goto-char end)))))
+
+(defun erc-fill-wrap-refill-buffer (repair)
+ "Recalculate all `fill-wrap' prefixes in the current buffer.
+With REPAIR, attempt to refresh \"speaker merges\", which may be
+necessary after revealing previously hidden text with commands
+like `erc-match-toggle-hidden-fools'."
+ (interactive "P")
+ (unless erc-fill-wrap-mode
+ (user-error "Module `fill-wrap' not active in current buffer."))
+ (save-excursion
+ (with-silent-modifications
+ (let* ((rep (make-progress-reporter
+ "Rewrap" 0 (line-number-at-pos erc-insert-marker) 1))
+ (seen 0)
+ (callback (lambda ()
+ (progress-reporter-update rep (cl-incf seen))
+ (accept-process-output nil 0.000001))))
+ (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker
+ callback repair)
+ (progress-reporter-done rep)))))
;; FIXME use own text property to avoid false positives.
(defun erc-fill--wrap-merged-button-p (point)
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 6eb015fdd64..9d70c644429 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -44,45 +44,46 @@
This should be an integer specifying the line of the buffer on which
the input line should stay. A value of \"-1\" would keep the input
line positioned on the last line in the buffer. This is passed as an
-argument to `recenter', unless `erc-scrolltobottom-relaxed' is
-non-nil, in which case, ERC interprets it as additional lines to
-scroll down by per message insertion (minus one for the prompt)."
+argument to `recenter', unless `erc-scrolltobottom-all' is
+`relaxed', in which case, ERC interprets it as additional lines
+to scroll down by per message insertion (minus one for the
+prompt)."
:group 'erc-display
:type '(choice integer (const nil)))
(defcustom erc-scrolltobottom-all nil
"Whether to scroll all windows or just the selected one.
-A value of nil preserves pre-5.6 behavior, in which scrolling
-only affects the selected window. Users should consider its
-non-nil behavior experimental for the time being. Note also that
ERC expects this option to be configured before module
-initialization."
+initialization. A value of nil preserves pre-5.6 behavior, in
+which scrolling only affects the selected window. A value of t
+means ERC attempts to recenter all visible windows whose point
+resides in the input area.
+
+A value of `relaxed' tells ERC to forgo forcing prompt to the
+bottom of the window. When point is at the prompt, ERC scrolls
+the window up when inserting messages, making the prompt appear
+stationary. Users who find this effect too \"stagnant\" can
+adjust the option `erc-input-line-position', borrowed here to
+express a scroll step offset. Setting that value to zero lets
+the prompt drift toward the bottom by one line per message, which
+is generally slow enough not to distract while composing input.
+Of course, this doesn't apply when receiving a large influx of
+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
- :type 'boolean)
-
-(defcustom erc-scrolltobottom-relaxed nil
- "Whether to forgo forcing prompt to the bottom of the window.
-When non-nil, and point is at the prompt, ERC scrolls the window
-up when inserting messages, making the prompt appear stationary.
-Users who find this effect too \"stagnant\" can adjust the option
-`erc-input-line-position', which ERC borrows to express a scroll
-step offset when this option is non-nil. Setting that value to
-zero lets the prompt drift toward the bottom by one line per
-message, which is generally slow enough not to distract while
-composing input. Of course, this doesn't apply when receiving a
-large influx of messages, such as after typing \"/msg NickServ
-help\". Note that ERC only considers this option when the
-experimental companion option `erc-scrolltobottom-all' is enabled
-and, only then, during module setup."
- :group 'erc-display
- :package-version '(ERC . "5.6") ; FIXME sync on release
- :type 'boolean)
+ :type '(choice boolean (const relaxed)))
;;;###autoload(autoload 'erc-scrolltobottom-mode "erc-goodies" nil t)
(define-erc-module scrolltobottom nil
"This mode causes the prompt to stay at the end of the window."
((add-hook 'erc-mode-hook #'erc--scrolltobottom-setup)
+ (when (and erc-scrolltobottom-all (< emacs-major-version 28))
+ (erc-button--display-error-notice-with-keys
+ "Option `erc-scrolltobottom-all' requires Emacs 28+. Disabling.")
+ (setopt erc-scrolltobottom-all nil))
(unless erc--updating-modules-p (erc-buffer-do #'erc--scrolltobottom-setup))
(if erc-scrolltobottom-all
(progn
@@ -93,25 +94,17 @@ and, only then, during module setup."
(add-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)))
((remove-hook 'erc-mode-hook #'erc--scrolltobottom-setup)
(erc-buffer-do #'erc--scrolltobottom-setup)
- (if erc-scrolltobottom-all
- (progn
- (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert)
- (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all)
- (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all)
- (remove-hook 'erc-pre-send-functions
- #'erc--scrolltobottom-on-pre-insert))
- (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom))))
+ (remove-hook 'erc-insert-pre-hook #'erc--scrolltobottom-on-pre-insert)
+ (remove-hook 'erc-send-completed-hook #'erc--scrolltobottom-all)
+ (remove-hook 'erc-insert-done-hook #'erc--scrolltobottom-all)
+ (remove-hook 'erc-pre-send-functions #'erc--scrolltobottom-on-pre-insert)
+ (remove-hook 'erc-insert-done-hook #'erc-possibly-scroll-to-bottom)))
(defun erc-possibly-scroll-to-bottom ()
"Like `erc-add-scroll-to-bottom', but only if window is selected."
(when (eq (selected-window) (get-buffer-window))
(erc-scroll-to-bottom)))
-(defvar-local erc--scrolltobottom-relaxed-commands '(end-of-buffer)
- "Commands triggering a forced scroll to prompt.
-Only applies with `erc-scrolltobottom-relaxed' while away from
-prompt.")
-
(defvar-local erc--scrolltobottom-window-info nil
"Alist with windows as keys and lists of window-related info as values.
Values are lists containing the last window start position and
@@ -119,28 +112,11 @@ the last \"window line\" of point. The \"window line\",
which
may be nil, is the number of lines between `window-start' and
`window-point', inclusive.")
-(defvar erc--scrolltobottom-post-force-commands
- '(beginning-of-buffer
- electric-newline-and-maybe-indent
- newline
- default-indent-new-line)
- "Commands that force a scroll after execution at prompt.
-That is, ERC recalculates the window's start instead of blindly
-restoring it.")
-
-(defvar erc--scrolltobottom-relaxed-skip-commands
- '(recenter-top-bottom scroll-down-command)
- "Commands exempt from triggering a stash and restore of `window-start'.
-Only applies with `erc-scrolltobottom-relaxed' while in the input
-area.")
-
-(defun erc--scrolltobottom-on-pre-command ()
- (when (and (eq (selected-window) (get-buffer-window))
- (>= (point) erc-input-marker))
- (setq erc--scrolltobottom-window-info
- (list (list (selected-window)
- (window-start)
- (count-screen-lines (window-start) (point-max)))))))
+;; FIXME treat `end-of-buffer' specially and always recenter -1.
+;; FIXME make this work when `erc-scrolltobottom-all' is set to
+;; `relaxed'.
+(defvar erc--scrolltobottom-post-ignore-commands '(text-scale-adjust)
+ "Commands to skip instead of force-scroll on `post-command-hook'.")
(defun erc--scrolltobottom-on-post-command ()
"Restore window start or scroll to prompt and recenter.
@@ -149,56 +125,10 @@ item is associated with the selected window, restore
start of
window so long as prompt hasn't moved. Expect buffer to be
unnarrowed."
(when (eq (selected-window) (get-buffer-window))
- (if-let (((not (input-pending-p)))
- (erc--scrolltobottom-window-info)
- (found (car erc--scrolltobottom-window-info))
- ((eq (car found) (selected-window)))
- ((not (memq this-command
- erc--scrolltobottom-post-force-commands)))
- ((= (nth 2 found)
- (count-screen-lines (window-start) (point-max)))))
- (set-window-start (selected-window) (nth 1 found))
+ (unless (memq this-command erc--scrolltobottom-post-ignore-commands)
(erc--scrolltobottom-confirm))
(setq erc--scrolltobottom-window-info nil)))
-(defun erc--scrolltobottom-on-pre-command-relaxed ()
- "Maybe scroll to bottom when away from prompt.
-When `erc-scrolltobottom-relaxed' is active, only scroll when
-prompt is past window's end and the command is `end-of-buffer' or
-`self-insert-command' (assuming `move-to-prompt' is active).
-When at prompt and current command does not appear in
-`erc--scrolltobottom-relaxed-skip-commands', stash
-`erc--scrolltobottom-window-info' for the selected window.
-Assume an unnarrowed buffer."
- (when (eq (selected-window) (get-buffer-window))
- (when (and (not (input-pending-p))
- (< (point) erc-input-marker)
- (memq this-command erc--scrolltobottom-relaxed-commands)
- (< (window-end nil t) erc-input-marker))
- (save-excursion
- (goto-char (point-max))
- (recenter (or erc-input-line-position -1))))
- (when (and (>= (point) erc-input-marker)
- (not (memq this-command
- erc--scrolltobottom-relaxed-skip-commands)))
- (setq erc--scrolltobottom-window-info
- (list (list (selected-window)
- (window-start)
- (count-screen-lines (window-start) (point-max))))))))
-
-(defun erc--scrolltobottom-on-post-command-relaxed ()
- "Set window start or scroll when data was captured on pre-command."
- (when-let (((eq (selected-window) (get-buffer-window)))
- (erc--scrolltobottom-window-info)
- (found (car erc--scrolltobottom-window-info))
- ((eq (car found) (selected-window))))
- (if (and (not (memq this-command erc--scrolltobottom-post-force-commands))
- (= (nth 2 found)
- (count-screen-lines (window-start) (point-max))))
- (set-window-start (selected-window) (nth 1 found))
- (recenter (nth 2 found)))
- (setq erc--scrolltobottom-window-info nil)))
-
;; It may be desirable to also restore the relative line position of
;; window point after changing dimensions. Perhaps stashing the
;; previous ratio of window line to body height and later recentering
@@ -240,54 +170,33 @@ function used `window-scroll-functions', which was
replaced by
(declare (obsolete erc--scrolltobottom-setup "30.1"))
(add-hook 'post-command-hook #'erc-scroll-to-bottom nil t))
-(cl-defgeneric erc--scrolltobottom-setup ()
- "Arrange for scrolling to bottom on window configuration changes.
-Undo that arrangement when disabling `erc-scrolltobottom-mode'."
+(defun erc--scrolltobottom-setup ()
+ "Perform buffer-local setup for module `scrolltobottom'."
(if erc-scrolltobottom-mode
- (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t)
- (remove-hook 'post-command-hook #'erc-scroll-to-bottom t)))
-
-(cl-defmethod erc--scrolltobottom-setup (&context
- (erc-scrolltobottom-all (eql t)))
- "Add and remove local hooks specific to `erc-scrolltobottom-all'."
- (if erc-scrolltobottom-mode
- (if erc-scrolltobottom-relaxed
+ (if erc-scrolltobottom-all
(progn
- (when (or (bound-and-true-p erc-move-to-prompt-mode)
- (memq 'move-to-prompt erc-modules))
- (cl-pushnew 'self-insert-command
- erc--scrolltobottom-relaxed-commands))
- (add-hook 'post-command-hook
- #'erc--scrolltobottom-on-post-command-relaxed 60 t)
- (add-hook 'pre-command-hook ; preempt `move-to-prompt'
- #'erc--scrolltobottom-on-pre-command-relaxed 60 t))
- (add-hook 'window-configuration-change-hook
- #'erc--scrolltobottom-at-prompt-minibuffer-active nil t)
- (add-hook 'pre-command-hook
- #'erc--scrolltobottom-on-pre-command 60 t)
- (add-hook 'post-command-hook
- #'erc--scrolltobottom-on-post-command 60 t))
+ (setq-local read-minibuffer-restore-windows nil)
+ (unless (eq erc-scrolltobottom-all 'relaxed)
+ (add-hook 'window-configuration-change-hook
+ #'erc--scrolltobottom-at-prompt-minibuffer-active 50 t)
+ (add-hook 'post-command-hook
+ #'erc--scrolltobottom-on-post-command 50 t)))
+ (add-hook 'post-command-hook #'erc-scroll-to-bottom nil t))
+ (remove-hook 'post-command-hook #'erc-scroll-to-bottom t)
+ (remove-hook 'post-command-hook #'erc--scrolltobottom-on-post-command t)
(remove-hook 'window-configuration-change-hook
#'erc--scrolltobottom-at-prompt-minibuffer-active t)
- (remove-hook 'pre-command-hook
- #'erc--scrolltobottom-on-pre-command t)
- (remove-hook 'post-command-hook
- #'erc--scrolltobottom-on-post-command t)
- (remove-hook 'pre-command-hook
- #'erc--scrolltobottom-on-pre-command-relaxed t)
- (remove-hook 'post-command-hook
- #'erc--scrolltobottom-on-post-command-relaxed t)
- (kill-local-variable 'erc--scrolltobottom-relaxed-commands)
+ (kill-local-variable 'read-minibuffer-restore-windows)
(kill-local-variable 'erc--scrolltobottom-window-info)))
(defun erc--scrolltobottom-on-pre-insert (_)
- "Remember the `window-start' before inserting a message."
+ "Remember `window-start' before inserting a message."
(setq erc--scrolltobottom-window-info
(mapcar (lambda (w)
(list w
(window-start w)
(and-let*
- ((erc-scrolltobottom-relaxed)
+ (((eq erc-scrolltobottom-all 'relaxed))
(c (count-screen-lines (window-start w)
(point-max) nil w)))
(if (= ?\n (char-before (point-max))) (1+ c) c))))
@@ -333,8 +242,8 @@ variable `erc-input-line-position'."
;;;###autoload(autoload 'erc-readonly-mode "erc-goodies" nil t)
(define-erc-module readonly nil
"This mode causes all inserted text to be read-only."
- ((add-hook 'erc-insert-post-hook #'erc-make-read-only)
- (add-hook 'erc-send-post-hook #'erc-make-read-only))
+ ((add-hook 'erc-insert-post-hook #'erc-make-read-only 70)
+ (add-hook 'erc-send-post-hook #'erc-make-read-only 70))
((remove-hook 'erc-insert-post-hook #'erc-make-read-only)
(remove-hook 'erc-send-post-hook #'erc-make-read-only)))
@@ -372,7 +281,7 @@ Put this function on `erc-insert-post-hook' and/or
`erc-send-post-hook'."
;;;###autoload(autoload 'erc-keep-place-mode "erc-goodies" nil t)
(define-erc-module keep-place nil
"Leave point above un-viewed text in other channels."
- ((add-hook 'erc-insert-pre-hook #'erc-keep-place 85))
+ ((add-hook 'erc-insert-pre-hook #'erc-keep-place 65))
((remove-hook 'erc-insert-pre-hook #'erc-keep-place)))
(defcustom erc-keep-place-indicator-style t
@@ -383,7 +292,9 @@ displays an arrow in the left fringe or margin. When it's
appropriate line. A value of t does both."
:group 'erc
:package-version '(ERC . "5.6") ; FIXME sync on release
- :type '(choice (const t) (const server) (const target)))
+ :type '(choice (const :tag "Use arrow" arrow)
+ (const :tag "Use face" face)
+ (const :tag "Use both arrow and face" t)))
(defcustom erc-keep-place-indicator-buffer-type t
"ERC buffer type in which to display `keep-place-indicator'.
@@ -467,7 +378,7 @@ and `keep-place-indicator' in different buffers."
((memq 'keep-place erc-modules)
(erc-keep-place-mode +1))
;; Enable a local version of `keep-place-mode'.
- (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t)))
+ (t (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
(if (pcase erc-keep-place-indicator-buffer-type
('target erc--target)
('server (not erc--target))
@@ -490,7 +401,7 @@ That is, ensure the local module can survive a user
toggling the
global one."
(if erc-keep-place-mode
(remove-hook 'erc-insert-pre-hook #'erc-keep-place t)
- (add-hook 'erc-insert-pre-hook #'erc-keep-place 85 t)))
+ (add-hook 'erc-insert-pre-hook #'erc-keep-place 65 t)))
(defun erc-keep-place-move (pos)
"Move keep-place indicator to current line or POS.
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index 612814ac6da..790efae97ac 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -27,6 +27,9 @@
;; needs work. Usage: Type / C-e C-h when in Ibuffer-mode to see new
;; limiting commands
+;; This library does not contain a module, but you can `require' it
+;; after loading `erc' to make use of its functionality.
+
;;; Code:
(require 'ibuffer)
@@ -118,11 +121,11 @@
(define-ibuffer-column
erc-members (:name "Users")
- (if (and (eq major-mode 'erc-mode)
- (boundp 'erc-channel-users)
- (hash-table-p erc-channel-users)
- (> (hash-table-size erc-channel-users) 0))
- (number-to-string (hash-table-size erc-channel-users))
+ (if-let ((table (or erc-channel-users erc-server-users))
+ ((hash-table-p table))
+ (count (hash-table-count table))
+ ((> count 0)))
+ (number-to-string count)
""))
(define-ibuffer-column erc-away (:name "A")
@@ -177,8 +180,7 @@
(defvar erc-ibuffer-limit-map nil
"Prefix keymap to use for ERC related limiting.")
(define-prefix-command 'erc-ibuffer-limit-map)
-;; FIXME: Where is `ibuffer-limit-by-erc-server' defined?
-(define-key 'erc-ibuffer-limit-map (kbd "s") 'ibuffer-limit-by-erc-server)
+(define-key 'erc-ibuffer-limit-map (kbd "s") #'ibuffer-filter-by-erc-server)
(define-key ibuffer-mode-map (kbd "/ \C-e") 'erc-ibuffer-limit-map)
(provide 'erc-ibuffer)
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 50db8a132ec..186717579d7 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -53,13 +53,14 @@ they are hidden or highlighted. This is controlled via the
variables
you can decide whether the entire message or only the sending nick is
highlighted."
((add-hook 'erc-insert-modify-hook #'erc-match-message 50)
- (add-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
- (unless erc--updating-modules-p
- (erc-buffer-do #'erc-match--modify-invisibility-spec))
+ (add-hook 'erc-mode-hook #'erc-match--setup)
+ (unless erc--updating-modules-p (erc-buffer-do #'erc-match--setup))
+ (add-hook 'erc-insert-post-hook #'erc-match--on-insert-post 50)
(erc--modify-local-map t "C-c C-k" #'erc-go-to-log-matches-buffer))
((remove-hook 'erc-insert-modify-hook #'erc-match-message)
- (remove-hook 'erc-mode-hook #'erc-match--modify-invisibility-spec)
- (erc-match--modify-invisibility-spec)
+ (remove-hook 'erc-insert-post-hook #'erc-match--on-insert-post)
+ (remove-hook 'erc-mode-hook #'erc-match--setup)
+ (erc-buffer-do #'erc-match--setup)
(erc--modify-local-map nil "C-c C-k" #'erc-go-to-log-matches-buffer)))
;; Remaining customizations
@@ -657,7 +658,20 @@ See `erc-log-match-format'."
(defun erc-hide-fools (match-type _nickuserhost _message)
"Hide comments from designated fools."
- (when (eq match-type 'fool)
+ (when (and erc--msg-props (eq match-type 'fool))
+ (puthash 'erc--invisible 'erc-match-fool erc--msg-props)))
+
+;; FIXME remove, make public, or only add locally.
+;;
+;; ERC modules typically don't add internal functions to public hooks
+;; globally. However, ERC 5.6 will likely include a general
+;; (internal) facility for adding invisible props, which will obviate
+;; the need for this function. IOW, leaving this internal for now is
+;; an attempt to avoid the hassle of the deprecation process.
+(defun erc-match--on-insert-post ()
+ "Hide messages marked with the `erc--invisible' prop."
+ (when (erc--check-msg-prop 'erc--invisible 'erc-match-fool)
+ (remhash 'erc--invisible erc--msg-props)
(erc--hide-message 'match-fools)))
(defun erc-beep-on-match (match-type _nickuserhost _message)
@@ -666,14 +680,13 @@ This function is meant to be called from
`erc-text-matched-hook'."
(when (member match-type erc-beep-match-types)
(beep)))
-(defun erc-match--modify-invisibility-spec ()
+(defun erc-match--setup ()
"Add an `erc-match' property to the local spec."
;; Hopefully, this will be extended to do the same for other
;; invisible properties managed by this module.
(if erc-match-mode
(erc-match-toggle-hidden-fools +1)
- (erc-with-all-buffers-of-server nil nil
- (erc-match-toggle-hidden-fools -1))))
+ (erc-match-toggle-hidden-fools -1)))
(defun erc-match-toggle-hidden-fools (arg)
"Toggle fool visibility.
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index ba7990e87d6..d73d715db2c 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -756,9 +756,8 @@ number, a list of numbers, or a list of port ranges."
Each network is a list (NET MATCHER) where
NET is a symbol naming that IRC network and
MATCHER is used to find a corresponding network to a server while
- connected to it. If it is regexp, it's used to match against
- `erc-server-announced-name'. It can also be a function (predicate).
- Then it is executed with the server buffer as current buffer."
+connected to it. If it is a regexp, it's used to match against
+`erc-server-announced-name'."
:type '(repeat
(list :tag "Network"
(symbol :tag "Network name")
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index f159b6d226f..394643c03cb 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -55,21 +55,22 @@ If nil, timestamping is turned off."
:type '(choice (const nil)
(string)))
-;; FIXME remove surrounding whitespace from default value and have
-;; `erc-insert-timestamp-left-and-right' add it before insertion.
-
(defcustom erc-timestamp-format-left "\n[%a %b %e %Y]\n"
- "If set to a string, messages will be timestamped.
-This string is processed using `format-time-string'.
-Good examples are \"%T\" and \"%H:%M\".
-
-This timestamp is used for timestamps on the left side of the
-screen when `erc-insert-timestamp-function' is set to
-`erc-insert-timestamp-left-and-right'.
-
-If nil, timestamping is turned off."
- :type '(choice (const nil)
- (string)))
+ "Format recognized by `format-time-string' for date stamps.
+Only considered when `erc-insert-timestamp-function' is set to
+`erc-insert-timestamp-left-and-right'. Used for displaying date
+stamps on their own line, between messages. ERC inserts this
+flavor of stamp as a separate \"psuedo message\", so a final
+newline isn't necessary. For compatibility, only additional
+trailing newlines beyond the first become empty lines. For
+example, the default value results in an empty line after the
+previous message, followed by the timestamp on its own line,
+followed immediately by the next message on the next line. ERC
+expects to display these stamps less frequently, so the
+formatting specifiers should reflect that. To omit these stamps
+entirely, use a different `erc-insert-timestamp-function', such
+as `erc-timestamp-format-right'."
+ :type 'string)
(defcustom erc-timestamp-format-right nil
"If set to a string, messages will be timestamped.
@@ -175,9 +176,9 @@ from entering them and instead jump over them."
;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
- ((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
- (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 60)
- (add-hook 'erc-send-modify-hook #'erc-add-timestamp 60)
+ ((add-hook 'erc-mode-hook #'erc-stamp--setup)
+ (add-hook 'erc-insert-modify-hook #'erc-add-timestamp 70)
+ (add-hook 'erc-send-modify-hook #'erc-add-timestamp 70)
(add-hook 'erc-mode-hook #'erc-stamp--recover-on-reconnect)
(add-hook 'erc--pre-clear-functions #'erc-stamp--reset-on-clear)
(unless erc--updating-modules-p (erc-buffer-do #'erc-stamp--setup)))
@@ -214,18 +215,27 @@ the stamp passed to `erc-insert-timestamp-function'.")
(cl-defgeneric erc-stamp--current-time ()
"Return a lisp time object to associate with an IRC message.
-This becomes the message's `erc-timestamp' text property."
- (let (current-time-list) (current-time)))
+This becomes the message's `erc-ts' text property."
+ (erc-compat--current-lisp-time))
(cl-defmethod erc-stamp--current-time :around ()
(or erc-stamp--current-time (cl-call-next-method)))
+(defvar erc-stamp--skip nil
+ "Non-nil means inhibit `erc-add-timestamp' completely.")
+
+(defvar erc-stamp--allow-unmanaged nil
+ "Non-nil means `erc-add-timestamp' runs unconditionally.
+Escape hatch for third-parties using lower-level API functions,
+such as `erc-display-line', directly.")
+
(defun erc-add-timestamp ()
"Add timestamp and text-properties to message.
This function is meant to be called from `erc-insert-modify-hook'
or `erc-send-modify-hook'."
- (progn ; remove this `progn' on next major refactor
+ (unless (or erc-stamp--skip (and (not erc-stamp--allow-unmanaged)
+ (null erc--msg-props)))
(let* ((ct (erc-stamp--current-time))
(invisible (get-text-property (point-min) 'invisible))
(erc-stamp--invisible-property
@@ -233,6 +243,8 @@ or `erc-send-modify-hook'."
(if invisible `(timestamp ,@(ensure-list invisible)) 'timestamp))
(skipp (and erc-stamp--skip-when-invisible invisible))
(erc-stamp--current-time ct))
+ (when erc--msg-props
+ (puthash 'erc-ts ct erc--msg-props))
(unless skipp
(funcall erc-insert-timestamp-function
(erc-format-timestamp ct erc-timestamp-format)))
@@ -244,12 +256,13 @@ or `erc-send-modify-hook'."
(erc-away-time))
(funcall erc-insert-away-timestamp-function
(erc-format-timestamp ct erc-away-timestamp-format)))
- (add-text-properties (point-min) (1- (point-max))
+ (when erc-stamp--allow-unmanaged
+ (add-text-properties (point-min) (1- (point-max))
;; It's important for the function to
;; be different on different entries (bug#22700).
(list 'cursor-sensor-functions
;; Regions are no longer contiguous ^
- '(erc--echo-ts-csf) 'erc-timestamp ct)))))
+ '(erc--echo-ts-csf) 'erc-ts ct))))))
(defvar-local erc-timestamp-last-window-width nil
"The width of the last window that showed the current buffer.
@@ -260,9 +273,11 @@ buffer is not shown in any window.")
"Last timestamp inserted into the buffer.")
(defvar-local erc-timestamp-last-inserted-left nil
- "Last timestamp inserted into the left side of the buffer.
-This is used when `erc-insert-timestamp-function' is set to
-`erc-timestamp-left-and-right'")
+ "Last \"date stamp\" inserted into the left side of the buffer.
+Used when `erc-insert-timestamp-function' is set to
+`erc-timestamp-left-and-right'. If the format string specified
+by `erc-timestamp-format-left' includes trailing newlines, this
+value omits the last one.")
(defvar-local erc-timestamp-last-inserted-right nil
"Last timestamp inserted into the right side of the buffer.
@@ -362,19 +377,27 @@ non-nil."
(goto-char (point-min))
(while
(progn
- (when-let* (((< (point) (pos-eol)))
- (end (1- (pos-eol)))
- ((eq 'erc-timestamp (field-at-pos end)))
- (beg (field-beginning end))
- ;; Skip a line that's just a timestamp.
- ((> beg (point))))
+ (when-let (((< (point) (pos-eol)))
+ (end (1- (pos-eol)))
+ ((eq 'erc-timestamp (field-at-pos end)))
+ (beg (field-beginning end))
+ ;; Skip a line that's just a timestamp.
+ ((> beg (point))))
(delete-region beg (1+ end)))
- (when-let (time (get-text-property (point) 'erc-timestamp))
+ (when-let (time (erc--get-inserted-msg-prop 'erc-ts))
(insert (format-time-string "[%H:%M:%S] " time)))
(zerop (forward-line))))
"")
-(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix))
+;; These are currently extended manually, but we could also bind
+;; `text-property-default-nonsticky' and call `insert-and-inherit'
+;; instead of `insert', but we'd have to pair the props with differing
+;; boolean values for left and right stamps. Also, since this hook
+;; runs last, we can't expect overriding sticky props to be absent,
+;; even though, as of 5.6, `front-sticky' is only added by the
+;; `readonly' module after hooks run.
+(defvar erc-stamp--inherited-props '(line-prefix wrap-prefix)
+ "Extant properties at the start of a message inherited by the stamp.")
(declare-function erc--remove-text-properties "erc" (string))
@@ -573,8 +596,11 @@ printed just after each line's text (no alignment)."
;; intervening white space unless a hard break is warranted.
(pcase erc-timestamp-use-align-to
((guard erc-stamp--display-margin-mode)
- (put-text-property 0 (length string)
- 'display `((margin right-margin) ,string) string))
+ (let ((s (propertize (substring-no-properties string)
+ 'invisible erc-stamp--invisible-property)))
+ (put-text-property 0 (length string) 'display
+ `((margin right-margin) ,s)
+ string)))
((and 't (guard (< col pos)))
(insert " ")
(put-text-property from (point) 'display `(space :align-to ,pos)))
@@ -599,30 +625,94 @@ printed just after each line's text (no alignment)."
(when erc-timestamp-intangible
(erc-put-text-property from (1+ (point)) 'cursor-intangible t)))))
-(defvar erc-stamp--insert-date-function #'insert
- "Function to insert left \"left-right date\" stamp.
-A local module might use this to modify text properties,
-`insert-before-markers' or renarrow the region after insertion.")
+(defvar erc-stamp--insert-date-hook nil
+ "Functions appended to send and modify hooks when inserting date stamp.")
+
+(defvar-local erc-stamp--date-format-end nil
+ "Substring index marking usable portion of date stamp format.")
+
+(defun erc-stamp--propertize-left-date-stamp ()
+ (add-text-properties (point-min) (1- (point-max))
+ '(field erc-timestamp erc-stamp-type date-left))
+ (erc--hide-message 'timestamp))
+
+;; A kludge to pass state from insert hook to nested insert hook.
+(defvar erc-stamp--current-datestamp-left nil)
+
+(defun erc-stamp--format-date-stamp (ct)
+ "Format left date stamp with `erc-timestamp-format-left'."
+ (unless erc-stamp--date-format-end
+ ;; Don't add text properties to the trailing newline.
+ (setq erc-stamp--date-format-end
+ (if (string-suffix-p "\n" erc-timestamp-format-left) -1 0)))
+ ;; Ignore existing `invisible' prop value because date stamps should
+ ;; never be hideable except via `timestamp'.
+ (let (erc-stamp--invisible-property)
+ (erc-format-timestamp ct (substring erc-timestamp-format-left
+ 0 erc-stamp--date-format-end))))
+
+;; Calling `erc-display-message' from within a hook it's currently
+;; running is roundabout, but it's a definite means of ensuring hooks
+;; can act on the date stamp as a standalone message to do things like
+;; adjust invisibility props.
+(defun erc-stamp--insert-date-stamp-as-phony-message (string)
+ (cl-assert (string-empty-p string))
+ (setq string erc-stamp--current-datestamp-left)
+ (cl-assert string)
+ (let ((erc-stamp--skip t)
+ (erc--msg-props (map-into `((erc-msg . datestamp)
+ (erc-ts . ,erc-stamp--current-time))
+ 'hash-table))
+ (erc-send-modify-hook `(,@erc-send-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook))
+ (erc-insert-modify-hook `(,@erc-insert-modify-hook
+ erc-stamp--propertize-left-date-stamp
+ ,@erc-stamp--insert-date-hook)))
+ (erc-display-message nil nil (current-buffer) string)
+ (setq erc-timestamp-last-inserted-left string)))
+
+(defun erc-stamp--lr-date-on-pre-modify (_)
+ (when-let ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
+ (rendered (erc-stamp--format-date-stamp ct))
+ ((not (string-equal rendered erc-timestamp-last-inserted-left)))
+ (erc-stamp--current-datestamp-left rendered)
+ (erc-insert-timestamp-function
+ #'erc-stamp--insert-date-stamp-as-phony-message))
+ (save-restriction
+ (narrow-to-region (or erc--insert-marker erc-insert-marker)
+ (or erc--insert-marker erc-insert-marker))
+ (let (erc-timestamp-format erc-away-timestamp-format)
+ (erc-add-timestamp)))))
(defun erc-insert-timestamp-left-and-right (string)
"Insert a stamp on either side when it changes.
When the deprecated option `erc-timestamp-format-right' is nil,
use STRING, which originates from `erc-timestamp-format', for the
-right-hand stamp. Use `erc-timestamp-format-left' for the
-left-hand stamp and expect it to change less frequently."
+right-hand stamp. Use `erc-timestamp-format-left' for formatting
+the left-sided \"date stamp,\" and expect it to change less
+frequently. Include all but the final trailing newline present
+in the latter (if any) as part of the `erc-timestamp' field.
+Allow the stamp's `invisible' property to span that same interval
+but also cover the previous newline, in order to satisfy folding
+requirements related to `erc-legacy-invisible-bounds-p'.
+Additionally, ensure every date stamp is identifiable as such so
+that internal modules can easily distinguish between other
+left-sided stamps and date stamps inserted by this function."
+ (unless erc-stamp--date-format-end
+ (add-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (add-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify -95 t)
+ (let ((erc--insert-marker (point-min-marker)))
+ (set-marker-insertion-type erc--insert-marker t)
+ (erc-stamp--lr-date-on-pre-modify nil)
+ (narrow-to-region erc--insert-marker (point-max))
+ (set-marker erc--insert-marker nil)))
(let* ((ct (or erc-stamp--current-time (erc-stamp--current-time)))
- (ts-left (erc-format-timestamp ct erc-timestamp-format-left))
(ts-right (with-suppressed-warnings
((obsolete erc-timestamp-format-right))
(if erc-timestamp-format-right
(erc-format-timestamp ct erc-timestamp-format-right)
string))))
- ;; insert left timestamp
- (unless (string-equal ts-left erc-timestamp-last-inserted-left)
- (goto-char (point-min))
- (erc-put-text-property 0 (length ts-left) 'field 'erc-timestamp ts-left)
- (funcall erc-stamp--insert-date-function ts-left)
- (setq erc-timestamp-last-inserted-left ts-left))
;; insert right timestamp
(let ((erc-timestamp-only-if-changed-flag t)
(erc-timestamp-last-inserted erc-timestamp-last-inserted-right))
@@ -639,8 +729,9 @@ Return the empty string if FORMAT is nil."
(let ((ts (format-time-string format time erc-stamp--tz)))
(erc-put-text-property 0 (length ts)
'font-lock-face 'erc-timestamp-face ts)
- (erc-put-text-property 0 (length ts) 'invisible
- erc-stamp--invisible-property ts)
+ (when erc-stamp--invisible-property
+ (erc-put-text-property 0 (length ts) 'invisible
+ erc-stamp--invisible-property ts))
;; N.B. Later use categories instead of this harmless, but
;; inelegant, hack. -- BPT
(and erc-timestamp-intangible
@@ -649,6 +740,8 @@ Return the empty string if FORMAT is nil."
ts)
""))
+(defvar-local erc-stamp--csf-props-updated-p nil)
+
;; This function is used to munge `buffer-invisibility-spec' to an
;; appropriate value. Currently, it only handles timestamps, thus its
;; location. If you add other features which affect invisibility,
@@ -661,10 +754,23 @@ Return the empty string if FORMAT is nil."
(cursor-intangible-mode -1)))
(if erc-echo-timestamps
(progn
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (add-hook hook #'erc-stamp--add-csf-on-post-modify nil t))
+ (erc--restore-initialize-priors erc-stamp-mode
+ erc-stamp--csf-props-updated-p nil)
+ (unless (or erc-stamp--allow-unmanaged erc-stamp--csf-props-updated-p)
+ (setq erc-stamp--csf-props-updated-p t)
+ (let ((erc--msg-props (map-into '((erc-ts . t)) 'hash-table)))
+ (with-silent-modifications
+ (erc--traverse-inserted (point-min) erc-insert-marker
+ #'erc-stamp--add-csf-on-post-modify))))
(cursor-sensor-mode +1) ; idempotent
(when (>= emacs-major-version 29)
(add-function :before-until (local 'clear-message-function)
#'erc-stamp--on-clear-message)))
+ (dolist (hook '(erc-insert-post-hook erc-send-post-hook))
+ (remove-hook hook #'erc-stamp--add-csf-on-post-modify t))
+ (kill-local-variable 'erc-stamp--csf-props-updated-p)
(when (bound-and-true-p cursor-sensor-mode)
(cursor-sensor-mode -1))
(remove-function (local 'clear-message-function)
@@ -673,12 +779,22 @@ Return the empty string if FORMAT is nil."
(add-to-invisibility-spec 'timestamp)
(remove-from-invisibility-spec 'timestamp)))
+(defun erc-stamp--add-csf-on-post-modify ()
+ "Add `cursor-sensor-functions' to narrowed buffer."
+ (when (erc--check-msg-prop 'erc-ts)
+ (put-text-property (point-min) (1- (point-max))
+ 'cursor-sensor-functions '(erc--echo-ts-csf))))
+
(defun erc-stamp--setup ()
"Enable or disable buffer-local `erc-stamp-mode' modifications."
(if erc-stamp-mode
(erc-munge-invisibility-spec)
(let (erc-echo-timestamps erc-hide-timestamps erc-timestamp-intangible)
- (erc-munge-invisibility-spec))))
+ (erc-munge-invisibility-spec))
+ ;; Undo local mods from `erc-insert-timestamp-left-and-right'.
+ (remove-hook 'erc-insert-pre-hook #'erc-stamp--lr-date-on-pre-modify t)
+ (remove-hook 'erc-send-pre-functions #'erc-stamp--lr-date-on-pre-modify t)
+ (kill-local-variable 'erc-stamp--date-format-end)))
(defun erc-hide-timestamps ()
"Hide timestamp information from display."
@@ -714,7 +830,7 @@ enabled when the message was inserted."
(defun erc-stamp--on-clear-message (&rest _)
"Return `dont-clear-message' when operating inside the same stamp."
(and erc-stamp--last-stamp erc-echo-timestamps
- (eq (get-text-property (point) 'erc-timestamp) erc-stamp--last-stamp)
+ (eq (erc--get-inserted-msg-prop 'erc-ts) erc-stamp--last-stamp)
'dont-clear-message))
(defun erc-echo-timestamp (dir stamp &optional zone)
@@ -724,7 +840,7 @@ hours (or seconds, if its abs value is larger than 14), and
interpret a \"raw\" prefix as UTC. To specify a zone for use
with the option `erc-echo-timestamps', see the companion option
`erc-echo-timestamp-zone'."
- (interactive (list nil (get-text-property (point) 'erc-timestamp)
+ (interactive (list nil (erc--get-inserted-msg-prop 'erc-ts)
(pcase current-prefix-arg
((and (pred numberp) v)
(if (<= (abs v) 14) (* v 3600) v))
@@ -738,18 +854,18 @@ with the option `erc-echo-timestamps', see the companion
option
(setq erc-stamp--last-stamp nil))))
(defun erc--echo-ts-csf (_window _before dir)
- (erc-echo-timestamp dir (get-text-property (point) 'erc-timestamp)))
+ (erc-echo-timestamp dir (erc--get-inserted-msg-prop 'erc-ts)))
(defun erc-stamp--update-saved-position (&rest _)
- (remove-function (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
- (move-marker erc-last-saved-position (1- (point))))
+ (remove-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position t)
+ (move-marker erc-last-saved-position (1- (point-max))))
(defun erc-stamp--reset-on-clear (pos)
"Forget last-inserted stamps when POS is at insert marker."
(when (= pos (1- erc-insert-marker))
- (add-function :after (local 'erc-stamp--insert-date-function)
- #'erc-stamp--update-saved-position)
+ (add-hook 'erc-stamp--insert-date-hook
+ #'erc-stamp--update-saved-position 0 t)
(setq erc-timestamp-last-inserted nil
erc-timestamp-last-inserted-left nil
erc-timestamp-last-inserted-right nil)))
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 48d8408a85a..3350cbd13b7 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -102,7 +102,7 @@ present in `erc-modules'."
;; Truncate at message boundary (formerly line boundary
;; before 5.6).
(goto-char end)
- (goto-char (or (previous-single-property-change (point) 'erc-command)
+ (goto-char (or (erc--get-inserted-msg-bounds 'beg)
(pos-bol)))
(setq end (point))
;; try to save the current buffer using
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8b7f4c2cfa5..5bf6496e926 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -135,9 +135,11 @@ concerning buffers."
"Running scripts at startup and with /LOAD."
:group 'erc)
-;; Forward declarations
-(defvar erc-message-parsed)
+(defvar erc-message-parsed) ; only known to this file
+(defvar erc--msg-props nil)
+(defvar erc--msg-prop-overrides nil)
+;; Forward declarations
(defvar tabbar--local-hlf)
(defvar motif-version-string)
(defvar gtk-version-string)
@@ -252,7 +254,14 @@ node `(auth) Top' and Info node `(erc) auth-source'.")
:type 'boolean)
(defcustom erc-warn-about-blank-lines t
- "Warn the user if they attempt to send a blank line."
+ "Warn the user if they attempt to send a blank line.
+When non-nil, ERC signals a `user-error' upon encountering prompt
+input containing empty or whitespace-only lines. When nil, ERC
+still inhibits sending but does so silently. With the companion
+option `erc-send-whitespace-lines' enabled, ERC sends pending
+input and prints a message in the echo area indicating the amount
+of padding and/or stripping applied, if any. Setting this option
+to nil suppresses such reporting."
:group 'erc
:type 'boolean)
@@ -264,8 +273,8 @@ node `(auth) Top' and Info node `(erc) auth-source'.")
(defcustom erc-inhibit-multiline-input nil
"When non-nil, conditionally disallow input consisting of multiple lines.
Issue an error when the number of input lines submitted for
-sending exceeds this value. The value t means disallow more
-than 1 line of input."
+sending meets or exceeds this value. The value t is synonymous
+with a value of 2 and means disallow more than 1 line of input."
:package-version '(ERC . "5.5")
:group 'erc
:type '(choice integer boolean))
@@ -1095,9 +1104,10 @@ subprotocols should probably be handled manually."
(define-obsolete-variable-alias 'erc--pre-send-split-functions
'erc--input-review-functions "30.1")
-(defvar erc--input-review-functions '(erc--discard-trailing-multiline-nulls
- erc--split-lines
- erc--run-input-validation-checks)
+(defvar erc--input-review-functions '(erc--split-lines
+ erc--run-input-validation-checks
+ erc--discard-trailing-multiline-nulls
+ erc--inhibit-slash-cmd-insertion)
"Special hook for reviewing and modifying prompt input.
ERC runs this before clearing the prompt and before running any
send-related hooks, such as `erc-pre-send-functions'. Thus, it's
@@ -1131,9 +1141,13 @@ if they wish to avoid sending of a particular string.")
"Insertion hook for functions that will change the text's appearance.
This hook is called just after `erc-insert-pre-hook' when the value
of `erc-insert-this' is t.
-While this hook is run, narrowing is in effect and `current-buffer' is
-the buffer where the text got inserted. One possible value to add here
-is `erc-fill'."
+
+ERC runs this hook with the buffer narrowed to the bounds of the
+inserted message plus a trailing newline. Built-in modules place
+their hook members at depths between 20 and 80, with those from
+the stamp module always running last. Use the functions
+`erc-find-parsed-property' and `erc-get-parsed-vector' to locate
+and extract the `erc-response' object for the inserted message."
:group 'erc-hooks
:type 'hook)
@@ -1358,16 +1372,15 @@ buffer during local-module setup and `erc-mode-hook'
activation.")
(defmacro erc--restore-initialize-priors (mode &rest vars)
"Restore local VARS for MODE from a previous session."
(declare (indent 1))
- (let ((existing (make-symbol "existing"))
+ (let ((priors (make-symbol "priors"))
+ (initp (make-symbol "initp"))
;;
- restore initialize)
- (while-let ((k (pop vars)) (v (pop vars)))
- (push `(,k (alist-get ',k ,existing)) restore)
- (push `(,k ,v) initialize))
- `(if-let* ((,existing (or erc--server-reconnecting erc--target-priors))
- ((alist-get ',mode ,existing)))
- (setq ,@(mapcan #'identity (nreverse restore)))
- (setq ,@(mapcan #'identity (nreverse initialize))))))
+ forms)
+ (while-let ((k (pop vars)))
+ (push `(,k (if ,initp (alist-get ',k ,priors) ,(pop vars))) forms))
+ `(let* ((,priors (or erc--server-reconnecting erc--target-priors))
+ (,initp (and ,priors (alist-get ',mode ,priors))))
+ (setq ,@(mapcan #'identity (nreverse forms))))))
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
@@ -1997,6 +2010,14 @@ buffer rather than a server buffer.")
;; each item is in the format '(old . new)
(delete-dups (mapcar #'erc--normalize-module-symbol mods)))
+(defun erc--sort-modules (modules)
+ "Return a copy of MODULES, deduped and led by sorted built-ins."
+ (let (built-in third-party)
+ (dolist (mod modules)
+ (setq mod (erc--normalize-module-symbol mod))
+ (cl-pushnew mod (if (get mod 'erc--module) built-in third-party)))
+ `(,@(sort built-in #'string-lessp) ,@(nreverse third-party))))
+
(defcustom erc-modules '( autojoin button completion fill imenu irccontrols
list match menu move-to-prompt netsplit
networks noncommands readonly ring stamp track)
@@ -2032,16 +2053,10 @@ removed from the list will be disabled."
(when (symbol-value f)
(funcall f 0))
(kill-local-variable f)))))))))
- (let (built-in third-party)
- (dolist (v val)
- (setq v (erc--normalize-module-symbol v))
- (if (get v 'erc--module)
- (push v built-in)
- (push v third-party)))
- ;; Calling `set-default-toplevel-value' complicates testing
- (set sym (append (sort built-in #'string-lessp)
- (nreverse third-party))))
+ ;; Calling `set-default-toplevel-value' complicates testing.
+ (set sym (erc--sort-modules val))
;; this test is for the case where erc hasn't been loaded yet
+ ;; FIXME explain how this ^ can occur or remove comment.
(when (fboundp 'erc-update-modules)
(unless erc--inside-mode-toggle-p
(erc-update-modules))))
@@ -2105,15 +2120,29 @@ removed from the list will be disabled."
(defun erc-update-modules ()
"Enable minor mode for every module in `erc-modules'.
Except ignore all local modules, which were introduced in ERC 5.5."
- (erc--update-modules)
+ (erc--update-modules erc-modules)
nil)
+(defvar erc--aberrant-modules nil
+ "Modules suspected of being improperly loaded.")
+
+(defun erc--warn-about-aberrant-modules ()
+ (when (and erc--aberrant-modules (not erc--target))
+ (erc-button--display-error-notice-with-keys-and-warn
+ "The following modules exhibited strange loading behavior: "
+ (mapconcat (lambda (s) (format "`%s'" s)) erc--aberrant-modules ", ")
+ ". Please contact ERC with \\[erc-bug] if you believe this to be untrue."
+ " See Info:\"(erc) Module Loading\" for more.")
+ (setq erc--aberrant-modules nil)))
+
(defun erc--find-mode (sym)
(setq sym (erc--normalize-module-symbol sym))
- (if-let* ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
- ((or (boundp mode)
- (and (fboundp mode)
- (autoload-do-load (symbol-function mode) mode)))))
+ (if-let ((mode (intern-soft (concat "erc-" (symbol-name sym) "-mode")))
+ ((and (fboundp mode)
+ (autoload-do-load (symbol-function mode) mode)))
+ ((or (get sym 'erc--module)
+ (symbol-file mode)
+ (ignore (cl-pushnew sym erc--aberrant-modules)))))
mode
(and (require (or (get sym 'erc--feature)
(intern (concat "erc-" (symbol-name sym))))
@@ -2122,9 +2151,9 @@ Except ignore all local modules, which were introduced in
ERC 5.5."
(fboundp mode)
mode)))
-(defun erc--update-modules ()
+(defun erc--update-modules (modules)
(let (local-modes)
- (dolist (module erc-modules local-modes)
+ (dolist (module modules local-modes)
(if-let ((mode (erc--find-mode module)))
(if (custom-variable-p mode)
(funcall mode 1)
@@ -2151,7 +2180,7 @@ realizes it's missing some required module \"foo\", it can
confidently call (erc-foo-mode 1) without having to learn
anything about the dependency's implementation.")
-(defvar erc--setup-buffer-hook nil
+(defvar erc--setup-buffer-hook '(erc--warn-about-aberrant-modules)
"Internal hook for module setup involving windows and frames.")
(defvar erc--display-context nil
@@ -2308,7 +2337,8 @@ Returns the buffer for the given server or channel."
(setq old-point (point))
(setq delayed-modules
(erc--merge-local-modes (let ((erc--updating-modules-p t))
- (erc--update-modules))
+ (erc--update-modules
+ (erc--sort-modules erc-modules)))
(or erc--server-reconnecting
erc--target-priors)))
@@ -2847,11 +2877,10 @@ If ARG is non-nil, show the *erc-protocol* buffer."
(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)
- (let ((erc-insert-pre-hook
- (cons (lambda (s) ; Leave newline be.
- (put-text-property 0 (1- (length s)) 'erc-command 'PRIVMSG s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp 'ACTION s))
- erc-insert-pre-hook))
+ ;; Allow hooks that act on inserted PRIVMSG and NOTICES to process us.
+ (let ((erc--msg-prop-overrides '((erc-msg . msg)
+ (erc-cmd . PRIVMSG)
+ (erc-ctcp . ACTION)))
(nick (erc-current-nick)))
(setq nick (propertize nick 'erc-speaker nick))
(erc-display-message nil '(t action input) (current-buffer)
@@ -2869,9 +2898,18 @@ I.e. any char in it has the `invisible' property set."
The default is to remove it, since it causes ERC to take up extra
memory. If you have code that relies on this property, then set
-this option to nil."
+this option to nil.
+
+Note that this option is deprecated because a value of nil is
+impractical in prolonged sessions with more than a few channels.
+Use `erc-insert-post-hook' or similar and the helper function
+`erc-find-parsed-property' and friends to stash the current
+`erc-response' object as needed. And instead of using this for
+debugging purposes, try `erc-debug-irc-protocol'."
:type 'boolean
:group 'erc)
+(make-obsolete-variable 'erc-remove-parsed-property
+ "impractical when non-nil" "30.1")
(define-inline erc--assert-input-bounds ()
(inline-quote
@@ -2901,6 +2939,70 @@ this option to nil."
(delete-region (point) (1- erc-input-marker))))
(run-hooks 'erc--refresh-prompt-hook)))
+(defun erc--check-msg-prop (prop &optional val)
+ "Return PROP's value in `erc--msg-props' when populated.
+If VAL is a list, return non-nil if PROP appears in VAL. If VAL
+is otherwise non-nil, return non-nil if VAL compares `eq' to the
+stored value. Otherwise, return the stored value."
+ (and-let* ((erc--msg-props)
+ (v (gethash prop erc--msg-props)))
+ (if (consp val) (memq v val) (if val (eq v val) v))))
+
+(defmacro erc--get-inserted-msg-bounds (&optional only point)
+ "Return the bounds of a message in an ERC buffer.
+Return ONLY one side when the first arg is `end' or `beg'. With
+POINT, search from POINT instead of `point'."
+ `(let* ((point ,(or point '(point)))
+ (at-start-p (get-text-property point 'erc-msg)))
+ (and-let*
+ (,@(and (member only '(nil 'beg))
+ '((b (or (and at-start-p point)
+ (and-let*
+ ((p (previous-single-property-change point
+ 'erc-msg)))
+ (if (= p (1- point)) point (1- p)))))))
+ ,@(and (member only '(nil 'end))
+ '((e (1- (next-single-property-change
+ (if at-start-p (1+ point) point)
+ 'erc-msg nil erc-insert-marker))))))
+ ,(pcase only
+ ('(quote beg) 'b)
+ ('(quote end) 'e)
+ (_ '(cons b e))))))
+
+(defun erc--get-inserted-msg-prop (prop)
+ "Return the value of text property PROP for some message at point."
+ (and-let* ((stack-pos (erc--get-inserted-msg-bounds 'beg)))
+ (get-text-property stack-pos prop)))
+
+(defmacro erc--with-inserted-msg (&rest body)
+ "Simulate narrowing performed for send and insert hooks, and run BODY.
+Expect callers to know that this doesn't wrap BODY in
+`with-silent-modifications' or bind a temporary `erc--msg-props'."
+ `(when-let ((bounds (erc--get-inserted-msg-bounds)))
+ (save-restriction
+ (narrow-to-region (car bounds) (1+ (cdr bounds)))
+ ,@body)))
+
+(defun erc--traverse-inserted (beg end fn)
+ "Visit messages between BEG and END and run FN in narrowed buffer."
+ (setq end (min end (marker-position erc-insert-marker)))
+ (save-excursion
+ (goto-char beg)
+ (let ((b (if (get-text-property (point) 'erc-msg)
+ (point)
+ (next-single-property-change (point) 'erc-msg nil end))))
+ (while-let ((b)
+ ((< b end))
+ (e (next-single-property-change (1+ b) 'erc-msg nil end)))
+ (save-restriction
+ (narrow-to-region b e)
+ (funcall fn))
+ (setq b e)))))
+
+(defvar erc--insert-marker nil
+ "Internal override for `erc-insert-marker'.")
+
(defun erc-display-line-1 (string buffer)
"Display STRING in `erc-mode' BUFFER.
Auxiliary function used in `erc-display-line'. The line gets filtered to
@@ -2924,6 +3026,8 @@ If STRING is nil, the function does nothing."
(format "%s" buffer)))
(setq erc-insert-this t)
(run-hook-with-args 'erc-insert-pre-hook string)
+ (setq insert-position (marker-position (or erc--insert-marker
+ erc-insert-marker)))
(if (null erc-insert-this)
;; Leave erc-insert-this set to t as much as possible. Fran
;; Litterio <franl> has seen erc-insert-this set to nil while
@@ -2943,10 +3047,17 @@ If STRING is nil, the function does nothing."
(run-hooks 'erc-insert-post-hook)
(when erc-remove-parsed-property
(remove-text-properties (point-min) (point-max)
- '(erc-parsed nil))))
+ '(erc-parsed nil tags nil)))
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (let ((props (if erc--msg-props
+ (erc--order-text-properties-from-hash
+ erc--msg-props)
+ '(erc-msg unknown))))
+ (add-text-properties (point-min) (1+ (point-min)) props)))
(erc--refresh-prompt)))))
(run-hooks 'erc-insert-done-hook)
- (erc-update-undo-list (- (or (marker-position erc-insert-marker)
+ (erc-update-undo-list (- (or (marker-position (or erc--insert-marker
+ erc-insert-marker))
(point-max))
insert-position))))))
@@ -3040,6 +3151,30 @@ value. See also `erc-button-add-face'."
old (get-text-property pos prop object)
end (next-single-property-change pos prop object to)))))
+(defun erc--remove-from-prop-value-list (from to prop val &optional object)
+ "Remove VAL from text prop value between FROM and TO.
+If current value is VAL itself, remove the property entirely.
+When VAL is a list, act as if this function were called
+repeatedly with VAL set to each of VAL's members."
+ (let ((old (get-text-property from prop object))
+ (pos from)
+ (end (next-single-property-change from prop object to))
+ new)
+ (while (< pos to)
+ (when old
+ (if (setq new (and (consp old) (if (consp val)
+ (seq-difference old val)
+ (remq val old))))
+ (put-text-property pos end prop
+ (if (cdr new) new (car new)) object)
+ (when (pcase val
+ ((pred consp) (or (consp old) (memq old val)))
+ (_ (if (consp old) (memq val old) (eq old val))))
+ (remove-text-properties pos end (list prop nil) object))))
+ (setq pos end
+ old (get-text-property pos prop object)
+ end (next-single-property-change pos prop object to)))))
+
(defvar erc-legacy-invisible-bounds-p nil
"Whether to hide trailing rather than preceding newlines.
Beginning in ERC 5.6, invisibility extends from a message's
@@ -3049,7 +3184,11 @@ preceding newline to its last non-newline character.")
(defun erc--hide-message (value)
"Apply `invisible' text-property with VALUE to current message.
-Expect to run in a narrowed buffer during message insertion."
+Expect to run in a narrowed buffer during message insertion.
+Begin the invisible interval at the previous message's trailing
+newline and end before the current message's. If the preceding
+message ends in a double newline or there is no previous message,
+don't bother including the preceding newline."
(if erc-legacy-invisible-bounds-p
;; Before ERC 5.6, this also used to add an `intangible'
;; property, but the docs say it's now obsolete.
@@ -3058,8 +3197,25 @@ Expect to run in a narrowed buffer during message
insertion."
(end (point-max)))
(save-restriction
(widen)
+ (when (or (<= beg 4) (= ?\n (char-before (- beg 2))))
+ (cl-incf beg))
(erc--merge-prop (1- beg) (1- end) 'invisible value)))))
+(defvar erc--ranked-properties '(erc-msg erc-ts erc-cmd))
+
+(defun erc--order-text-properties-from-hash (table)
+ "Return a plist of text props from items in TABLE.
+Ensure props in `erc--ranked-properties' appear last and in
+reverse order so they end up sorted in buffer interval plists for
+retrieval by `text-properties-at' and friends."
+ (let (out)
+ (dolist (k erc--ranked-properties)
+ (when-let ((v (gethash k table)))
+ (remhash k table)
+ (setq out (nconc (list k v) out))))
+ (maphash (lambda (k v) (setq out (nconc (list k v) out))) table)
+ out))
+
(defun erc-display-message-highlight (type string)
"Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
@@ -3273,23 +3429,52 @@ returns non-nil."
(defun erc-display-message (parsed type buffer msg &rest args)
"Display MSG in BUFFER.
-ARGS, PARSED, and TYPE are used to format MSG sensibly.
+Insert MSG or text derived from MSG into an ERC buffer, possibly
+after applying formatting by way of either a `format-spec' known
+to a message-catalog entry or a TYPE known to a specialized
+string handler. Additionally, derive internal metadata, faces,
+and other text properties from the various overloaded parameters,
+such as PARSED, when it's an `erc-response' object, and MSG, when
+it's a key (symbol) for a \"message catalog\" entry. Expect
+ARGS, when applicable, to be `format-spec' args known to such an
+entry, and TYPE, when non-nil, to be a symbol handled by
+`erc-display-message-highlight' (necessarily accompanied by a
+string MSG).
When TYPE is a list of symbols, call handlers from left to right
without influencing how they behave when encountering existing
faces. As of ERC 5.6, expect a TYPE of (notice error) to insert
MSG with `font-lock-face' as `erc-error-face' throughout.
However, when the list of symbols begins with t, tell compatible
-handlers to compose rather than clobber faces. For example, as
-of ERC 5.6, expect a TYPE of (t notice error) to result in MSG's
-`font-lock-face' being (erc-error-face erc-notice-face)
-throughout when `erc-notice-highlight-type' is set to its default
-`all'.
-
-See also `erc-format-message' and `erc-display-line'."
+handlers to compose rather than clobber faces. For example,
+expect a TYPE of (t notice error) to result in `font-lock-face'
+being (erc-error-face erc-notice-face) throughout MSG when
+`erc-notice-highlight-type' is left at its default, `all'.
+
+As of ERC 5.6, assume user code will use this function instead of
+`erc-display-line' when it's important that insert hooks treat
+MSG in a manner befitting messages received from a server. That
+is, expect to process most nontrivial informational messages, for
+which PARSED is typically nil, when the caller desires
+buttonizing and other effects."
(let ((string (if (symbolp msg)
(apply #'erc-format-message msg args)
msg))
+ (erc--msg-props
+ (or erc--msg-props
+ (let* ((table (make-hash-table :size 5))
+ (cmd (and parsed (erc--get-eq-comparable-cmd
+ (erc-response.command parsed))))
+ (m (cond ((and msg (symbolp msg)) msg)
+ ((and cmd (memq cmd '(PRIVMSG NOTICE)) 'msg))
+ (t 'unknown))))
+ (puthash 'erc-msg m table)
+ (when cmd
+ (puthash 'erc-cmd cmd table))
+ (and erc--msg-prop-overrides
+ (pcase-dolist (`(,k . ,v) erc--msg-prop-overrides)
+ (puthash k v table)))
+ table)))
(erc-message-parsed parsed))
(setq string
(cond
@@ -3308,9 +3493,6 @@ See also `erc-format-message' and `erc-display-line'."
(erc-display-line string buffer)
(unless (erc-hide-current-message-p parsed)
(erc-put-text-property 0 (length string) 'erc-parsed parsed string)
- (put-text-property
- 0 (length string) 'erc-command
- (erc--get-eq-comparable-cmd (erc-response.command parsed)) string)
(when (erc-response.tags parsed)
(erc-put-text-property 0 (length string) 'tags (erc-response.tags
parsed)
string))
@@ -3579,16 +3761,14 @@ If no USER argument is specified, list the contents of
`erc-ignore-list'."
(run-at-time timeout nil
(lambda ()
(erc--unignore-user user buffer))))
- (erc-display-line
- (erc-make-notice (format "Now ignoring %s" user))
- 'active)
+ (erc-display-message nil 'notice 'active
+ (format "Now ignoring %s" user))
(erc-with-server-buffer (add-to-list 'erc-ignore-list user))))
(if (null (erc-with-server-buffer erc-ignore-list))
- (erc-display-line (erc-make-notice "Ignore list is empty") 'active)
- (erc-display-line (erc-make-notice "Ignore list:") 'active)
+ (erc-display-message nil 'notice 'active "Ignore list is empty")
+ (erc-display-message nil 'notice 'active "Ignore list:")
(mapc (lambda (item)
- (erc-display-line (erc-make-notice item)
- 'active))
+ (erc-display-message nil 'notice 'active item))
(erc-with-server-buffer erc-ignore-list))))
t)
@@ -3602,9 +3782,8 @@ If no USER argument is specified, list the contents of
`erc-ignore-list'."
(unless (y-or-n-p (format "Remove this regexp (%s)? "
ignored-nick))
(setq ignored-nick nil))
- (erc-display-line
- (erc-make-notice (format "%s is not currently ignored!" user))
- 'active)))
+ (erc-display-message nil 'notice 'active
+ (format "%s is not currently ignored!" user))))
(when ignored-nick
(erc--unignore-user user (current-buffer))))
t)
@@ -3612,9 +3791,8 @@ If no USER argument is specified, list the contents of
`erc-ignore-list'."
(defun erc--unignore-user (user buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
- (erc-display-line
- (erc-make-notice (format "No longer ignoring %s" user))
- 'active)
+ (erc-display-message nil 'notice 'active
+ (format "No longer ignoring %s" user))
(erc-with-server-buffer
(setq erc-ignore-list (delete user erc-ignore-list))))))
@@ -4099,12 +4277,10 @@ See `erc-cmd-WHOIS' for more details."
(string-to-number
(cl-third
(erc-response.command-args parsed)))))
- (erc-display-line
- (erc-make-notice
+ (erc-display-message nil 'notice origbuf
(format "%s has been idle for %s."
(erc-string-no-properties nick)
(erc-seconds-to-string idleseconds)))
- origbuf)
t)))
'erc-server-317-functions)
symlist)
@@ -4653,8 +4829,7 @@ The ban list is fetched from the server if necessary."
(cond
((not (erc-channel-p chnl))
- (erc-display-line (erc-make-notice "You're not on a channel\n")
- 'active))
+ (erc-display-message nil 'notice 'active "You're not on a channel\n"))
((not (get 'erc-channel-banlist 'received-from-server))
(let ((old-367-hook erc-server-367-functions))
@@ -4673,9 +4848,8 @@ The ban list is fetched from the server if necessary."
(erc-server-send (format "MODE %s b" chnl)))))
((null erc-channel-banlist)
- (erc-display-line (erc-make-notice
- (format "No bans for channel: %s\n" chnl))
- 'active)
+ (erc-display-message nil 'notice 'active
+ (format "No bans for channel: %s\n" chnl))
(put 'erc-channel-banlist 'received-from-server nil))
(t
@@ -4689,10 +4863,9 @@ The ban list is fetched from the server if necessary."
"%-" (number-to-string (/ erc-fill-column 2)) "s"
"%" (number-to-string (/ erc-fill-column 2)) "s")))
- (erc-display-line
- (erc-make-notice (format "Ban list for channel: %s\n"
- (erc-default-target)))
- 'active)
+ (erc-display-message
+ nil 'notice 'active
+ (format "Ban list for channel: %s\n" (erc-default-target)))
(erc-display-line separator 'active)
(erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
@@ -4709,8 +4882,7 @@ The ban list is fetched from the server if necessary."
'active))
erc-channel-banlist)
- (erc-display-line (erc-make-notice "End of Ban list")
- 'active)
+ (erc-display-message nil 'notice 'active "End of Ban list")
(put 'erc-channel-banlist 'received-from-server nil)))))
t)
@@ -4724,9 +4896,7 @@ Unban all currently banned users in the current channel."
(cond
((not (erc-channel-p chnl))
- (erc-display-line
- (erc-make-notice "You're not on a channel\n")
- 'active))
+ (erc-display-message nil 'notice 'active "You're not on a channel\n"))
((not (get 'erc-channel-banlist 'received-from-server))
(let ((old-367-hook erc-server-367-functions))
@@ -4773,6 +4943,7 @@ Eventually add a # in front of it, if that turns it into
a valid channel name."
rear-nonsticky erc-prompt field front-sticky read-only
;; stamp
cursor-intangible cursor-sensor-functions isearch-open-invisible
+ erc-stamp-type
;; match
invisible intangible
;; button
@@ -5255,15 +5426,13 @@ and as second argument the event parsed as a vector."
(and (erc-is-message-ctcp-p message)
(not (string-match "^\C-aACTION.*\C-a$" message))))
-(define-inline erc--get-speaker-bounds ()
- "Return the bounds of `erc-speaker' property when present.
+(defun erc--get-speaker-bounds ()
+ "Return the bounds of `erc-speaker' text property when present.
Assume buffer is narrowed to the confines of an inserted message."
- (inline-quote
- (and-let*
- (((memq (get-text-property (point) 'erc-command) '(PRIVMSG NOTICE)))
- (beg (or (and (get-text-property (point-min) 'erc-speaker) (point-min))
- (next-single-property-change (point-min) 'erc-speaker))))
- (cons beg (next-single-property-change beg 'erc-speaker)))))
+ (and-let* (((erc--check-msg-prop 'erc-msg 'msg))
+ (beg (text-property-not-all (point-min) (point-max)
+ 'erc-speaker nil)))
+ (cons beg (next-single-property-change beg 'erc-speaker))))
(defvar erc--cmem-from-nick-function #'erc--cmem-get-existing
"Function maybe returning a \"channel member\" cons from a nick.
@@ -5585,11 +5754,8 @@ See also `erc-display-message'."
(while queries
(let* ((type (upcase (car (split-string (car queries)))))
(hook (intern-soft (concat "erc-ctcp-query-" type "-hook")))
- (erc-insert-pre-hook
- (cons (lambda (s)
- (put-text-property 0 (1- (length s)) 'erc-ctcp
- (intern type) s))
- erc-insert-pre-hook)))
+ (erc--msg-prop-overrides `((erc-msg . msg)
+ (erc-ctcp . ,(intern type)))))
(if (and hook (boundp hook))
(if (string-equal type "ACTION")
(run-hook-with-args-until-success
@@ -6424,20 +6590,6 @@ holds off on submitting it, for obvious reasons."
(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
"Regular expression used for matching commands in ERC.")
-(defun erc--blank-in-multiline-input-p (lines)
- "Detect whether LINES contains a blank line.
-When `erc-send-whitespace-lines' is in effect, return nil if
-LINES is multiline or the first line is non-empty. When
-`erc-send-whitespace-lines' is nil, return non-nil when any line
-is empty or consists of one or more spaces, tabs, or form-feeds."
- (catch 'return
- (let ((multilinep (cdr lines)))
- (dolist (line lines)
- (when (if erc-send-whitespace-lines
- (and (string-empty-p line) (not multilinep))
- (string-match (rx bot (* (in " \t\f")) eot) line))
- (throw 'return t))))))
-
(defun erc--check-prompt-input-for-excess-lines (_ lines)
"Return non-nil when trying to send too many LINES."
(when erc-inhibit-multiline-input
@@ -6457,13 +6609,78 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
(y-or-n-p (concat "Send input " msg "?")))
(concat "Too many lines " msg))))))
-(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
- "Return non-nil when multiline prompt input has blank LINES."
- (when (erc--blank-in-multiline-input-p lines)
+(defun erc--check-prompt-input-for-something (string _)
+ (when (string-empty-p string)
(if erc-warn-about-blank-lines
"Blank line - ignoring..."
'invalid)))
+(defun erc--count-blank-lines (lines)
+ "Report on the number of whitespace-only and empty LINES.
+Return a list of (BLANKS TO-PAD TO-STRIP). Expect caller to know
+that BLANKS includes non-empty whitespace-only lines and that no
+padding or stripping has yet occurred."
+ (let ((real 0) (total 0) (pad 0) (strip 0))
+ (dolist (line lines)
+ (if (string-match (rx bot (* (in " \t\f")) eot) line)
+ (progn
+ (cl-incf total)
+ (if (zerop (match-end 0))
+ (cl-incf strip)
+ (cl-incf pad strip)
+ (setq strip 0)))
+ (cl-incf real)
+ (unless (zerop strip)
+ (cl-incf pad strip)
+ (setq strip 0))))
+ (when (and (zerop real) (not (zerop total)) (= total (+ pad strip)))
+ (cl-incf strip (1- pad))
+ (setq pad 1))
+ (list total pad strip)))
+
+(defvar erc--check-prompt-explanation nil
+ "List of strings to print if no validator returns non-nil.")
+
+(defun erc--check-prompt-input-for-multiline-blanks (_ lines)
+ "Return non-nil when multiline prompt input has blank LINES.
+Consider newlines to be intervening delimiters, meaning the empty
+\"logical\" line between a trailing newline and `eob' constitutes
+a separate message."
+ (pcase-let ((`(,total ,pad ,strip)(erc--count-blank-lines lines)))
+ (cond ((zerop total) nil)
+ ((and erc-warn-about-blank-lines erc-send-whitespace-lines)
+ (let (msg args)
+ (unless (zerop strip)
+ (push "stripping (%d)" msg)
+ (push strip args))
+ (unless (zerop pad)
+ (when msg
+ (push "and" msg))
+ (push "padding (%d)" msg)
+ (push pad args))
+ (when msg
+ (push "blank" msg)
+ (push (if (> (apply #'+ args) 1) "lines" "line") msg))
+ (when msg
+ (setf msg (nreverse msg)
+ (car msg) (capitalize (car msg))))
+ (when msg
+ (push (apply #'format (string-join msg " ") (nreverse args))
+ erc--check-prompt-explanation)
+ nil)))
+ (erc-warn-about-blank-lines
+ (concat (if (= total 1)
+ (if (zerop strip) "Blank" "Trailing")
+ (if (= total strip)
+ (format "%d trailing" strip)
+ (format "%d blank" total)))
+ (and (> total 1) (/= total strip) (not (zerop strip))
+ (format " (%d trailing)" strip))
+ (if (= total 1) " line" " lines")
+ " detected (see `erc-send-whitespace-lines')"))
+ (erc-send-whitespace-lines nil)
+ (t 'invalid))))
+
(defun erc--check-prompt-input-for-point-in-bounds (_ _)
"Return non-nil when point is before prompt."
(when (< (point) (erc-beg-of-input-line))
@@ -6484,25 +6701,39 @@ is empty or consists of one or more spaces, tabs, or
form-feeds."
(defvar erc--check-prompt-input-functions
'(erc--check-prompt-input-for-point-in-bounds
+ erc--check-prompt-input-for-something
+ erc--check-prompt-input-for-multiline-command
erc--check-prompt-input-for-multiline-blanks
erc--check-prompt-input-for-running-process
- erc--check-prompt-input-for-excess-lines
- erc--check-prompt-input-for-multiline-command)
+ erc--check-prompt-input-for-excess-lines)
"Validators for user input typed at prompt.
-Called with latest input string submitted by user and the list of
-lines produced by splitting it. If any member function returns
-non-nil, processing is abandoned and input is left untouched.
-When the returned value is a string, ERC passes it to `erc-error'.")
+Called with two arguments: the current input submitted by the
+user, as a string, along with the same input as a list of
+strings. If any member function returns non-nil, ERC abandons
+processing and leaves pending input untouched in the prompt area.
+When the returned value is a string, ERC passes it to
+`user-error'. Any other non-nil value tells ERC to abort
+silently. If all members return nil, and the variable
+`erc--check-prompt-explanation' is a nonempty list of strings,
+ERC prints them as a single message joined by newlines.")
(defun erc--run-input-validation-checks (state)
"Run input checkers from STATE, an `erc--input-split' object."
- (when-let ((msg (run-hook-with-args-until-success
- 'erc--check-prompt-input-functions
- (erc--input-split-string state)
- (erc--input-split-lines state))))
- (unless (stringp msg)
- (setq msg (format "Input error: %S" msg)))
- (user-error msg)))
+ (let* ((erc--check-prompt-explanation nil)
+ (msg (run-hook-with-args-until-success
+ 'erc--check-prompt-input-functions
+ (erc--input-split-string state)
+ (erc--input-split-lines state))))
+ (cond ((stringp msg) (user-error msg))
+ (msg (push msg (erc--input-split-abortp state)))
+ (erc--check-prompt-explanation
+ (message "%s" (string-join (nreverse erc--check-prompt-explanation)
+ "\n"))))))
+
+(defun erc--inhibit-slash-cmd-insertion (state)
+ "Don't insert STATE object's message if it's a \"slash\" command."
+ (when (erc--input-split-cmdp state)
+ (setf (erc--input-split-insertp state) nil)))
(defun erc-send-current-line ()
"Parse current line and send it to IRC."
@@ -6526,9 +6757,11 @@ When the returned value is a string, ERC passes it to
`erc-error'.")
str erc--input-line-delim-regexp)
:cmdp (string-match erc-command-regexp str))))
(run-hook-with-args 'erc--input-review-functions state)
- (let ((inhibit-read-only t)
- (old-buf (current-buffer)))
- (progn ; unprogn this during next major surgery
+ (when-let (((not (erc--input-split-abortp state)))
+ (inhibit-read-only t)
+ (old-buf (current-buffer)))
+ (let ((erc--msg-prop-overrides '((erc-cmd . PRIVMSG)
+ (erc-msg . msg))))
(erc-set-active-buffer (current-buffer))
;; Kill the input and the prompt
(delete-region erc-input-marker (erc-end-of-input-line))
@@ -6556,12 +6789,11 @@ When the returned value is a string, ERC passes it to
`erc-error'.")
(erc-end-of-input-line)))
(defun erc--discard-trailing-multiline-nulls (state)
- "Ensure last line of STATE's string is non-null.
-But only when `erc-send-whitespace-lines' is non-nil. STATE is
-an `erc--input-split' object."
- (when (and erc-send-whitespace-lines (erc--input-split-lines state))
+ "Remove trailing empty lines from STATE, an `erc--input-split' object.
+When all lines are empty, remove all but the first."
+ (when (erc--input-split-lines state)
(let ((reversed (nreverse (erc--input-split-lines state))))
- (while (and reversed (string-empty-p (car reversed)))
+ (while (and (cdr reversed) (string-empty-p (car reversed)))
(setq reversed (cdr reversed)))
(setf (erc--input-split-lines state) (nreverse reversed)))))
@@ -6581,7 +6813,7 @@ multiline input. Optionally readjust lines to protocol
length
limits and pad empty ones, knowing full well that additional
processing may still corrupt messages before they reach the send
queue. Expect LINES-OBJ to be an `erc--input-split' object."
- (when (or erc-send-pre-hook erc-pre-send-functions)
+ (progn ; FIXME remove `progn' after code review.
(with-suppressed-warnings ((lexical str) (obsolete erc-send-this))
(defvar str) ; see note in string `erc-send-input'.
(let* ((str (string-join (erc--input-split-lines lines-obj) "\n"))
@@ -6612,9 +6844,8 @@ queue. Expect LINES-OBJ to be an `erc--input-split'
object."
"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))
- (unless (erc--input-split-cmdp lines-obj)
- (when (erc--input-split-insertp lines-obj)
- (erc-display-msg line)))
+ (when (erc--input-split-insertp lines-obj)
+ (erc-display-msg line))
(erc-process-input-line (concat line "\n")
(null erc-flood-protect)
(not (erc--input-split-cmdp lines-obj))))))
@@ -6677,17 +6908,24 @@ Return non-nil only if we actually send anything."
(save-excursion
(erc--assert-input-bounds)
(let ((insert-position (marker-position (goto-char erc-insert-marker)))
+ (erc--msg-props (or erc--msg-props
+ (map-into (cons '(erc-msg . self)
+ erc--msg-prop-overrides)
+ 'hash-table)))
beg)
(insert (erc-format-my-nick))
(setq beg (point))
(insert line)
(erc-put-text-property beg (point) 'font-lock-face 'erc-input-face)
- (erc-put-text-property insert-position (point) 'erc-command 'PRIVMSG)
(insert "\n")
(save-restriction
(narrow-to-region insert-position (point))
(run-hooks 'erc-send-modify-hook)
- (run-hooks 'erc-send-post-hook))
+ (run-hooks 'erc-send-post-hook)
+ (cl-assert (> (- (point-max) (point-min)) 1))
+ (add-text-properties (point-min) (1+ (point-min))
+ (erc--order-text-properties-from-hash
+ erc--msg-props)))
(erc--refresh-prompt)))))
(defun erc-command-symbol (command)
@@ -8075,8 +8313,8 @@ This function should be on `erc-kill-channel-hook'."
(text-property-not-all (point-min) (point-max) 'erc-parsed nil))
(defun erc-restore-text-properties ()
- "Restore the property `erc-parsed' for the region."
- (when-let* ((parsed-posn (erc-find-parsed-property))
+ "Ensure the `erc-parsed' and `tags' props cover the entire message."
+ (when-let ((parsed-posn (erc-find-parsed-property))
(found (erc-get-parsed-vector parsed-posn)))
(put-text-property (point-min) (point-max) 'erc-parsed found)
(when-let ((tags (get-text-property parsed-posn 'tags)))
@@ -8105,7 +8343,7 @@ This function should be on `erc-kill-channel-hook'."
See also `erc-message-type'."
;; IRC numerics are three-digit numbers, possibly with leading 0s.
;; To invert: (if (numberp o) (format "%03d" o) (symbol-name o))
- (if-let* ((n (string-to-number command)) ((zerop n))) (intern command) n))
+ (if-let ((n (string-to-number command)) ((zerop n))) (intern command) n))
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 25dccbd695c..61f1237b907 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -343,7 +343,7 @@ to writing a completion function."
(defun eshell-complete-parse-arguments ()
"Parse the command line arguments for `pcomplete-argument'."
(when (and eshell-no-completion-during-jobs
- (eshell-interactive-process-p))
+ eshell-foreground-command)
(eshell--pcomplete-insert-tab))
(let ((end (point-marker))
(begin (save-excursion (beginning-of-line) (point)))
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index 9f6f720b8b0..3a4c315ad15 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -94,7 +94,12 @@ Comments begin with `#'."
(setq cmd `(eshell-as-subcommand ,cmd)))
(throw 'eshell-replace-command
`(let ((eshell-command-name ',file)
- (eshell-command-arguments ',args))
+ (eshell-command-arguments ',args)
+ ;; Don't print subjob messages by default.
+ ;; Otherwise, if this function was called as a
+ ;; subjob, then *all* commands in the script would
+ ;; print start/stop messages.
+ (eshell-subjob-messages nil))
,cmd))))
(defun eshell/source (&rest args)
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index d5002a59d14..4c39a991ec6 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -294,7 +294,7 @@ and the end of the buffer are still visible."
((eq this-command 'self-insert-command)
(if (eq last-command-event ? )
(if (and eshell-smart-space-goes-to-end
- eshell-current-command)
+ eshell-foreground-command)
(if (not (pos-visible-in-window-p (point-max)))
(setq this-command 'scroll-up)
(setq this-command 'eshell-smart-goto-end))
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 1d828bd7f82..990d2ca1122 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -263,7 +263,24 @@ command line.")
;;; Internal Variables:
-(defvar eshell-current-command nil)
+;; These variables have been merged into `eshell-foreground-command'.
+;; Outside of this file, the most-common use for them is to check
+;; whether they're nil.
+(define-obsolete-variable-alias 'eshell-last-async-procs
+ 'eshell-foreground-command "30.1")
+(define-obsolete-variable-alias 'eshell-current-command
+ 'eshell-foreground-command "30.1")
+
+(defvar eshell-foreground-command nil
+ "The currently-running foreground command, if any.
+This is a list of the form (FORM PROCESSES). FORM is the Eshell
+command form. PROCESSES is a list of processes that deferred the
+command.")
+(defvar eshell-background-commands nil
+ "A list of currently-running deferred commands.
+Each element is of the form (FORM PROCESSES), as with
+`eshell-foreground-command' (which see).")
+
(defvar eshell-command-name nil)
(defvar eshell-command-arguments nil)
(defvar eshell-in-pipeline-p nil
@@ -273,11 +290,6 @@ otherwise t.")
(defvar eshell-in-subcommand-p nil)
(defvar eshell-last-arguments nil)
(defvar eshell-last-command-name nil)
-(defvar eshell-last-async-procs nil
- "The currently-running foreground process(es).
-When executing a pipeline, this is a list of all the pipeline's
-processes, with the first usually reading from stdin and last
-usually writing to stdout.")
(defvar eshell-allow-commands t
"If non-nil, allow evaluating command forms (including Lisp forms).
@@ -294,29 +306,30 @@ also `eshell-complete-parse-arguments'.")
(defsubst eshell-interactive-process-p ()
"Return non-nil if there is a currently running command process."
- eshell-last-async-procs)
+ (declare (obsolete 'eshell-foreground-command "30.1"))
+ eshell-foreground-command)
(defsubst eshell-head-process ()
"Return the currently running process at the head of any pipeline.
This only returns external (non-Lisp) processes."
- (car eshell-last-async-procs))
+ (caadr eshell-foreground-command))
(defsubst eshell-tail-process ()
"Return the currently running process at the tail of any pipeline.
This only returns external (non-Lisp) processes."
- (car (last eshell-last-async-procs)))
+ (car (last (cadr eshell-foreground-command))))
(define-obsolete-function-alias 'eshell-interactive-process
'eshell-tail-process "29.1")
(defun eshell-cmd-initialize () ;Called from `eshell-mode' via intern-soft!
"Initialize the Eshell command processing module."
- (setq-local eshell-current-command nil)
+ (setq-local eshell-foreground-command nil)
+ (setq-local eshell-background-commands nil)
(setq-local eshell-command-name nil)
(setq-local eshell-command-arguments nil)
(setq-local eshell-last-arguments nil)
(setq-local eshell-last-command-name nil)
- (setq-local eshell-last-async-procs nil)
(add-hook 'eshell-kill-hook #'eshell-resume-command nil t)
(add-hook 'eshell-parse-argument-hook
@@ -337,6 +350,47 @@ This only returns external (non-Lisp) processes."
(throw 'pcomplete-completions
(all-completions pcomplete-stub obarray 'boundp)))))
+;; Current command management
+
+(defun eshell-add-command (form &optional background)
+ "Add a command FORM to our list of known commands and return the new entry.
+If non-nil, BACKGROUND indicates that this is a command running
+in the background. The result is a command entry in the
+form (BACKGROUND FORM PROCESSES), where PROCESSES is initially
+nil."
+ (cons (when background 'background)
+ (if background
+ (car (push (list form nil) eshell-background-commands))
+ (cl-assert (null eshell-foreground-command))
+ (setq eshell-foreground-command (list form nil)))))
+
+(defun eshell-remove-command (command)
+ "Remove COMMAND from our list of known commands.
+COMMAND should be a list of the form (BACKGROUND FORM PROCESSES),
+as returned by `eshell-add-command' (which see)."
+ (let ((background (car command))
+ (entry (cdr command)))
+ (if background
+ (setq eshell-background-commands
+ (delq entry eshell-background-commands))
+ (cl-assert (eq eshell-foreground-command entry))
+ (setq eshell-foreground-command nil))))
+
+(defun eshell-commands-for-process (process)
+ "Return all commands associated with a PROCESS.
+Each element will have the form (BACKGROUND FORM PROCESSES), as
+returned by `eshell-add-command' (which see).
+
+Usually, there should only be one element in this list, but it's
+theoretically possible to have more than one associated command
+for a given process."
+ (nconc (when (memq process (cadr eshell-foreground-command))
+ (list (cons nil eshell-foreground-command)))
+ (seq-keep (lambda (cmd)
+ (when (memq process (cadr cmd))
+ (cons 'background cmd)))
+ eshell-background-commands)))
+
;; Command parsing
(defsubst eshell--region-p (object)
@@ -407,8 +461,6 @@ command hooks should be run before and after the command."
(lambda (cmd)
(let ((sep (pop sep-terms)))
(setq cmd (eshell-parse-pipeline cmd))
- (when (equal sep "&")
- (setq cmd `(eshell-do-subjob (cons :eshell-background ,cmd))))
(unless eshell-in-pipeline-p
(setq cmd `(eshell-trap-errors ,cmd)))
;; Copy I/O handles so each full statement can manipulate
@@ -416,6 +468,8 @@ command hooks should be run before and after the command."
;; command in the list; we won't use the originals again
;; anyway.
(setq cmd `(eshell-with-copied-handles ,cmd ,(not sep)))
+ (when (equal sep "&")
+ (setq cmd `(eshell-do-subjob ,cmd)))
cmd))
sub-chains)))
(if toplevel
@@ -740,10 +794,13 @@ if none)."
(defmacro eshell-do-subjob (object)
"Evaluate a command OBJECT as a subjob.
-We indicate that the process was run in the background by returning it
-ensconced in a list."
- `(let ((eshell-current-subjob-p t))
- ,object))
+We indicate that the process was run in the background by
+returning it as (:eshell-background . PROCESSES)."
+ `(let ((eshell-current-subjob-p t)
+ ;; Print subjob messages. This could have been cleared
+ ;; (e.g. by `eshell-source-file', which see).
+ (eshell-subjob-messages t))
+ (eshell-resume-eval (eshell-add-command ',object 'background))))
(defmacro eshell-commands (object &optional silent)
"Place a valid set of handles, and context, around command OBJECT."
@@ -977,12 +1034,12 @@ Return the process (or head and tail processes) created
by
COMMAND, if any. If COMMAND is a background command, return the
process(es) in a cons cell like:
- (:eshell-background . PROCESS)"
- (if eshell-current-command
+ (:eshell-background . PROCESSES)"
+ (if eshell-foreground-command
(progn
;; We can just stick the new command at the end of the current
;; one, and everything will happen as it should.
- (setcdr (last (cdr eshell-current-command))
+ (setcdr (last (cdar eshell-foreground-command))
(list `(let ((here (and (eobp) (point))))
,(and input
`(insert-and-inherit ,(concat input "\n")))
@@ -991,56 +1048,61 @@ process(es) in a cons cell like:
(eshell-do-eval ',command))))
(eshell-debug-command 'form
"enqueued command form for %S\n\n%s"
- (or input "<no string>") (eshell-stringify eshell-current-command)))
+ (or input "<no string>")
+ (eshell-stringify (car eshell-foreground-command))))
(eshell-debug-command-start input)
- (setq eshell-current-command command)
(let* (result
(delim (catch 'eshell-incomplete
- (ignore (setq result (eshell-resume-eval))))))
+ (ignore (setq result (eshell-resume-eval
+ (eshell-add-command command)))))))
(when delim
(error "Unmatched delimiter: %S" delim))
result)))
(defun eshell-resume-command (proc status)
- "Resume the current command when a pipeline ends."
- (when (and proc
- ;; Make sure PROC is one of our foreground processes and
- ;; that all of those processes are now dead.
- (member proc eshell-last-async-procs)
- (not (seq-some #'eshell-process-active-p
eshell-last-async-procs)))
- (if (and ;; Check STATUS to determine whether we want to resume or
- ;; abort the command.
- (stringp status)
- (not (string= "stopped" status))
- (not (string-match eshell-reset-signals status)))
- (eshell-resume-eval)
- (setq eshell-last-async-procs nil)
- (setq eshell-current-command nil)
- (declare-function eshell-reset "esh-mode" (&optional no-hooks))
- (eshell-reset))))
-
-(defun eshell-resume-eval ()
- "Destructively evaluate a form which may need to be deferred."
- (setq eshell-last-async-procs nil)
- (when eshell-current-command
- (eshell-condition-case err
- (let (retval procs)
- (unwind-protect
- (progn
- (setq procs (catch 'eshell-defer
- (ignore (setq retval
- (eshell-do-eval
- eshell-current-command)))))
- (when retval
- (cadr retval)))
- (setq eshell-last-async-procs procs)
+ "Resume the current command when a pipeline ends.
+PROC is the process that invoked this from its sentinel, and
+STATUS is its status."
+ (when proc
+ (dolist (command (eshell-commands-for-process proc))
+ (unless (seq-some #'eshell-process-active-p (nth 2 command))
+ (setf (nth 2 command) nil) ; Clear processes from command.
+ (if (and ;; Check STATUS to determine whether we want to resume or
+ ;; abort the command.
+ (stringp status)
+ (not (string= "stopped" status))
+ (not (string-match eshell-reset-signals status)))
+ (eshell-resume-eval command)
+ (eshell-remove-command command)
+ (declare-function eshell-reset "esh-mode" (&optional no-hooks))
+ (eshell-reset))))))
+
+(defun eshell-resume-eval (command)
+ "Destructively evaluate a COMMAND which may need to be deferred.
+COMMAND is a command entry of the form (BACKGROUND FORM
+PROCESSES) (see `eshell-add-command').
+
+Return the result of COMMAND's FORM if it wasn't deferred. If
+BACKGROUND is non-nil and Eshell defers COMMAND, return a list of
+the form (:eshell-background . PROCESSES)."
+ (eshell-condition-case err
+ (let (retval procs)
+ (unwind-protect
+ (progn
+ (setq procs
+ (catch 'eshell-defer
+ (ignore (setq retval (eshell-do-eval (cadr command))))))
+ (cond
+ (retval (cadr retval))
+ ((car command) (cons :eshell-background procs))))
+ (if procs
+ (setf (nth 2 command) procs)
;; If we didn't defer this command, clear it out. This
;; applies both when the command has finished normally,
;; and when a signal or thrown value causes us to unwind.
- (unless procs
- (setq eshell-current-command nil))))
- (error
- (error (error-message-string err))))))
+ (eshell-remove-command command))))
+ (error
+ (error (error-message-string err)))))
(defmacro eshell-manipulate (form tag &rest body)
"Manipulate a command FORM with BODY, using TAG as a debug identifier."
@@ -1269,7 +1331,6 @@ have been replaced by constants."
(setcdr form (cdr new-form)))
(eshell-do-eval form synchronous-p))
(if-let (((memq (car form) eshell-deferrable-commands))
- ((not eshell-current-subjob-p))
(procs (eshell-make-process-list result)))
(if synchronous-p
(apply #'eshell/wait procs)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 0c381dbb86a..9d2cd1e67eb 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -361,6 +361,9 @@ and the hook `eshell-exit-hook'."
(setq-local eshell-last-output-end (point-marker))
(setq-local eshell-last-output-block-begin (point))
+ (add-function :filter-return (local 'filter-buffer-substring-function)
+ #'eshell--unmark-string-as-output)
+
(let ((modules-list (copy-sequence eshell-modules-list)))
(setq-local eshell-modules-list modules-list))
@@ -453,7 +456,7 @@ and the hook `eshell-exit-hook'."
last-command-event))))
(defun eshell-intercept-commands ()
- (when (and (eshell-interactive-process-p)
+ (when (and eshell-foreground-command
(not (and (integerp last-input-event)
(memq last-input-event '(?\C-x ?\C-c)))))
(let ((possible-events (where-is-internal this-command))
@@ -967,7 +970,7 @@ buffer's process if STRING contains a password prompt
defined by
`eshell-password-prompt-regexp'.
This function could be in the list `eshell-output-filter-functions'."
- (when (eshell-interactive-process-p)
+ (when eshell-foreground-command
(save-excursion
(let ((case-fold-search t))
(goto-char eshell-last-output-block-begin)
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index d15e1e7d09b..bc3776259a7 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -100,6 +100,8 @@ information, for example."
(defvar eshell-supports-asynchronous-processes (fboundp 'make-process)
"Non-nil if Eshell can create asynchronous processes.")
+(defvar eshell-subjob-messages t
+ "Non-nil if we should print process start/end messages for subjobs.")
(defvar eshell-current-subjob-p nil)
(defvar eshell-process-list nil
@@ -111,6 +113,7 @@ subjob.
To add or remove elements of this list, see
`eshell-record-process-object' and `eshell-remove-process-entry'.")
+(declare-function eshell-reset "esh-mode" (&optional no-hooks))
(declare-function eshell-send-eof-to-process "esh-mode")
(declare-function eshell-interactive-filter "esh-mode" (buffer string))
(declare-function eshell-tail-process "esh-cmd")
@@ -148,16 +151,8 @@ PROC and STATUS to functions on the latter."
(make-local-variable 'eshell-process-list)
(eshell-proc-mode))
-(defun eshell-reset-after-proc (status)
- "Reset the command input location after a process terminates.
-The signals which will cause this to happen are matched by
-`eshell-reset-signals'."
- (declare (obsolete nil "30.1"))
- (when (and (stringp status)
- (string-match eshell-reset-signals status))
- (require 'esh-mode)
- (declare-function eshell-reset "esh-mode" (&optional no-hooks))
- (eshell-reset)))
+(define-obsolete-function-alias 'eshell-reset-after-proc
+ 'eshell--reset-after-signal "30.1")
(defun eshell-process-active-p (process)
"Return non-nil if PROCESS is active.
@@ -243,8 +238,9 @@ The prompt will be set to PROMPT."
(defsubst eshell-record-process-object (object)
"Record OBJECT as now running."
- (when (and (eshell-processp object)
- eshell-current-subjob-p)
+ (when (and eshell-subjob-messages
+ eshell-current-subjob-p
+ (eshell-processp object))
(require 'esh-mode)
(declare-function eshell-interactive-print "esh-mode" (string))
(eshell-interactive-print
@@ -253,11 +249,12 @@ The prompt will be set to PROMPT."
(defun eshell-remove-process-entry (entry)
"Record the process ENTRY as fully completed."
- (if (and (eshell-processp (car entry))
- (cdr entry)
- eshell-done-messages-in-minibuffer)
- (message "[%s]+ Done %s" (process-name (car entry))
- (process-command (car entry))))
+ (when (and eshell-subjob-messages
+ eshell-done-messages-in-minibuffer
+ (eshell-processp (car entry))
+ (cdr entry))
+ (message "[%s]+ Done %s" (process-name (car entry))
+ (process-command (car entry))))
(setq eshell-process-list
(delq entry eshell-process-list)))
@@ -645,29 +642,41 @@ See the variable `eshell-kill-processes-on-exit'."
(kill-buffer buf)))
(message nil))))
+(defun eshell--reset-after-signal (status)
+ "Reset the prompt after a signal when necessary.
+STATUS is the status associated with the signal; if
+`eshell-reset-signals' matches status, reset the prompt.
+
+This is really only useful when \"signaling\" while there's no
+foreground process. Otherwise, `eshell-resume-command' handles
+everything."
+ (when (and (stringp status)
+ (string-match eshell-reset-signals status))
+ (eshell-reset)))
+
(defun eshell-interrupt-process ()
"Interrupt a process."
(interactive)
(unless (eshell-process-interact 'interrupt-process)
- (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
+ (eshell--reset-after-signal "interrupt\n")))
(defun eshell-kill-process ()
"Kill a process."
(interactive)
(unless (eshell-process-interact 'kill-process)
- (run-hook-with-args 'eshell-kill-hook nil "killed")))
+ (eshell--reset-after-signal "killed\n")))
(defun eshell-quit-process ()
"Send quit signal to process."
(interactive)
(unless (eshell-process-interact 'quit-process)
- (run-hook-with-args 'eshell-kill-hook nil "quit")))
+ (eshell--reset-after-signal "quit\n")))
;(defun eshell-stop-process ()
; "Send STOP signal to process."
; (interactive)
; (unless (eshell-process-interact 'stop-process)
-; (run-hook-with-args 'eshell-kill-hook nil "stopped")))
+; (eshell--reset-after-signal "stopped\n")))
;(defun eshell-continue-process ()
; "Send CONTINUE signal to process."
@@ -676,7 +685,7 @@ See the variable `eshell-kill-processes-on-exit'."
; ;; jww (1999-09-17): this signal is not dealt with yet. For
; ;; example, `eshell-reset' will be called, and so will
; ;; `eshell-resume-eval'.
-; (run-hook-with-args 'eshell-kill-hook nil "continue")))
+; (eshell--reset-after-signal "continue\n")))
(provide 'esh-proc)
;;; esh-proc.el ends here
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 4c251a29269..ca2f775318a 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -234,6 +234,14 @@ current buffer."
(eshell--mark-as-output start1 end1)))))
(add-hook 'after-change-functions hook nil t)))
+(defun eshell--unmark-string-as-output (string)
+ "Unmark STRING as Eshell output."
+ (remove-list-of-text-properties
+ 0 (length string)
+ '(rear-nonsticky front-sticky field insert-in-front-hooks)
+ string)
+ string)
+
(defun eshell-find-delimiter
(open close &optional bound reverse-p backslash-p)
"From point, find the CLOSE delimiter corresponding to OPEN.
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index a3f80f453eb..8765ba499a1 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -315,9 +315,8 @@ argument), then insert output into the current buffer at
point."
;; make the output as attractive as possible, with no
;; extraneous newlines
(when intr
- (if (eshell-interactive-process-p)
- (eshell-wait-for-process (eshell-tail-process)))
- (cl-assert (not (eshell-interactive-process-p)))
+ (apply #'eshell-wait-for-process (cadr eshell-foreground-command))
+ (cl-assert (not eshell-foreground-command))
(goto-char (point-max))
(while (and (bolp) (not (bobp)))
(delete-char -1)))
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index e9f8d4e515d..03bd4e51485 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -138,7 +138,7 @@ It is nil or a `file-notify--rename' defstruct where the
cookie can be nil.")
((memq action '(delete delete-self move-self))
'deleted)
((eq action 'moved-from) 'renamed-from)
((eq action 'moved-to) 'renamed-to)
- ((eq action 'ignored) 'stopped)))
+ ((memq action '(ignored unmount)) 'stopped)))
actions))
file file1-or-cookie))
@@ -153,7 +153,8 @@ It is nil or a `file-notify--rename' defstruct where the
cookie can be nil.")
((eq action 'write) 'changed)
((memq action '(attrib link)) 'attribute-changed)
((eq action 'delete) 'deleted)
- ((eq action 'rename) 'renamed)))
+ ((eq action 'rename) 'renamed)
+ ((eq action 'revoke) 'stopped)))
actions))
file file1-or-cookie))
@@ -179,7 +180,8 @@ It is nil or a `file-notify--rename' defstruct where the
cookie can be nil.")
((memq action
'(created changed attribute-changed deleted))
action)
- ((eq action 'moved) 'renamed)))
+ ((eq action 'moved) 'renamed)
+ ((eq action 'unmounted) 'stopped)))
(if (consp actions) actions (list actions))))
file file1-or-cookie))
@@ -195,6 +197,7 @@ It is nil or a `file-notify--rename' defstruct where the
cookie can be nil.")
((memq action '(created changed attribute-changed deleted))
action)
((eq action 'moved) 'renamed)
+ ((eq action 'unmounted) 'stopped)
;; inotify actions:
((eq action 'create) 'created)
((eq action 'modify) 'changed)
@@ -202,7 +205,7 @@ It is nil or a `file-notify--rename' defstruct where the
cookie can be nil.")
((memq action '(delete delete-self move-self)) 'deleted)
((eq action 'moved-from) 'renamed-from)
((eq action 'moved-to) 'renamed-to)
- ((eq action 'ignored) 'stopped)))
+ ((memq action '(ignored unmount)) 'stopped)))
(if (consp actions) actions (list actions))))
file file1-or-cookie))
@@ -339,7 +342,7 @@ DESC is the back-end descriptor. ACTIONS is a list of:
"Add a watch for FILE in DIR with FLAGS, using inotify."
(inotify-add-watch dir
(append
- '(dont-follow)
+ '(dont-follow ignored unmount)
(and (memq 'change flags)
'(create delete delete-self modify move-self move))
(and (memq 'attribute-change flags)
@@ -352,6 +355,7 @@ DESC is the back-end descriptor. ACTIONS is a list of:
;; directories, so we watch each file directly.
(kqueue-add-watch file
(append
+ '(revoke)
(and (memq 'change flags)
'(create delete write extend rename))
(and (memq 'attribute-change flags)
diff --git a/lisp/files.el b/lisp/files.el
index 4c33f406bd7..4fb3c73239d 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -7574,7 +7574,8 @@ files, you could say something like:
In this example, if you're in \"src/emacs/emacs-27/lisp/abbrev.el\",
and a \"src/emacs/emacs-28/lisp/abbrev.el\" file exists, it's now
defined as a sibling."
- :type 'sexp
+ :type '(alist :key-type (regexp :tag "Match")
+ :value-type (repeat (string :tag "Expansion")))
:version "29.1")
(defun find-sibling-file (file)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index a3be5577f7a..f576d4e6147 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -8331,39 +8331,29 @@ articles."
(defun gnus-summary-limit-to-age (age &optional younger-p)
"Limit the summary buffer to articles that are older than (or equal) AGE
days.
-If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
-articles that are younger than AGE days."
+Days are counted from midnight to midnight, and now to the
+previous midnight counts as day one. If YOUNGER-P (the prefix)
+is non-nil, limit the summary buffer to articles that are younger
+than AGE days."
(interactive
- (let ((younger current-prefix-arg)
- (days-got nil)
- days)
- (while (not days-got)
- (setq days (if younger
- (read-string "Limit to articles younger than (in days,
older when negative): ")
- (read-string
- "Limit to articles older than (in days, younger when
negative): ")))
- (when (> (length days) 0)
- (setq days (read days)))
- (if (numberp days)
- (progn
- (setq days-got t)
- (when (< days 0)
- (setq younger (not younger))
- (setq days (* days -1))))
- (message "Please enter a number.")
- (sleep-for 1)))
+ (let* ((younger current-prefix-arg)
+ (days (read-number
+ (if younger "Limit to articles younger than days: "
+ "Limit to articles older than days: "))))
(list days younger))
gnus-summary-mode)
(prog1
- (let ((data gnus-newsgroup-data)
- (cutoff (days-to-time age))
- articles d date is-younger)
+ (let* ((data gnus-newsgroup-data)
+ (now (append '(0 0 0) (cdddr (decode-time))))
+ (delta (make-decoded-time :day (* -1 (- age 1))))
+ (cutoff (encode-time (decoded-time-add now delta)))
+ articles d date is-younger)
(while (setq d (pop data))
(when (and (mail-header-p (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (gnus-date-get-time date))
- cutoff))
+ cutoff
+ (gnus-date-get-time date)))
(when (if younger-p
is-younger
(not is-younger))
diff --git a/lisp/help.el b/lisp/help.el
index 3a641ccc1be..41c43c356a4 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -192,7 +192,7 @@ buffer.")
max-key-len (max (length key) max-key-len))
(push (list key (cdr ent) (car ent)) keys))))
(when keys
- (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len
+ (let ((fmt (format "%%s %%-%ds%s" max-cmd-len
(make-string padding ?\s)))
(width (+ max-key-len 1 max-cmd-len padding)))
(push `(,width
@@ -203,10 +203,12 @@ buffer.")
'face 'bold)
,@(mapcar (lambda (ent)
(format fmt
- (propertize
- (car ent)
- 'quick-help-cmd
- (caddr ent))
+ (concat
+ (propertize
+ (car ent)
+ 'quick-help-cmd
+ (caddr ent))
+ (make-string (- max-key-len (length
(car ent))) ?\s))
(cadr ent)))
keys))
blocks)))))
diff --git a/lisp/ido.el b/lisp/ido.el
index 041ed33aa99..bbb3264f4f7 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1509,8 +1509,8 @@ Removes badly formatted data and ignored directories."
(add-hook 'minibuffer-setup-hook #'ido-minibuffer-setup)
(add-hook 'choose-completion-string-functions
#'ido-choose-completion-string))
-(defun ido--ffap-find-file (file)
- (find-file file))
+(defun ido--ffap-find-file (file &optional wildcard)
+ (find-file file wildcard))
(define-minor-mode ido-everywhere
"Toggle use of Ido for all buffer/file reading."
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index ecc7d73dd9e..d5ca6348c92 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -772,9 +772,8 @@ to switch back to
;;;###autoload
(defun image-mode-to-text ()
- "Set a non-image mode as major mode in combination with image minor mode.
-A non-mage major mode found from `auto-mode-alist' or fundamental mode
-displays an image file as text."
+ "Set current buffer's modes be a non-image major mode, plus
`image-minor-mode'.
+A non-image major mode displays an image file as text."
;; image-mode-as-text = normal-mode + image-minor-mode
(let ((previous-image-type image-type)) ; preserve `image-type'
(major-mode-restore '(image-mode image-mode-as-text))
@@ -785,15 +784,14 @@ displays an image file as text."
(image-toggle-display-text))))
(defun image-mode-as-hex ()
- "Set `hexl-mode' as major mode in combination with image minor mode.
-A non-mage major mode found from `auto-mode-alist' or fundamental mode
-displays an image file as hex. `image-minor-mode' provides the key
-\\<image-mode-map>\\[image-toggle-hex-display] to switch back to `image-mode' \
-to display an image file as
-the actual image.
+ "Set current buffer's modes be `hexl-mode' major mode, plus
`image-minor-mode'.
+This will by default display an image file as hex. `image-minor-mode'
+provides the key sequence \\<image-mode-map>\\[image-toggle-hex-display] to \
+switch back to `image-mode' to display
+an image file's buffer as an image.
You can use `image-mode-as-hex' in `auto-mode-alist' when you want to
-display an image file as hex initially.
+display image files as hex by default.
See commands `image-mode' and `image-minor-mode' for more information
on these modes."
diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el
index d0874124fc7..5ba1c4801fd 100644
--- a/lisp/leim/quail/cyrillic.el
+++ b/lisp/leim/quail/cyrillic.el
@@ -38,12 +38,12 @@
;; This was `cyrillic-jcuken'. Alexander Mikhailian
;; <mikhailian@altern.org> says: "cyrillic-jcuken" is actually
-;; russian. It is ok but a bit outdated. This layout has been used
+;; Russian. It is ok but a bit outdated. This layout has been used
;; in typewriters for ages but it has been superseded on desktops by
;; a variation of this layout, implemented in M$ Windows software.
;; The Windows layout is greatly preferred because of the comma and
;; period being placed more conveniently and, of course, because of
-;; the popularity of Windows software. This layout is a common option
+;; the popularity of Windows software. This layout is a common option
;; in X Windows and console layouts for GNU/Linux. [See
;; `russian-computer' below.]
(quail-define-package
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index efc06ffbbf8..5b264554005 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -169,7 +169,7 @@ A value of nil (or an empty list) means display none of
them.
Concepts come from UNIX: `links' means count of names associated with
the file; `uid' means user (owner) identifier; `gid' means group
-identifier.
+identifier; `modes' means Unix-style permission bits (drwxrwxrwx).
If emulation is MacOS then default is nil;
if emulation is MS-Windows then default is `(links)' if platform is
@@ -180,7 +180,8 @@ if emulation is GNU then default is `(links uid gid)'."
;; Functionality suggested by Howard Melman <howard@silverstream.com>
:type '(set (const :tag "Show Link Count" links)
(const :tag "Show User" uid)
- (const :tag "Show Group" gid))
+ (const :tag "Show Group" gid)
+ (const :tag "Show Modes" modes))
:group 'ls-lisp)
(defcustom ls-lisp-use-insert-directory-program
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 3a348ebcdc6..94c2b50c724 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1804,7 +1804,7 @@ mail status in mode line"))
(bindings--define-key menu [project-find-regexp] '(menu-item "Find
Regexp..." project-find-regexp :help "Search for a regexp in files belonging to
current project"))
(bindings--define-key menu [separator-project-search] menu-bar-separator)
(bindings--define-key menu [project-kill-buffers] '(menu-item "Kill
Buffers..." project-kill-buffers :help "Kill the buffers belonging to the
current project"))
- (bindings--define-key menu [project-list-buffers] '(menu-item "List
Buffers..." project-list-buffers :help "Pop up a window listing all Emacs
buffers belonging to current project"))
+ (bindings--define-key menu [project-list-buffers] '(menu-item "List
Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers
belonging to current project"))
(bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch
To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to
current project, and switch to it"))
(bindings--define-key menu [separator-project-buffers] menu-bar-separator)
(bindings--define-key menu [project-async-shell-command] '(menu-item
"Async Shell Command..." project-async-shell-command :help "Invoke a shell
command in project root asynchronously in background"))
@@ -1814,7 +1814,7 @@ mail status in mode line"))
(bindings--define-key menu [project-compile] '(menu-item "Compile..."
project-compile :help "Invoke compiler or Make for current project, view
errors"))
(bindings--define-key menu [separator-project-programs] menu-bar-separator)
(bindings--define-key menu [project-switch-project] '(menu-item "Switch
Project..." project-switch-project :help "Switch to another project and then
run a command"))
- (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir..."
project-vc-dir :help "Show the VC status of the project repository"))
+ (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir"
project-vc-dir :help "Show the VC status of the project repository"))
(bindings--define-key menu [project-dired] '(menu-item "Open Project Root"
project-dired :help "Read the root directory of the current project, to operate
on its files"))
(bindings--define-key menu [project-find-dir] '(menu-item "Open
Directory..." project-find-dir :help "Open existing directory that belongs to
current project"))
(bindings--define-key menu [project-or-external-find-file] '(menu-item
"Open File Including External Roots..." project-or-external-find-file :help
"Open existing file that belongs to current project or its external roots"))
@@ -2314,12 +2314,12 @@ The menu shows all the killed text sequences stored in
`kill-ring'."
;;; Buffers Menu
-(defcustom buffers-menu-max-size (if (display-graphic-p) 15 10)
+;; Increasing this more might be problematic on TTY frames. See Bug#64398.
+(defcustom buffers-menu-max-size 15
"Maximum number of entries which may appear on the Buffers menu.
If this is a number, only that many most-recently-selected
buffers are shown.
If this is nil, all buffers are shown."
- :initialize #'custom-initialize-delay
:type '(choice natnum
(const :tag "All" nil))
:group 'menu
@@ -2467,12 +2467,9 @@ It must accept a buffer as its only required argument.")
;; Make the menu of buffers proper.
(setq buffers-menu
(let ((i 0)
- (limit (if (boundp 'buffers-menu-max-size)
- (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1)
- buffers-menu-max-size)
- ;; Used when bootstrapping.
- 10))
+ (limit (and (integerp buffers-menu-max-size)
+ (> buffers-menu-max-size 1)
+ buffers-menu-max-size))
alist)
;; Put into each element of buffer-list
;; the name for actual display,
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index ca706c3c6e9..d1f92334ee2 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -309,12 +309,12 @@ Otherwise, `dictionary-search' displays definitions in a
*Dictionary* buffer."
:version "30.1")
(defface dictionary-word-definition-face
-'((((supports (:family "DejaVu Serif")))
- (:family "DejaVu Serif"))
- (((type x))
- (:font "Sans Serif"))
- (t
- (:font "default")))
+ '((((supports (:family "DejaVu Serif")))
+ (:family "DejaVu Serif"))
+ (((type x))
+ (:font "Sans Serif"))
+ (t
+ (:font "default")))
"The face that is used for displaying the definition of the word."
:group 'dictionary
:version "28.1")
@@ -405,6 +405,22 @@ Otherwise, `dictionary-search' displays definitions in a
*Dictionary* buffer."
"M-SPC" #'scroll-down-command
"DEL" #'scroll-down-command)
+(easy-menu-define dictionary-mode-menu dictionary-mode-map
+ "Menu for the Dictionary mode."
+ '("Dictionary"
+ ["Search Definition" dictionary-search
+ :help "Look up a new word"]
+ ["List Matching Words" dictionary-match-words
+ :help "List all words matching a pattern"]
+ ["Lookup Word At Point" dictionary-lookup-definition
+ :help "Look up the word at point"]
+ ["Select Dictionary" dictionary-select-dictionary
+ :help "Select one or more dictionaries to search within"]
+ ["Select Match Strategy" dictionary-select-strategy
+ :help "Select the algorithm to match queries and entries with"]
+ ["Back" dictionary-previous
+ :help "Return to the previous match or location"]))
+
(defvar dictionary-connection
nil
"The current network connection.")
@@ -423,6 +439,30 @@ Otherwise, `dictionary-search' displays definitions in a
*Dictionary* buffer."
;; Basic function providing startup actions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar dictionary-tool-bar-map
+ (let ((map (make-sparse-keymap)))
+ ;; Most of these items are the same as in the default tool bar
+ ;; map, but with extraneous items removed, and with extra search
+ ;; and navigation items.
+ (tool-bar-local-item-from-menu 'find-file "new" map
+ nil :label "New File"
+ :vert-only t)
+ (tool-bar-local-item-from-menu 'menu-find-file-existing "open" map
+ nil :label "Open" :vert-only t)
+ (tool-bar-local-item-from-menu 'dired "diropen" map nil :vert-only t)
+ (tool-bar-local-item-from-menu 'kill-this-buffer "close" map nil
+ :vert-only t)
+ (define-key-after map [separator-1] menu-bar-separator)
+ (tool-bar-local-item-from-menu 'dictionary-search "search"
+ map dictionary-mode-map :vert-only t
+ :help "Start a new search query.")
+ (tool-bar-local-item-from-menu 'dictionary-previous "left-arrow"
+ map dictionary-mode-map
+ :vert-only t
+ :help "Go backwards in history.")
+ map)
+ "Like the default `tool-bar-map', but with additions for Dictionary mode")
+
;;;###autoload
(define-derived-mode dictionary-mode special-mode "Dictionary"
"Mode for searching a dictionary.
@@ -452,6 +492,8 @@ This is a quick reference to this mode describing the
default key bindings:
(make-local-variable 'dictionary-positions)
(make-local-variable 'dictionary-default-dictionary)
(make-local-variable 'dictionary-default-strategy)
+ ;; Replace the tool bar map with `dictionary-tool-bar-map'.
+ (setq-local tool-bar-map dictionary-tool-bar-map)
(add-hook 'kill-buffer-hook #'dictionary-close t t))
;;;###autoload
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 4f90470d4fb..4ef179003de 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -60,8 +60,7 @@
;;; History:
-;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich
-;; Mueller.
+;; 07/28/2008: version 0.2. Added VM interface, written by Ulrich Müller.
;; 07/14/2008: Initial release
@@ -288,7 +287,7 @@ Currently there are `threads' and `flags'.")
(message-field-value field)))
;;; VM
-;;; written by Ulrich Mueller
+;;; written by Ulrich Müller
(declare-function vm-quit "ext:vm-folder" (&optional no-change))
(declare-function vm-visit-folder "ext:vm-startup"
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index 3f6242d9347..7cc7adc45c7 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -392,8 +392,9 @@ and the cdr part is used for encoding."
(cons (coding-system :tag "Decode")
(coding-system :tag "Encode")))))
-(defcustom rcirc-multiline-major-mode 'fundamental-mode
+(defcustom rcirc-multiline-major-mode #'text-mode
"Major-mode function to use in multiline edit buffers."
+ :version "30.1"
:type 'function)
(defcustom rcirc-nick-completion-format "%s: "
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 577760f806c..451c033a044 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1208,6 +1208,9 @@ file names."
(tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
+ ;; Tilde expansion shall be possible also for quoted localname.
+ (when (string-prefix-p "~" (file-name-unquote localname))
+ (setq localname (file-name-unquote localname)))
;; If there is a default location, expand tilde.
(when (string-match
(rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname)
@@ -1490,10 +1493,10 @@ If FILE-SYSTEM is non-nil, return file system
attributes."
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
'(created changed changes-done-hint moved deleted
- attribute-changed))
+ attribute-changed unmounted))
((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed))))
+ '(created changed changes-done-hint moved deleted unmounted))
+ ((memq 'attribute-change flags) '(attribute-changed unmounted))))
(p (apply
#'start-process
"gvfs-monitor" (generate-new-buffer " *gvfs-monitor*")
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 07f1cf24542..ba6dbdf0c39 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2637,15 +2637,15 @@ The method used must be an out-of-band method."
(defun tramp-sh-handle-insert-directory
(filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
- (unless switches (setq switches ""))
- ;; Check, whether directory is accessible.
- (unless wildcard
- (access-file filename "Reading directory"))
- (with-parsed-tramp-file-name (expand-file-name filename) nil
- (if (and (featurep 'ls-lisp)
- (not ls-lisp-use-insert-directory-program))
- (tramp-handle-insert-directory
- filename switches wildcard full-directory-p)
+ (if (and (featurep 'ls-lisp)
+ (not ls-lisp-use-insert-directory-program))
+ (tramp-handle-insert-directory
+ filename switches wildcard full-directory-p)
+ (unless switches (setq switches ""))
+ ;; Check, whether directory is accessible.
+ (unless wildcard
+ (access-file filename "Reading directory"))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
(let ((dired (tramp-get-ls-command-with v "--dired")))
(when (stringp switches)
(setq switches (split-string switches)))
@@ -2835,6 +2835,9 @@ the result will be a local, non-Tramp, file name."
(tramp-run-real-handler #'expand-file-name (list name)))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "~/" localname)))
+ ;; Tilde expansion shall be possible also for quoted localname.
+ (when (string-prefix-p "~" (file-name-unquote localname))
+ (setq localname (file-name-unquote localname)))
;; Tilde expansion if necessary. This needs a shell which
;; groks tilde expansion! The function `tramp-find-shell' is
;; supposed to find such a shell on the remote host. Please
@@ -3802,11 +3805,12 @@ Fall back to normal file name handler if no Tramp
handler exists."
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
(concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,attrib,ignored"))
+ "delete,delete_self,attrib"))
((memq 'change flags)
(concat "create,modify,move,moved_from,moved_to,move_self,"
- "delete,delete_self,ignored"))
- ((memq 'attribute-change flags) "attrib,ignored"))
+ "delete,delete_self"))
+ ((memq 'attribute-change flags) "attrib"))
+ events (concat events ",ignored,unmount")
;; "-P" has been added to version 3.21, so we cannot assume it
yet.
sequence `(,command "-mq" "-e" ,events ,localname)
;; Make events a list of symbols.
@@ -3821,10 +3825,10 @@ Fall back to normal file name handler if no Tramp
handler exists."
(cond
((and (memq 'change flags) (memq 'attribute-change flags))
'(created changed changes-done-hint moved deleted
- attribute-changed))
+ attribute-changed unmounted))
((memq 'change flags)
- '(created changed changes-done-hint moved deleted))
- ((memq 'attribute-change flags) '(attribute-changed)))
+ '(created changed changes-done-hint moved deleted unmounted))
+ ((memq 'attribute-change flags) '(attribute-changed unmounted)))
sequence `(,command "monitor" ,localname)))
;; None.
(t (tramp-error
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index f3f2c40e62c..ac1b29f08cd 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -722,6 +722,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(tramp-run-real-handler #'expand-file-name (list name))
;; Dissect NAME.
(with-parsed-tramp-file-name name nil
+ ;; Tilde expansion shall be possible also for quoted localname.
+ (when (string-prefix-p "~" (file-name-unquote localname))
+ (setq localname (file-name-unquote localname)))
;; Tilde expansion if necessary.
(when (string-match
(rx bos "~" (group (* (not "/"))) (group (* nonl)) eos) localname)
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index c22bfd7ff5c..40e438435fc 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -381,6 +381,9 @@ the result will be a local, non-Tramp, file name."
;; but to the root home directory.
(when (tramp-string-empty-or-nil-p localname)
(setq localname "~"))
+ ;; Tilde expansion shall be possible also for quoted localname.
+ (when (string-prefix-p "~" (file-name-unquote localname))
+ (setq localname (file-name-unquote localname)))
(unless (file-name-absolute-p localname)
(setq localname (format "~%s/%s" user localname)))
(when (string-match
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index aca2ebb8e8a..7cc9b0c14a2 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -67,7 +67,11 @@
(declare-function file-notify-rm-watch "filenotify")
(declare-function netrc-parse "netrc")
(defvar auto-save-file-name-transforms)
+(defvar ls-lisp-dirs-first)
+(defvar ls-lisp-emulation)
+(defvar ls-lisp-ignore-case)
(defvar ls-lisp-use-insert-directory-program)
+(defvar ls-lisp-verbosity)
(defvar tramp-prefix-format)
(defvar tramp-prefix-regexp)
(defvar tramp-method-regexp)
@@ -410,7 +414,7 @@ Another host name is useful only in combination with
;; an external method.
(cond
;; PuTTY is installed. We don't take it, if it is installed on a
- ;; non-windows system, or pscp from the pssh (parallel ssh) package
+ ;; non-Windows system, or pscp from the pssh (parallel ssh) package
;; is found.
((and (eq system-type 'windows-nt) (executable-find "pscp")) "pscp")
;; There is an ssh installation.
@@ -3807,6 +3811,9 @@ Let-bind it when necessary.")
(with-parsed-tramp-file-name name nil
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
+ ;; Tilde expansion shall be possible also for quoted localname.
+ (when (string-prefix-p "~" (file-name-unquote localname))
+ (setq localname (file-name-unquote localname)))
;; Expand tilde. Usually, the methods applying this handler do
;; not support tilde expansion. But users could declare a
;; respective connection property. (Bug#53847)
@@ -4159,7 +4166,7 @@ Let-bind it when necessary.")
(tramp-error v 'file-error "Unsafe backup file name"))))))
(defun tramp-handle-insert-directory
- (filename switches &optional wildcard full-directory-p)
+ (filename switches &optional wildcard full-directory-p)
"Like `insert-directory' for Tramp files."
(require 'ls-lisp)
(unless switches (setq switches ""))
@@ -4172,8 +4179,14 @@ Let-bind it when necessary.")
(access-file filename "Reading directory"))
(with-parsed-tramp-file-name (expand-file-name filename) nil
(with-tramp-progress-reporter v 0 (format "Opening directory %s" filename)
- (let (ls-lisp-use-insert-directory-program start)
- ;; Silence byte compiler.
+ ;; We bind `ls-lisp-emulation' to nil (which is GNU).
+ ;; `ls-lisp-set-options' modifies `ls-lisp-ignore-case',
+ ;; `ls-lisp-dirs-first' and `ls-lisp-verbosity', so we bind them
+ ;; as well. We don't want to use `insert-directory-program'.
+ (let (ls-lisp-emulation ls-lisp-ignore-case ls-lisp-dirs-first
+ ls-lisp-verbosity ls-lisp-use-insert-directory-program start)
+ ;; Set proper options based on `ls-lisp-emulation'.
+ (tramp-compat-funcall 'ls-lisp-set-options)
(tramp-run-real-handler
#'insert-directory
(list filename switches wildcard full-directory-p))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index d3e61643190..38e81d9d713 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -6784,7 +6784,8 @@ scheduled items with an hour specification like [h]h:mm."
(let ((deadline (time-to-days
(when (org-element-property
:deadline el)
(org-time-string-to-time
- (org-element-property :deadline
el))))))
+ (org-element-interpret-data
+ (org-element-property :deadline
el)))))))
(and (<= schedule deadline) (> current deadline))))
(`not-today pastschedp)
(`t t)
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index 28cfd0d910c..475416ecf74 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -525,7 +525,8 @@ for the duration of the command.")
(setq header-line-format org-previous-header-line-format)
(kill-local-variable 'org-previous-header-line-format)
(remove-hook 'post-command-hook #'org-columns-hscroll-title 'local))
- (set-marker org-columns-begin-marker nil)
+ (when (markerp org-columns-begin-marker)
+ (set-marker org-columns-begin-marker nil))
(when (markerp org-columns-top-level-marker)
(set-marker org-columns-top-level-marker nil))
(with-silent-modifications
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index a859fe6d412..cfef38581c6 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.9"))
+ (let ((org-release "9.6.10"))
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.9"))
+ (let ((org-git-version "release_9.6.10"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 9ca7f155614..8b02721a859 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.9
+;; Version: 9.6.10
;; This file is part of GNU Emacs.
;;
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 0457f1b00c0..3dde001328d 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -685,35 +685,13 @@ parts of the list.
The OFFSET argument is added to/taken away from the index that will be
used. This is really only useful with `first' and `last', for
-accessing absolute argument positions.
-
-When the argument has been transformed into something that is not
-a string by `pcomplete-parse-arguments-function', the text
-representation of the argument, namely what the user actually
-typed in, is returned, and the value of the argument is stored in
-the pcomplete-arg-value text property of that string."
- (let ((arg
- (nth (+ (pcase index
- ('first 0)
- ('last pcomplete-last)
- (_ (- pcomplete-index (or index 0))))
- (or offset 0))
- pcomplete-args)))
- (if (or (stringp arg)
- ;; FIXME: 'last' is handled specially in Emacs 29, because
- ;; 'pcomplete-parse-arguments' accepts a list of strings
- ;; (which are completion candidates) as return value for
- ;; (pcomplete-arg 'last). See below: "it means it's a
- ;; list of completions computed during parsing,
- ;; e.g. Eshell uses that to turn globs into lists of
- ;; completions". This special case will be dealt with
- ;; differently in Emacs 30: the pcomplete-arg-value
- ;; property will be used by 'pcomplete-parse-arguments'.
- (eq index 'last))
- arg
- (propertize
- (car (split-string (pcomplete-actual-arg index offset)))
- 'pcomplete-arg-value arg))))
+accessing absolute argument positions."
+ (nth (+ (pcase index
+ ('first 0)
+ ('last pcomplete-last)
+ (_ (- pcomplete-index (or index 0))))
+ (or offset 0))
+ pcomplete-args))
(defun pcomplete-begin (&optional index offset)
"Return the beginning position of the INDEXth argument.
diff --git a/lisp/printing.el b/lisp/printing.el
index 8aea58e157b..cb43f7e40dc 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -1,6 +1,6 @@
;;; printing.el --- printing utilities -*- lexical-binding:t -*-
-;; Copyright (C) 2000-2001, 2003-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2023 Free Software Foundation, Inc.
;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
@@ -5518,7 +5518,7 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
(setq ext (cdr ext)
found nil))
found)
- ;; non-windows systems
+ ;; non-Windows systems
(and (file-regular-p cmd)
(file-executable-p cmd)
cmd)))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index e687f44d657..f5e0d21108f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -12266,11 +12266,14 @@ comment at the start of cc-engine.el for more info."
;; Each time around the following checks one
;; declaration (which may contain several identifiers).
(while (and
- (consp (setq decl-or-cast
- (c-forward-decl-or-cast-1
- after-prec-token
- nil ; Or 'arglist ???
- nil)))
+ (not (eq (char-after) ?{))
+ (or
+ (consp (setq decl-or-cast
+ (c-forward-decl-or-cast-1
+ after-prec-token
+ nil ; Or 'arglist ???
+ nil)))
+ (throw 'knr nil))
(memq (char-after) '(?\; ?\,))
(goto-char (car decl-or-cast))
(save-excursion
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index f85cc0909dd..9e441dbfcf7 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -683,7 +683,10 @@ File = \\(.+\\), Line = \\([0-9]+\\)\\(?:, Column =
\\([0-9]+\\)\\)?"
"Alist of values for `compilation-error-regexp-alist'.")
(defcustom compilation-error-regexp-alist
- (mapcar #'car compilation-error-regexp-alist-alist)
+ ;; Omit `omake' by default: its mere presence here triggers special
processing
+ ;; and modifies regexps for other rules (see `compilation-parse-errors'),
+ ;; which may slow down matching (or even cause mismatches).
+ (delq 'omake (mapcar #'car compilation-error-regexp-alist-alist))
"Alist that specifies how to match errors in compiler output.
On GNU and Unix, any string is a valid filename, so these
matchers must make some common sense assumptions, which catch
@@ -2721,7 +2724,7 @@ looking for the next message."
(compilation-loop > compilation-next-single-property-change 1-
(if (get-buffer-process (current-buffer))
"No more %ss yet"
- "Moved past last %s")
+ "Past last %s")
(point-max))
;; Don't move "back" to message at or before point.
;; Pass an explicit (point-min) to make sure pt is non-nil.
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 1736b45c72d..7b72e3baee5 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -550,6 +550,18 @@ This way enabling/disabling of menu items is more correct."
:version "29.1")
;;;###autoload(put 'cperl-file-style 'safe-local-variable 'stringp)
+(defcustom cperl-fontify-trailer
+ 'perl-code
+ "How to fontify text after an \"__END__\" or \"__DATA__\" token.
+If \"perl-code\", treat as Perl code for fontification, and
+examine for imenu entries. Use this setting if you have trailing
+POD documentation, or for modules which use AutoLoad or
+AutoSplit. If \"comment\", treat as comment, and do not look for
+imenu entries."
+ :type '(choice (const perl-code)
+ (const comment))
+ :group 'cperl-faces)
+
(defcustom cperl-ps-print-face-properties
'((font-lock-keyword-face nil nil bold shadow)
(font-lock-variable-name-face nil nil bold)
@@ -4913,8 +4925,9 @@ recursive calls in starting lines of here-documents."
;; 1+6+2+1+1+6+1+1=19 extra () before this:
;; "__\\(END\\|DATA\\)__"
((match-beginning 20) ; __END__, __DATA__
- (setq bb (match-end 0))
- ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
+ (if (eq cperl-fontify-trailer 'perl-code)
+ (setq bb (match-end 0))
+ (setq bb (point-max)))
(cperl-commentify b bb nil)
(setq end t))
;; "\\\\\\(['`\"($]\\)"
@@ -6049,35 +6062,6 @@ functions (which they are not). Inherits from
`default'.")
;; (matcher subexp facespec)
'("^[ \t]*format[ \t]+\\([a-zA-Z_][a-zA-Z_0-9:]*\\)[ \t]*=[ \t]*$"
1 font-lock-function-name-face)
- ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar}
- ;; (matcher (subexp facespec) ...
- `(,(rx (or (in "]}\\%@>*&")
- (sequence "$" (eval cperl--normal-identifier-rx)))
- (0+ blank) "{" (0+ blank)
- (group-n 1 (sequence (opt "-")
- (eval cperl--basic-identifier-rx)))
- (0+ blank) "}")
-;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[
\t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- (1 font-lock-string-face t)
- ;; -------- anchored bareword hash key: $foo{bar}{baz}
- ;; ... (anchored-matcher pre-form post-form subex-highlighters)
- (,(rx point
- (0+ blank) "{" (0+ blank)
- (group-n 1 (sequence (opt "-")
- (eval cperl--basic-identifier-rx)))
- (0+ blank) "}")
- ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
- nil nil
- (1 font-lock-string-face t)))
- ;; -------- hash element assignments with bareword key => value
- ;; (matcher subexp facespec)
- `(,(rx (in "[ \t{,()")
- (group-n 1 (sequence (opt "-")
- (eval cperl--basic-identifier-rx)))
- (0+ blank) "=>")
- 1 font-lock-string-face t)
- ;; '("[[ \t{,(]\\(-?[a-zA-Z0-9_:]+\\)[ \t]*=>" 1
- ;; font-lock-string-face t)
;; -------- labels
;; (matcher subexp facespec)
`(,(rx
@@ -6177,32 +6161,33 @@ functions (which they are not). Inherits from
`default'.")
(setq
t-font-lock-keywords-1
`(
- ;; -------- arrays and hashes. Access to elements is fixed below
- ;; (matcher subexp facespec)
- ;; facespec is an expression to distinguish between arrays and
hashes
- (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#"))
- (eval cperl--normal-identifier-rx)))
- 1
-;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
- (if (eq (char-after (match-beginning 2)) ?%)
- 'cperl-hash-face
- 'cperl-array-face)
- nil)
- ;; -------- access to array/hash elements
- ;; (matcher subexp facespec)
- ;; facespec is an expression to distinguish between arrays and
hashes
- (,(rx (group-n 1 (group-n 2 (in "$@%"))
- (eval cperl--normal-identifier-rx))
- (0+ blank)
- (group-n 3 (in "[{")))
-;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
- 1
- (if (= (- (match-end 2) (match-beginning 2)) 1)
- (if (eq (char-after (match-beginning 3)) ?{)
- 'cperl-hash-face
- 'cperl-array-face) ; arrays and hashes
- font-lock-variable-name-face) ; Just to put something
- t) ; override previous
+ ;; -------- bareword hash key: $foo{bar}, $foo[1]{bar}
+ ;; (matcher (subexp facespec) ...
+ (,(rx (or (in "]}\\%@>*&")
+ (sequence "$" (eval cperl--normal-identifier-rx)))
+ (0+ blank) "{" (0+ blank)
+ (group-n 1 (sequence (opt "-")
+ (eval cperl--basic-identifier-rx)))
+ (0+ blank) "}")
+;; '("\\([]}\\%@>*&]\\|\\$[a-zA-Z0-9_:]*\\)[ \t]*{[
\t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ (1 font-lock-string-face)
+ ;; -------- anchored bareword hash key: $foo{bar}{baz}
+ ;; ... (anchored-matcher pre-form post-form subex-highlighters)
+ (,(rx point
+ (0+ blank) "{" (0+ blank)
+ (group-n 1 (sequence (opt "-")
+ (eval cperl--basic-identifier-rx)))
+ (0+ blank) "}")
+ ;; ("\\=[ \t]*{[ \t]*\\(-?[a-zA-Z0-9_:]+\\)[ \t]*}"
+ nil nil
+ (1 font-lock-string-face)))
+ ;; -------- hash element assignments with bareword key => value
+ ;; (matcher subexp facespec)
+ (,(rx (in "[ \t{,()")
+ (group-n 1 (sequence (opt "-")
+ (eval cperl--basic-identifier-rx)))
+ (0+ blank) "=>")
+ 1 font-lock-string-face)
;; -------- @$ array dereferences, $#$ last array index
;; (matcher (subexp facespec) (subexp facespec))
(,(rx (group-n 1 (or "@" "$#"))
@@ -6221,6 +6206,32 @@ functions (which they are not). Inherits from
`default'.")
;; ("\\(%\\)\\(\\$+\\([a-zA-Z_:][a-zA-Z0-9_:]*\\|[^ \t\n]\\)\\)"
(1 'cperl-hash-face)
(2 font-lock-variable-name-face))
+ ;; -------- access to array/hash elements
+ ;; (matcher subexp facespec)
+ ;; facespec is an expression to distinguish between arrays and
hashes
+ (,(rx (group-n 1 (group-n 2 (in "$@%"))
+ (eval cperl--normal-identifier-rx))
+ (0+ blank)
+ (group-n 3 (in "[{")))
+;; ("\\(\\([$@%]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)"
+ 1
+ (if (= (- (match-end 2) (match-beginning 2)) 1)
+ (if (eq (char-after (match-beginning 3)) ?{)
+ 'cperl-hash-face
+ 'cperl-array-face) ; arrays and hashes
+ font-lock-variable-name-face) ; Just to put something
+ nil) ; do not override previous
+ ;; -------- "Pure" arrays and hashes.
+ ;; (matcher subexp facespec)
+ ;; facespec is an expression to distinguish between arrays and
hashes
+ (,(rx (group-n 1 (group-n 2 (or (in "@%") "$#"))
+ (eval cperl--normal-identifier-rx)))
+ 1
+;; ("\\(\\([@%]\\|\\$#\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)" 1
+ (if (eq (char-after (match-beginning 2)) ?%)
+ 'cperl-hash-face
+ 'cperl-array-face)
+ nil)
;;("\\([smy]\\|tr\\)\\([^a-z_A-Z0-9]\\)\\(\\([^\n\\]*||\\)\\)\\2")
;;; Too much noise from \s* @s[ and friends
;;("\\(\\<\\([msy]\\|tr\\)[ \t]*\\([^
\t\na-zA-Z0-9_]\\)\\|\\(/\\)\\)"
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 664299df288..ff90a744ea3 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -460,7 +460,11 @@ use of `macroexpand-all' as a way to find the \"underlying
raw code\".")
(message "Ignoring macroexpansion error: %S" err) form))))
(sexp
(unwind-protect
- (let ((warning-minimum-log-level :emergency))
+ ;; Silence any macro expansion errors when
+ ;; attempting completion at point (bug#58148).
+ (let ((inhibit-message t)
+ (macroexp-inhibit-compiler-macros t)
+ (warning-minimum-log-level :emergency))
(advice-add 'macroexpand-1 :around macroexpand-advice)
(macroexpand-all sexp elisp--local-macroenv))
(advice-remove 'macroexpand-1 macroexpand-advice)))
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 32cb56ababd..02c40943ebf 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -37,7 +37,7 @@
;; We acknowledge many contributions and valuable suggestions by
;; Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea,
-;; Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon,
+;; Dr. Anil Gokhale, Ulrich Müller, Mark Neale, Eric Prestemon,
;; Gary Sabot and Richard Stallman.
;;; Code:
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 3cc63aab84f..d4b954a7203 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -2942,6 +2942,10 @@ It is saved for when this flag is not set.")
(declare-function speedbar-change-initial-expansion-list "speedbar" (new))
(defvar speedbar-previously-used-expansion-list-name)
+(defvar gud-highlight-current-line-overlay nil
+ "Overlay created for `gud-highlight-current-line'.
+It is nil if not yet present.")
+
(defun gud-sentinel (proc msg)
(cond ((null (buffer-name (process-buffer proc)))
;; buffer killed
@@ -2958,6 +2962,10 @@ It is saved for when this flag is not set.")
((memq (process-status proc) '(signal exit))
;; Stop displaying an arrow in a source file.
(setq gud-overlay-arrow-position nil)
+ ;; And any highlight overlays.
+ (when gud-highlight-current-line-overlay
+ (delete-overlay gud-highlight-current-line-overlay)
+ (setq gud-highlight-current-line-overlay nil))
(if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer)
'gdbmi)
(gdb-reset)
@@ -3024,6 +3032,24 @@ Obeying it means displaying in another window the
specified file and line."
;; region-restriction if that's possible. We use an explicit display-buffer
;; to get around the fact that this is called inside a save-excursion.
+(defcustom gud-highlight-current-line nil
+ "Whether Gud should highlight the source line being debugged.
+If non-nil, Gud will accentuate the source code line previously
+executed upon each pause in the debugee's execution with an
+overlay in the face `gud-highlight-current-line-face'.
+
+If nil, yet one of `hl-line-mode' or `global-hl-line-mode' (which
+see) is enabled, then the emphasis imposed by either of those
+major modes is instead momentarily moved to the aforesaid source
+line, until it is displaced by subsequent cursor motion."
+ :version "30.1"
+ :type 'boolean)
+
+(defface gud-highlight-current-line-face
+ '((t :inherit highlight :extend t))
+ "Face for highlighting the source code line being executed."
+ :version "30.1")
+
(defun gud-display-line (true-file line)
(let* ((last-nonmenu-event t) ; Prevent use of dialog box for
questions.
(buffer
@@ -3053,14 +3079,32 @@ Obeying it means displaying in another window the
specified file and line."
(or gud-overlay-arrow-position
(setq gud-overlay-arrow-position (make-marker)))
(set-marker gud-overlay-arrow-position (point) (current-buffer))
- ;; If they turned on hl-line, move the hl-line highlight to
- ;; the arrow's line.
- (when (featurep 'hl-line)
- (cond
- (global-hl-line-mode
- (global-hl-line-highlight))
- ((and hl-line-mode hl-line-sticky-flag)
- (hl-line-highlight)))))
+ (if gud-highlight-current-line
+ (progn
+ (unless gud-highlight-current-line-overlay
+ ;; Create the highlight overlay if it does not yet
+ ;; exist.
+ (let ((overlay (make-overlay (point) (point))))
+ (overlay-put overlay 'priority -45) ; 5 less than hl-line.
+ (overlay-put overlay 'face
'gud-highlight-current-line-face)
+ (setq gud-highlight-current-line-overlay overlay)))
+ ;; Next, move the overlay to the current line.
+ (move-overlay gud-highlight-current-line-overlay
+ (line-beginning-position)
+ (line-beginning-position 2)
+ (current-buffer)))
+ ;; Delete any overlay introduced if g-h-c-l-f has changed.
+ (when gud-highlight-current-line-overlay
+ (delete-overlay gud-highlight-current-line-overlay)
+ (setq gud-highlight-current-line-overlay nil))
+ ;; If they turned on hl-line, move the hl-line highlight to
+ ;; the arrow's line.
+ (when (featurep 'hl-line)
+ (cond
+ (global-hl-line-mode
+ (global-hl-line-highlight))
+ ((and hl-line-mode hl-line-sticky-flag)
+ (hl-line-highlight))))))
(cond ((or (< pos (point-min)) (> pos (point-max)))
(widen)
(goto-char pos))))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 2e6ae89a443..fd9c146a1fd 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -4,8 +4,8 @@
;; Version: 0.10.0
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
-;; This is a GNU ELPA :core package. Avoid using functionality that
-;; not compatible with the version of Emacs recorded above.
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -2010,5 +2010,43 @@ would otherwise have the same name."
(file-relative-name dirname root))))
dirname))
+;;; Project mode-line
+
+;;;###autoload
+(defcustom project-mode-line nil
+ "Whether to show current project name and Project menu on the mode line.
+This feature requires the presence of the following item in
+`mode-line-format': `(project-mode-line project-mode-line-format)'; it
+is part of the default mode line beginning with Emacs 30."
+ :type 'boolean
+ :group 'project
+ :version "30.1")
+
+(defvar project-menu-entry
+ `(menu-item "Project" ,menu-bar-project-menu))
+
+(defvar project-mode-line-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1] project-menu-entry)
+ map))
+
+(defvar project-mode-line-face nil
+ "Face name to use for the project name on the mode line.")
+
+(defvar project-mode-line-format '(:eval (project-mode-line-format)))
+(put 'project-mode-line-format 'risky-local-variable t)
+
+(defun project-mode-line-format ()
+ "Compose the project mode-line."
+ (when-let ((project (project-current)))
+ (concat
+ " "
+ (propertize
+ (project-name project)
+ 'face project-mode-line-face
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "mouse-1: Project menu"
+ 'local-map project-mode-line-map))))
+
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 9d80bbd72dd..5c34ddc562b 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -516,7 +516,9 @@ is customizable via `ruby-encoding-magic-comment-style'.
When set to `always-utf8' an utf-8 comment will always be added,
even if it's not required."
- :type 'boolean :group 'ruby)
+ :type '(choice (const :tag "Don't insert" nil)
+ (const :tag "Insert utf-8 comment always" always-utf8)
+ (const :tag "Insert only when required" t)))
(defcustom ruby-encoding-magic-comment-style 'ruby
"The style of the magic encoding comment to use."
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 855ba4b50cf..2eec4bcd21a 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -5374,10 +5374,7 @@ primitive or interface named NAME."
(goto-char (match-end 0))
(setq there (point))
(setq err nil)
- (setq str (concat " // " cntx
(verilog-get-expr))))
-
- (;-- otherwise...
- (setq str " // auto-endcomment confused "))))
+ (setq str (concat " // " cntx
(verilog-get-expr))))))
((and
(verilog-in-case-region-p) ;-- handle case item
differently
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b7bfb192d87..fd788ec8f32 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -638,6 +638,18 @@ If SELECT is non-nil, select the target window."
"Face used to highlight matches in the xref buffer."
:version "28.1")
+(defvar-local xref-num-matches-found 0)
+
+(defvar xref-num-matches-face 'compilation-info
+ "Face name to show the number of matches on the mode line.")
+
+(defconst xref-mode-line-matches
+ `(" [" (:propertize (:eval (int-to-string xref-num-matches-found))
+ face ,xref-num-matches-face
+ help-echo "Number of matches so far")
+ "]"))
+(put 'xref-mode-line-matches 'risky-local-variable t)
+
(defmacro xref--with-dedicated-window (&rest body)
`(let* ((xref-w (get-buffer-window xref-buffer-name))
(xref-w-dedicated (window-dedicated-p xref-w)))
@@ -1235,6 +1247,8 @@ Return an alist of the form ((GROUP . (XREF ...)) ...)."
(xref--ensure-default-directory dd (current-buffer))
(xref--xref-buffer-mode)
(xref--show-common-initialize xref-alist fetcher alist)
+ (setq xref-num-matches-found (length xrefs))
+ (setq mode-line-process (list xref-mode-line-matches))
(pop-to-buffer (current-buffer))
(setq buf (current-buffer)))
(xref--auto-jump-first buf (assoc-default 'auto-jump alist))
diff --git a/lisp/simple.el b/lisp/simple.el
index 8b45e4b1c75..6cbf8767ef8 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10672,10 +10672,10 @@ See also `normal-erase-is-backspace'."
(t
(if enabled
(progn
- (keyboard-translate ?\C-h ?\C-?)
- (keyboard-translate ?\C-? ?\C-d))
- (keyboard-translate ?\C-h ?\C-h)
- (keyboard-translate ?\C-? ?\C-?))))
+ (key-translate "C-h" "DEL")
+ (key-translate "DEL" "C-d"))
+ (key-translate "C-h" "C-h")
+ (key-translate "DEL" "DEL"))))
(if (called-interactively-p 'interactive)
(message "Delete key deletes %s"
diff --git a/lisp/subr.el b/lisp/subr.el
index e88815fa58c..58274987d71 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3408,7 +3408,7 @@ causes it to evaluate `help-form' and display the result."
(message "%s%s" prompt (char-to-string char))
char))
-(defun sit-for (seconds &optional nodisp obsolete)
+(defun sit-for (seconds &optional nodisp)
"Redisplay, then wait for SECONDS seconds. Stop when input is available.
SECONDS may be a floating-point value.
\(On operating systems that do not support waiting for fractions of a
@@ -3417,29 +3417,11 @@ second, floating-point values are rounded down to the
nearest integer.)
If optional arg NODISP is t, don't redisplay, just wait for input.
Redisplay does not happen if input is available before it starts.
-Value is t if waited the full time with no input arriving, and nil otherwise.
-
-An obsolete, but still supported form is
-\(sit-for SECONDS &optional MILLISECONDS NODISP)
-where the optional arg MILLISECONDS specifies an additional wait period,
-in milliseconds; this was useful when Emacs was built without
-floating point support."
- (declare (advertised-calling-convention (seconds &optional nodisp) "22.1")
- (compiler-macro
- (lambda (form)
- (if (not (or (numberp nodisp) obsolete)) form
- (macroexp-warn-and-return
- (format-message "Obsolete calling convention for `sit-for'")
- `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0))
,obsolete)
- '(obsolete sit-for))))))
+Value is t if waited the full time with no input arriving, and nil otherwise."
;; This used to be implemented in C until the following discussion:
;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html
;; Then it was moved here using an implementation based on an idle timer,
;; which was then replaced by the use of read-event.
- (if (numberp nodisp)
- (setq seconds (+ seconds (* 1e-3 nodisp))
- nodisp obsolete)
- (if obsolete (setq nodisp obsolete)))
(cond
(noninteractive
(sleep-for seconds)
diff --git a/lisp/term.el b/lisp/term.el
index b8466b21332..b2875e4a17f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -486,7 +486,7 @@ Customize this option to nil if you want the previous
behavior."
(defcustom term-scroll-to-bottom-on-output nil
"Controls whether interpreter output causes window to scroll.
-If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
+If nil, then do not scroll. If t, scroll all windows showing buffer.
If `this', scroll only the selected window.
If `others', scroll only those that are not the selected window.
@@ -494,7 +494,12 @@ The default is nil.
See variable `term-scroll-show-maximum-output'.
This variable is buffer-local."
- :type 'boolean
+ :type '(choice (const :tag "Don't scroll" nil)
+ (const :tag "Scroll selected window only" this)
+ (const :tag "Scroll unselected windows" others)
+ ;; We also recognize `all', but we don't advertise it
+ ;; anymore. (Bug#66071)
+ (other :tag "Scroll all windows" t))
:group 'term)
(defcustom term-scroll-snap-to-bottom t
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index db873c176c8..f3f5c227df0 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -233,5 +233,63 @@ EVENT is a preedit-text event."
(defconst x-pointer-invisible 0)
+;; Drag-and-drop. There are two formats of drag and drop event under
+;; Android. The data field of the first is set to a cons of X and Y,
+;; which represent a position within a frame that something is being
+;; dragged over, whereas that of the second is a cons of either symbol
+;; `uri' or `text' and a list of URIs or text to insert.
+;;
+;; If a content:// URI is encountered, then it in turn designates a
+;; file within the special-purpose /content/by-authority directory,
+;; which facilitates accessing such atypical files.
+
+(declare-function url-type "url-parse")
+(declare-function url-host "url-parse")
+(declare-function url-filename "url-parse")
+
+(defun android-handle-dnd-event (event)
+ "Respond to a drag-and-drop event EVENT.
+If it reflects the motion of an item above a frame, call
+`dnd-handle-movement' to move the cursor or scroll the window
+under the item pursuant to the pertinent user options.
+
+If it reflects dropped text, insert such text within window at
+the location of the drop.
+
+If it reflects a list of URIs, then open each URI, converting
+content:// URIs into the special file names which represent them."
+ (interactive "e")
+ (let ((message (caddr event))
+ (posn (event-start event)))
+ (cond ((fixnump (car message))
+ (dnd-handle-movement posn))
+ ((eq (car message) 'text)
+ (let ((window (posn-window posn)))
+ (with-selected-window window
+ (unless mouse-yank-at-point
+ (goto-char (posn-point (event-start event))))
+ (dnd-insert-text window 'copy (cdr message)))))
+ ((eq (car message) 'uri)
+ (let ((uri-list (split-string (cdr message)
+ "[\0\r\n]" t))
+ (dnd-unescape-file-uris t))
+ (dolist (uri uri-list)
+ (ignore-errors
+ (let ((url (url-generic-parse-url uri)))
+ (when (equal (url-type url) "content")
+ ;; Replace URI with a matching /content file
+ ;; name.
+ (setq uri (format "file:/content/by-authority/%s%s"
+ (url-host url)
+ (url-filename url))
+ ;; And guarantee that this file URI is not
+ ;; subject to URI decoding, for it must be
+ ;; transformed back into a content URI.
+ dnd-unescape-file-uris nil))))
+ (dnd-handle-one-url (posn-window posn) 'copy uri)))))))
+
+(define-key special-event-map [drag-n-drop] 'android-handle-dnd-event)
+
+
(provide 'android-win)
;; android-win.el ends here.
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
index 983c8cded2f..0c2eba486a3 100644
--- a/lisp/term/bobcat.el
+++ b/lisp/term/bobcat.el
@@ -3,8 +3,8 @@
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
;; HP terminals usually encourage using ^H as the rubout character
- (keyboard-translate ?\177 ?\^h)
- (keyboard-translate ?\^h ?\177))
+ (key-translate "DEL" "C-h")
+ (key-translate "C-h" "DEL"))
(provide 'term/bobcat)
diff --git a/lisp/touch-screen.el b/lisp/touch-screen.el
index 23c5bbf71ff..2621aebf037 100644
--- a/lisp/touch-screen.el
+++ b/lisp/touch-screen.el
@@ -1140,9 +1140,7 @@ is not read-only."
;; ... generate a mouse-1 event...
(list 'mouse-1 posn)
;; ... otherwise, generate a drag-mouse-1 event.
- (list 'drag-mouse-1 (cons old-window
- old-posn)
- (cons new-window posn))))
+ (list 'drag-mouse-1 old-posn posn)))
(if (and (eq new-window old-window)
(eq new-point old-point)
(windowp new-window)
@@ -1150,9 +1148,7 @@ is not read-only."
;; ... generate a mouse-1 event...
(list 'mouse-1 posn)
;; ... otherwise, generate a drag-mouse-1 event.
- (list 'drag-mouse-1 (cons old-window
- old-posn)
- (cons new-window posn)))))))
+ (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.
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 402417c6ca9..c73ac9912d6 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2889,7 +2889,9 @@ to the offending pattern and highlight the pattern."
(start (nth 1 data))
(inhibit-read-only t))
(erase-buffer)
- (insert (treesit-query-expand query))
+ (insert (if (stringp query)
+ query
+ (treesit-query-expand query)))
(goto-char start)
(search-forward " " nil t)
(put-text-property start (point) 'face 'error)
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 494ed80c496..d3371d66863 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -77,7 +77,8 @@ rest from typing, then the next typing break is simply
rescheduled for later.
If a break is interrupted before this much time elapses, the user will be
asked whether or not really to interrupt the break."
:set-after '(type-break-interval)
- :type 'natnum
+ :type '(choice (const :tag "Don't check idle time" nil)
+ natnum)
:group 'type-break)
(defcustom type-break-good-break-interval nil
@@ -201,7 +202,8 @@ key is pressed."
"Name of file used to save state across sessions.
If this is nil, no data will be saved across sessions."
:version "24.4" ; added locate-user
- :type 'file)
+ :type '(choice (const :tag "Don't save data" nil)
+ file))
(defvar type-break-post-command-hook '(type-break-check)
"Hook run indirectly by `post-command-hook' for typing break functions.
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 24836e1b1c1..7e3b20d8939 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -909,7 +909,7 @@ MERGE-AUTOSTORE-DIR is the directory in which to store
merged files."
(defun ediff-windows-wordwise (dumb-mode &optional wind-A wind-B startup-hooks)
"Compare WIND-A and WIND-B, which are selected by clicking, wordwise.
This compares the portions of text visible in each of the two windows.
-With prefix argument, DUMB-MODE, or on a non-windowing display, works as
+With prefix argument, DUMB-MODE, or on a non-graphical display, works as
follows:
If WIND-A is nil, use selected window.
If WIND-B is nil, use window next to WIND-A.
@@ -923,7 +923,7 @@ arguments after setting up the Ediff buffers."
(defun ediff-windows-linewise (dumb-mode &optional wind-A wind-B startup-hooks)
"Compare WIND-A and WIND-B, which are selected by clicking, linewise.
This compares the portions of text visible in each of the two windows.
-With prefix argument, DUMB-MODE, or on a non-windowing display, works as
+With prefix argument, DUMB-MODE, or on a non-graphical display, works as
follows:
If WIND-A is nil, use selected window.
If WIND-B is nil, use window next to WIND-A.
@@ -935,7 +935,7 @@ arguments after setting up the Ediff buffers."
;; Compare visible portions of text in WIND-A and WIND-B, which are
;; selected by clicking.
-;; With prefix argument, DUMB-MODE, or on a non-windowing display,
+;; With prefix argument, DUMB-MODE, or on a non-graphical display,
;; works as follows:
;; If WIND-A is nil, use selected window.
;; If WIND-B is nil, use window next to WIND-A.
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 7847a6c7670..e42b82c7064 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -1239,7 +1239,11 @@ spacing of the \"Lower\" chunk."
(write-region beg1 end1 file1 nil 'nomessage)
(write-region beg2 end2 file2 nil 'nomessage)
(unwind-protect
- (with-current-buffer (get-buffer-create smerge-diff-buffer-name)
+ (save-current-buffer
+ (if-let (buffer (get-buffer smerge-diff-buffer-name))
+ (set-buffer buffer)
+ (set-buffer (get-buffer-create smerge-diff-buffer-name))
+ (setq buffer-read-only t))
(setq default-directory dir)
(let ((inhibit-read-only t))
(erase-buffer)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 7f334397a5e..a5575f91e9c 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -1211,18 +1211,23 @@ BEWARE: this function may change the current buffer."
(defun vc-next-action (verbose)
"Do the next logical version control operation on the current fileset.
This requires that all files in the current VC fileset be in the
-same state. If not, signal an error.
-
-For merging-based version control systems:
- If every file in the VC fileset is not registered for version
- control, register the fileset (but don't commit).
- If every work file in the VC fileset is added or changed, pop
- up a *vc-log* buffer to commit the fileset.
+same state. If they are not, signal an error. Also signal an error if
+files in the fileset are missing (removed, but tracked by version control),
+or are ignored by the version control system.
+
+For modern merging-based version control systems:
+ If every file in the fileset is not registered for version
+ control, register the fileset (but don't commit). If VERBOSE is
+ non-nil (interactively, the prefix argument), ask for the VC
+ backend with which to register the fileset.
+ If every work file in the VC fileset is either added or modified,
+ pop up a *vc-log* buffer to commit the fileset changes.
For a centralized version control system, if any work file in
the VC fileset is out of date, offer to update the fileset.
For old-style locking-based version control systems, like RCS:
- If every file is not registered, register the file(s).
+ If every file is not registered, register the file(s); with a prefix
+ argument, allow to specify the VC backend for registration.
If every file is registered and unlocked, check out (lock)
the file(s) for editing.
If every file is locked by you and has changes, pop up a
@@ -1230,14 +1235,21 @@ For old-style locking-based version control systems,
like RCS:
read-only copy of each changed file after checking in.
If every file is locked by you and unchanged, unlock them.
If every file is locked by someone else, offer to steal the lock.
+ If files are unlocked, but have changes, offer to either claim the
+ lock or revert to the last checked-in version.
+
+If this command is invoked from a patch buffer under `diff-mode', it
+will apply the diffs from the patch and pop up a *vc-log* buffer to
+check-in the resulting changes.
When using this command to register a new file (or files), it
will automatically deduce which VC repository to register it
with, using the most specific one.
If VERBOSE is non-nil (interactively, the prefix argument),
-you can specify a VC backend or (for centralized VCS only)
-the revision ID or branch ID."
+you can specify another VC backend for the file(s),
+or (for centralized VCS only) the revision ID or branch ID
+from which to check out the file(s)."
(interactive "P")
(let* ((vc-fileset (vc-deduce-fileset nil t 'state-model-only-files))
(backend (car vc-fileset))
@@ -1264,6 +1276,8 @@ the revision ID or branch ID."
(error "Fileset files are missing, so cannot be operated on"))
((eq state 'ignored)
(error "Fileset files are ignored by the version-control system"))
+ ;; Fileset comes from a diff-mode buffer, see
+ ;; 'diff-vc-deduce-fileset', and the buffer is the patch to apply.
((eq model 'patch)
(vc-checkin files backend nil nil nil (buffer-string)))
((or (null state) (eq state 'unregistered))
@@ -3169,14 +3183,13 @@ its name; otherwise return nil."
(vc-resynch-buffer file t t))
;;;###autoload
-(defun vc-switch-backend (file backend)
+(defun vc-change-backend (file backend)
"Make BACKEND the current version control system for FILE.
FILE must already be registered in BACKEND. The change is not
permanent, only for the current session. This function only changes
VC's perspective on FILE, it does not register or unregister it.
By default, this command cycles through the registered backends.
To get a prompt, use a prefix argument."
- (declare (obsolete nil "28.1"))
(interactive
(list
(or buffer-file-name
@@ -3207,6 +3220,9 @@ To get a prompt, use a prefix argument."
(error "%s is not registered in %s" file backend))
(vc-mode-line file)))
+(define-obsolete-function-alias 'vc-switch-backend #'vc-change-backend
+ "30.1")
+
;;;###autoload
(defun vc-transfer-file (file new-backend)
"Transfer FILE to another version control system NEW-BACKEND.
@@ -3231,8 +3247,7 @@ backend to NEW-BACKEND, and unregister FILE from the
current backend.
(if registered
(set-file-modes file (logior (file-modes file) 128))
;; `registered' might have switched under us.
- (with-suppressed-warnings ((obsolete vc-switch-backend))
- (vc-switch-backend file old-backend))
+ (vc-change-backend file old-backend)
(let* ((rev (vc-working-revision file))
(modified-file (and edited (make-temp-file file)))
(unmodified-file (and modified-file (vc-version-backup-file
file))))
@@ -3251,19 +3266,16 @@ backend to NEW-BACKEND, and unregister FILE from the
current backend.
(vc-revert-file file))))
(vc-call-backend new-backend 'receive-file file rev))
(when modified-file
- (with-suppressed-warnings ((obsolete vc-switch-backend))
- (vc-switch-backend file new-backend))
+ (vc-change-backend file new-backend)
(unless (eq (vc-checkout-model new-backend (list file)) 'implicit)
(vc-checkout file))
(rename-file modified-file file 'ok-if-already-exists)
(vc-file-setprop file 'vc-checkout-time nil)))))
(when move
- (with-suppressed-warnings ((obsolete vc-switch-backend))
- (vc-switch-backend file old-backend))
+ (vc-change-backend file old-backend)
(setq comment (vc-call-backend old-backend 'comment-history file))
(vc-call-backend old-backend 'unregister file))
- (with-suppressed-warnings ((obsolete vc-switch-backend))
- (vc-switch-backend file new-backend))
+ (vc-change-backend file new-backend)
(when (or move edited)
(vc-file-setprop file 'vc-state 'edited)
(vc-mode-line file new-backend)
diff --git a/lisp/woman.el b/lisp/woman.el
index e20a2399c00..b908e81a994 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -34,6 +34,10 @@
;; the emulation is modified to include the reformatting done by the
;; Emacs `man' command. No hyphenation is performed.
+;; Note that `M-x woman' doesn’t yet support the latest features of
+;; modern man pages, so we recommend using `M-x man' if that is
+;; available on your system.
+
;; Advantages
;; Much more direct, does not require any external programs.
@@ -1149,7 +1153,11 @@ speed. With a prefix argument, force the caches to be
updated (e.g. to re-interpret the current directory).
Used non-interactively, arguments are optional: if given then TOPIC
-should be a topic string and non-nil RE-CACHE forces re-caching."
+should be a topic string and non-nil RE-CACHE forces re-caching.
+
+Note that `M-x woman' doesn’t yet support the latest features of
+modern man pages, so we recommend using `M-x man' if that is
+available on your system."
(interactive (list nil current-prefix-arg))
;; The following test is for non-interactive calls via emacsclient, etc.
(if (or (not (stringp topic)) (string-match-p "\\S " topic))
diff --git a/src/android.c b/src/android.c
index aa4033c676f..8c4748cccf6 100644
--- a/src/android.c
+++ b/src/android.c
@@ -104,6 +104,7 @@ struct android_emacs_window
jmethodID make_input_focus;
jmethodID raise;
jmethodID lower;
+ jmethodID reconfigure;
jmethodID get_window_geometry;
jmethodID translate_coordinates;
jmethodID set_dont_accept_focus;
@@ -1755,6 +1756,7 @@ android_init_emacs_window (void)
FIND_METHOD (make_input_focus, "makeInputFocus", "(J)V");
FIND_METHOD (raise, "raise", "()V");
FIND_METHOD (lower, "lower", "()V");
+ FIND_METHOD (reconfigure, "reconfigure", "(Lorg/gnu/emacs/EmacsWindow;I)V");
FIND_METHOD (get_window_geometry, "getWindowGeometry",
"()[I");
FIND_METHOD (translate_coordinates, "translateCoordinates",
@@ -2317,6 +2319,100 @@ NATIVE_NAME (sendExpose) (JNIEnv *env, jobject object,
return event_serial;
}
+JNIEXPORT jboolean JNICALL
+NATIVE_NAME (sendDndDrag) (JNIEnv *env, jobject object,
+ jshort window, jint x, jint y)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+
+ event.dnd.type = ANDROID_DND_DRAG_EVENT;
+ event.dnd.serial = ++event_serial;
+ event.dnd.window = window;
+ event.dnd.x = x;
+ event.dnd.y = y;
+ event.dnd.uri_or_string = NULL;
+ event.dnd.length = 0;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
+JNIEXPORT jboolean JNICALL
+NATIVE_NAME (sendDndUri) (JNIEnv *env, jobject object,
+ jshort window, jint x, jint y,
+ jstring string)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const jchar *characters;
+ jsize length;
+ uint16_t *buffer;
+
+ event.dnd.type = ANDROID_DND_URI_EVENT;
+ event.dnd.serial = ++event_serial;
+ event.dnd.window = window;
+ event.dnd.x = x;
+ event.dnd.y = y;
+
+ length = (*env)->GetStringLength (env, string);
+ buffer = malloc (length * sizeof *buffer);
+ characters = (*env)->GetStringChars (env, string, NULL);
+
+ if (!characters)
+ /* The JVM has run out of memory; return and let the out of memory
+ error take its course. */
+ return 0;
+
+ memcpy (buffer, characters, length * sizeof *buffer);
+ (*env)->ReleaseStringChars (env, string, characters);
+
+ event.dnd.uri_or_string = buffer;
+ event.dnd.length = length;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
+JNIEXPORT jboolean JNICALL
+NATIVE_NAME (sendDndText) (JNIEnv *env, jobject object,
+ jshort window, jint x, jint y,
+ jstring string)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ const jchar *characters;
+ jsize length;
+ uint16_t *buffer;
+
+ event.dnd.type = ANDROID_DND_TEXT_EVENT;
+ event.dnd.serial = ++event_serial;
+ event.dnd.window = window;
+ event.dnd.x = x;
+ event.dnd.y = y;
+
+ length = (*env)->GetStringLength (env, string);
+ buffer = malloc (length * sizeof *buffer);
+ characters = (*env)->GetStringChars (env, string, NULL);
+
+ if (!characters)
+ /* The JVM has run out of memory; return and let the out of memory
+ error take its course. */
+ return 0;
+
+ memcpy (buffer, characters, length * sizeof *buffer);
+ (*env)->ReleaseStringChars (env, string, characters);
+
+ event.dnd.uri_or_string = buffer;
+ event.dnd.length = length;
+
+ android_write_event (&event);
+ return event_serial;
+}
+
JNIEXPORT jboolean JNICALL
NATIVE_NAME (shouldForwardMultimediaButtons) (JNIEnv *env,
jobject object)
@@ -4407,6 +4503,7 @@ android_fill_polygon (android_drawable drawable, struct
android_gc *gc,
service_class.fill_polygon,
drawable_object,
gcontext, array);
+ android_exception_check_1 (array);
ANDROID_DELETE_LOCAL_REF (array);
}
@@ -4429,6 +4526,10 @@ android_draw_rectangle (android_drawable handle, struct
android_gc *gc,
drawable, gcontext,
(jint) x, (jint) y,
(jint) width, (jint) height);
+
+ /* In lieu of android_exception_check, clear all exceptions after
+ calling this frequently called graphics operation. */
+ (*android_java_env)->ExceptionClear (android_java_env);
}
void
@@ -4449,6 +4550,10 @@ android_draw_point (android_drawable handle, struct
android_gc *gc,
service_class.draw_point,
drawable, gcontext,
(jint) x, (jint) y);
+
+ /* In lieu of android_exception_check, clear all exceptions after
+ calling this frequently called graphics operation. */
+ (*android_java_env)->ExceptionClear (android_java_env);
}
void
@@ -4470,6 +4575,10 @@ android_draw_line (android_drawable handle, struct
android_gc *gc,
drawable, gcontext,
(jint) x, (jint) y,
(jint) x2, (jint) y2);
+
+ /* In lieu of android_exception_check, clear all exceptions after
+ calling this frequently called graphics operation. */
+ (*android_java_env)->ExceptionClear (android_java_env);
}
android_pixmap
@@ -4963,6 +5072,37 @@ android_lower_window (android_window handle)
android_exception_check ();
}
+void
+android_reconfigure_wm_window (android_window handle,
+ enum android_wc_value_mask value_mask,
+ struct android_window_changes *values)
+{
+ jobject sibling, window;
+
+ window = android_resolve_handle (handle, ANDROID_HANDLE_WINDOW);
+
+ if (!(value_mask & ANDROID_CW_STACK_MODE))
+ return;
+
+ /* If value_mask & ANDROID_CW_SIBLING, place HANDLE above or below
+ values->sibling pursuant to values->stack_mode; else, reposition
+ it at the top or the bottom of its parent. */
+
+ sibling = NULL;
+
+ if (value_mask & ANDROID_CW_SIBLING)
+ sibling = android_resolve_handle (values->sibling,
+ ANDROID_HANDLE_WINDOW);
+
+ (*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
+ window,
+ window_class.class,
+ window_class.reconfigure,
+ sibling,
+ (jint) values->stack_mode);
+ android_exception_check ();
+}
+
int
android_query_tree (android_window handle, android_window *root_return,
android_window *parent_return,
@@ -5246,7 +5386,7 @@ android_wc_lookup_string (android_key_pressed_event
*event,
The caller must take care to unlock the bitmap data afterwards. */
unsigned char *
-android_lock_bitmap (android_window drawable,
+android_lock_bitmap (android_drawable drawable,
AndroidBitmapInfo *bitmap_info,
jobject *bitmap_return)
{
@@ -5262,9 +5402,15 @@ android_lock_bitmap (android_window drawable,
object,
drawable_class.get_bitmap);
if (!bitmap)
- /* NULL is returned when the bitmap does not currently exist due
- to ongoing reconfiguration on the main thread. */
- return NULL;
+ {
+ /* Report any exception signaled. */
+ android_exception_check ();
+
+ /* If no exception was signaled, then NULL was returned as the
+ bitmap does not presently exist due to window reconfiguration
+ on the main thread. */
+ return NULL;
+ }
memset (bitmap_info, 0, sizeof *bitmap_info);
@@ -5490,22 +5636,40 @@ android_toggle_on_screen_keyboard (android_window
window, bool show)
+#if defined __clang_major__ && __clang_major__ < 5
+# define HAS_BUILTIN_TRAP 0
+#elif 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__))
+# define HAS_BUILTIN_TRAP 1
+#elif defined __has_builtin
+# define HAS_BUILTIN_TRAP __has_builtin (__builtin_trap)
+#else /* !__has_builtin */
+# define HAS_BUILTIN_TRAP 0
+#endif /* defined __clang_major__ && __clang_major__ < 5 */
+
/* emacs_abort implementation for Android. This logs a stack
trace. */
void
emacs_abort (void)
{
+#ifndef HAS_BUILTIN_TRAP
volatile char *foo;
+#endif /* !HAS_BUILTIN_TRAP */
__android_log_print (ANDROID_LOG_FATAL, __func__,
- "emacs_abort called, please review the ensuing"
+ "emacs_abort called, please review the following"
" stack trace");
- /* Cause a NULL pointer dereference to make debuggerd generate a
+#ifndef HAS_BUILTIN_TRAP
+ /* Induce a NULL pointer dereference to make debuggerd generate a
tombstone. */
foo = NULL;
*foo = '\0';
+#else /* HAS_BUILTIN_TRAP */
+ /* Crash through __builtin_trap instead. This appears to more
+ uniformly elicit crash reports from debuggerd. */
+ __builtin_trap ();
+#endif /* !HAS_BUILTIN_TRAP */
abort ();
}
@@ -5593,15 +5757,20 @@ android_verify_jni_string (const char *name)
}
/* Given a Lisp string TEXT, return a local reference to an equivalent
- Java string. */
+ Java string. Each argument following TEXT should be NULL or a
+ local reference that will be freed if creating the string fails,
+ whereupon memory_full will also be signaled. */
jstring
-android_build_string (Lisp_Object text)
+android_build_string (Lisp_Object text, ...)
{
Lisp_Object encoded;
jstring string;
size_t nchars;
jchar *characters;
+ va_list ap;
+ jobject object;
+
USE_SAFE_ALLOCA;
/* Directly encode TEXT if it contains no non-ASCII characters, or
@@ -5619,9 +5788,11 @@ android_build_string (Lisp_Object text)
{
string = (*android_java_env)->NewStringUTF (android_java_env,
SSDATA (text));
- android_exception_check ();
- SAFE_FREE ();
+ if ((*android_java_env)->ExceptionCheck (android_java_env))
+ goto error;
+
+ SAFE_FREE ();
return string;
}
@@ -5640,10 +5811,36 @@ android_build_string (Lisp_Object text)
string
= (*android_java_env)->NewString (android_java_env,
characters, nchars);
- android_exception_check ();
+
+ if ((*android_java_env)->ExceptionCheck (android_java_env))
+ goto error;
SAFE_FREE ();
return string;
+
+ error:
+ /* An exception arose while creating the string. When this
+ transpires, an assumption is made that the error was induced by
+ running out of memory. Delete each of the local references
+ within AP. */
+
+ va_start (ap, text);
+
+ __android_log_print (ANDROID_LOG_WARN, __func__,
+ "Possible out of memory error. "
+ " The Java exception follows: ");
+ /* Describe exactly what went wrong. */
+ (*android_java_env)->ExceptionDescribe (android_java_env);
+ (*android_java_env)->ExceptionClear (android_java_env);
+
+ /* Now remove each and every local reference provided after
+ OBJECT. */
+
+ while ((object = va_arg (ap, jobject)))
+ ANDROID_DELETE_LOCAL_REF (object);
+
+ va_end (ap);
+ memory_full (0);
}
/* Do the same, except TEXT is constant string data in ASCII or
@@ -6154,7 +6351,7 @@ android_browse_url (Lisp_Object url, Lisp_Object send)
Lisp_Object tem;
const char *buffer;
- string = android_build_string (url);
+ string = android_build_string (url, NULL);
value
= (*android_java_env)->CallNonvirtualObjectMethod (android_java_env,
emacs_service,
@@ -6205,7 +6402,7 @@ android_restart_emacs (void)
exit (0);
}
-/* Return a number from 1 to 33 describing the version of Android
+/* Return a number from 1 to 34 describing the version of Android
Emacs is running on.
This is different from __ANDROID_API__, as that describes the
diff --git a/src/android.h b/src/android.h
index d4605c11ad0..28d9d25930e 100644
--- a/src/android.h
+++ b/src/android.h
@@ -108,7 +108,7 @@ extern void android_set_dont_focus_on_map (android_window,
bool);
extern void android_set_dont_accept_focus (android_window, bool);
extern int android_verify_jni_string (const char *);
-extern jstring android_build_string (Lisp_Object);
+extern jstring android_build_string (Lisp_Object, ...);
extern jstring android_build_jstring (const char *);
extern void android_exception_check (void);
extern void android_exception_check_1 (jobject);
diff --git a/src/androidfns.c b/src/androidfns.c
index 3ee9f7634aa..772a4f51e78 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -1591,7 +1591,8 @@ and width values are in pixels.
#endif
}
-DEFUN ("android-frame-edges", Fandroid_frame_edges, Sandroid_frame_edges, 0,
2, 0,
+DEFUN ("android-frame-edges", Fandroid_frame_edges,
+ Sandroid_frame_edges, 0, 2, 0,
doc: /* Return edge coordinates of FRAME.
FRAME must be a live frame and defaults to the selected one. The return
value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are
@@ -1693,6 +1694,28 @@ TERMINAL is a frame. */)
#endif
}
+#ifndef ANDROID_STUBIFY
+
+static void
+android_frame_restack (struct frame *f1, struct frame *f2,
+ bool above_flag)
+{
+ android_window window1;
+ struct android_window_changes wc;
+ unsigned long mask;
+
+ window1 = FRAME_ANDROID_WINDOW (f1);
+ wc.sibling = FRAME_ANDROID_WINDOW (f2);
+ wc.stack_mode = above_flag ? ANDROID_ABOVE : ANDROID_BELOW;
+ mask = ANDROID_CW_SIBLING | ANDROID_CW_STACK_MODE;
+
+ block_input ();
+ android_reconfigure_wm_window (window1, mask, &wc);
+ unblock_input ();
+}
+
+#endif /* !ANDROID_STUBIFY */
+
DEFUN ("android-frame-restack", Fandroid_frame_restack,
Sandroid_frame_restack, 2, 3, 0,
doc: /* Restack FRAME1 below FRAME2.
@@ -1709,19 +1732,25 @@ that of FRAME2. Hence the position of FRAME2 in its
display's Z
\(stacking) order relative to all other frames excluding FRAME1 remains
unaltered.
-The Android system refuses to restack windows, so this does not
-work. */)
- (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object frame3)
+Android does not facilitate restacking top-level windows managed by
+its own window manager; nor is it possible to restack frames that are
+children of different parents. Consequently, this function only
+functions when FRAME1 and FRAME2 are both child frames subordinate to
+the same parent frame. */)
+ (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above)
{
#ifdef ANDROID_STUBIFY
error ("Android cross-compilation stub called!");
return Qnil;
-#else
- /* This is not supported on Android because of limitations in the
- platform that prevent ViewGroups from restacking
- SurfaceViews. */
- return Qnil;
-#endif
+#else /* !ANDROID_STUBIFY */
+ struct frame *f1 = decode_live_frame (frame1);
+ struct frame *f2 = decode_live_frame (frame2);
+
+ if (!(FRAME_ANDROID_WINDOW (f1) && FRAME_ANDROID_WINDOW (f2)))
+ error ("Cannot restack frames");
+ android_frame_restack (f1, f2, !NILP (above));
+ return Qt;
+#endif /* ANDROID_STUBIFY */
}
DEFUN ("android-mouse-absolute-pixel-position",
diff --git a/src/androidgui.h b/src/androidgui.h
index 14225f7bf80..5fab5023ba4 100644
--- a/src/androidgui.h
+++ b/src/androidgui.h
@@ -248,6 +248,9 @@ enum android_event_type
ANDROID_CONTEXT_MENU,
ANDROID_EXPOSE,
ANDROID_INPUT_METHOD,
+ ANDROID_DND_DRAG_EVENT,
+ ANDROID_DND_URI_EVENT,
+ ANDROID_DND_TEXT_EVENT,
};
struct android_any_event
@@ -463,6 +466,7 @@ enum android_ime_operation
ANDROID_IME_END_BATCH_EDIT,
ANDROID_IME_REQUEST_SELECTION_UPDATE,
ANDROID_IME_REQUEST_CURSOR_UPDATES,
+ ANDROID_IME_REPLACE_TEXT,
};
enum
@@ -509,6 +513,28 @@ struct android_ime_event
unsigned long counter;
};
+struct android_dnd_event
+{
+ /* Type of the event. */
+ enum android_event_type type;
+
+ /* The event serial. */
+ unsigned long serial;
+
+ /* The window that gave rise to the event. */
+ android_window window;
+
+ /* X and Y coordinates of the event. */
+ int x, y;
+
+ /* Data tied to this event, such as a URI or clipboard string.
+ Must be deallocated with `free'. */
+ unsigned short *uri_or_string;
+
+ /* Length of that data. */
+ size_t length;
+};
+
union android_event
{
enum android_event_type type;
@@ -540,6 +566,11 @@ union android_event
/* This is used to dispatch input method editing requests. */
struct android_ime_event ime;
+
+ /* There is no analog under X because Android defines a strict DND
+ protocol, whereas there exist several competing X protocols
+ implemented in terms of X client messages. */
+ struct android_dnd_event dnd;
};
enum
@@ -563,6 +594,24 @@ enum android_ic_mode
ANDROID_IC_MODE_TEXT = 2,
};
+enum android_stack_mode
+ {
+ ANDROID_ABOVE = 0,
+ ANDROID_BELOW = 1,
+ };
+
+enum android_wc_value_mask
+ {
+ ANDROID_CW_SIBLING = 0,
+ ANDROID_CW_STACK_MODE = 1,
+ };
+
+struct android_window_changes
+{
+ android_window sibling;
+ enum android_stack_mode stack_mode;
+};
+
extern int android_pending (void);
extern void android_next_event (union android_event *);
extern bool android_check_if_event (union android_event *,
@@ -642,6 +691,9 @@ extern void android_bell (void);
extern void android_set_input_focus (android_window, unsigned long);
extern void android_raise_window (android_window);
extern void android_lower_window (android_window);
+extern void android_reconfigure_wm_window (android_window,
+ enum android_wc_value_mask,
+ struct android_window_changes *);
extern int android_query_tree (android_window, android_window *,
android_window *, android_window **,
unsigned int *);
diff --git a/src/androidmenu.c b/src/androidmenu.c
index ed26bdafa85..1f4d91b527d 100644
--- a/src/androidmenu.c
+++ b/src/androidmenu.c
@@ -278,7 +278,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
title_string = NULL;
if (STRINGP (title) && menu_items_n_panes < 2)
- title_string = android_build_string (title);
+ title_string = android_build_string (title, NULL);
/* Push the first local frame for the context menu. */
method = menu_class.create_context_menu;
@@ -370,7 +370,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
pane_name = Fsubstring (pane_name, make_fixnum (1), Qnil);
/* Add the pane. */
- temp = android_build_string (pane_name);
+ temp = android_build_string (pane_name, NULL);
android_exception_check ();
(*env)->CallNonvirtualVoidMethod (env, current_context_menu,
@@ -399,7 +399,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
{
/* This is a submenu. Add it. */
title_string = (!NILP (item_name)
- ? android_build_string (item_name)
+ ? android_build_string (item_name, NULL)
: NULL);
help_string = NULL;
@@ -408,7 +408,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
if (android_get_current_api_level () >= 26
&& STRINGP (help))
- help_string = android_build_string (help);
+ help_string = android_build_string (help, NULL);
store = current_context_menu;
current_context_menu
@@ -443,7 +443,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
/* Add this menu item with the appropriate state. */
title_string = (!NILP (item_name)
- ? android_build_string (item_name)
+ ? android_build_string (item_name, NULL)
: NULL);
help_string = NULL;
@@ -452,7 +452,7 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
if (android_get_current_api_level () >= 26
&& STRINGP (help))
- help_string = android_build_string (help);
+ help_string = android_build_string (help, NULL);
/* Determine whether or not to display a check box. */
@@ -686,7 +686,7 @@ android_dialog_show (struct frame *f, Lisp_Object title,
: android_build_jstring ("Question"));
/* And the title. */
- java_title = android_build_string (title);
+ java_title = android_build_string (title, NULL);
/* Now create the dialog. */
method = dialog_class.create_dialog;
@@ -738,7 +738,7 @@ android_dialog_show (struct frame *f, Lisp_Object title,
}
/* Add the button. */
- temp = android_build_string (item_name);
+ temp = android_build_string (item_name, NULL);
(*env)->CallNonvirtualVoidMethod (env, dialog,
dialog_class.class,
dialog_class.add_button,
diff --git a/src/androidselect.c b/src/androidselect.c
index cf2265d4cf4..3f025351093 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -613,10 +613,12 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
(long int) (boot_time.tv_sec / 2), id);
/* Encode all strings into their Java counterparts. */
- title1 = android_build_string (title);
- body1 = android_build_string (body);
- group1 = android_build_string (group);
- identifier1 = android_build_jstring (identifier);
+ title1 = android_build_string (title, NULL);
+ body1 = android_build_string (body, title1, NULL);
+ group1 = android_build_string (group, body1, title1, NULL);
+ identifier1
+ = (*android_java_env)->NewStringUTF (android_java_env, identifier);
+ android_exception_check_3 (title1, body1, group1);
/* Create the notification. */
notification
diff --git a/src/androidterm.c b/src/androidterm.c
index 438f8ce1fbb..9d6517cce2b 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -687,9 +687,17 @@ android_handle_ime_event (union android_event *event,
struct frame *f)
{
case ANDROID_IME_COMMIT_TEXT:
case ANDROID_IME_SET_COMPOSING_TEXT:
+ case ANDROID_IME_REPLACE_TEXT:
text = android_decode_utf16 (event->ime.text,
event->ime.length);
xfree (event->ime.text);
+
+ /* Return should text be long enough that it overflows ptrdiff_t.
+ Such circumstances are detected within android_decode_utf16. */
+
+ if (NILP (text))
+ return;
+
break;
default:
@@ -773,6 +781,12 @@ android_handle_ime_event (union android_event *event,
struct frame *f)
case ANDROID_IME_REQUEST_CURSOR_UPDATES:
android_request_cursor_updates (f, event->ime.length);
break;
+
+ case ANDROID_IME_REPLACE_TEXT:
+ replace_text (f, event->ime.start, event->ime.end,
+ text, event->ime.position,
+ event->ime.counter);
+ break;
}
}
@@ -1692,6 +1706,45 @@ handle_one_android_event (struct android_display_info
*dpyinfo,
goto OTHER;
+ case ANDROID_DND_DRAG_EVENT:
+
+ if (!any)
+ goto OTHER;
+
+ /* Generate a drag and drop event to convey its position. */
+ inev.ie.kind = DRAG_N_DROP_EVENT;
+ XSETFRAME (inev.ie.frame_or_window, any);
+ inev.ie.timestamp = ANDROID_CURRENT_TIME;
+ XSETINT (inev.ie.x, event->dnd.x);
+ XSETINT (inev.ie.y, event->dnd.y);
+ inev.ie.arg = Fcons (inev.ie.x, inev.ie.y);
+ goto OTHER;
+
+ case ANDROID_DND_URI_EVENT:
+ case ANDROID_DND_TEXT_EVENT:
+
+ if (!any)
+ {
+ free (event->dnd.uri_or_string);
+ goto OTHER;
+ }
+
+ /* An item was dropped over ANY, and is a file in the form of a
+ content or file URI or a string to be inserted. Generate an
+ event with this information. */
+
+ inev.ie.kind = DRAG_N_DROP_EVENT;
+ XSETFRAME (inev.ie.frame_or_window, any);
+ inev.ie.timestamp = ANDROID_CURRENT_TIME;
+ XSETINT (inev.ie.x, event->dnd.x);
+ XSETINT (inev.ie.y, event->dnd.y);
+ inev.ie.arg = Fcons ((event->type == ANDROID_DND_TEXT_EVENT
+ ? Qtext : Quri),
+ android_decode_utf16 (event->dnd.uri_or_string,
+ event->dnd.length));
+ free (event->dnd.uri_or_string);
+ goto OTHER;
+
default:
goto OTHER;
}
@@ -2515,7 +2568,8 @@ android_draw_fringe_bitmap (struct window *w, struct
glyph_row *row,
/* Intersect the destination rectangle with that of the row.
Setting a clip mask overrides the clip rectangles provided by
- x_clip_to_row, so clipping must be performed by hand. */
+ android_clip_to_row, so clipping must be performed by
+ hand. */
image_rect.x = p->x;
image_rect.y = p->y;
@@ -4856,6 +4910,39 @@ NATIVE_NAME (finishComposingText) (JNIEnv *env, jobject
object,
android_write_event (&event);
}
+JNIEXPORT void JNICALL
+NATIVE_NAME (replaceText) (JNIEnv *env, jobject object, jshort window,
+ jint start, jint end, jobject text,
+ int new_cursor_position, jobject attribute)
+{
+ JNI_STACK_ALIGNMENT_PROLOGUE;
+
+ union android_event event;
+ size_t length;
+
+ /* First, obtain a copy of the Java string. */
+ text = android_copy_java_string (env, text, &length);
+
+ if (!text)
+ return;
+
+ /* Next, populate the event with the information in this function's
+ arguments. */
+
+ event.ime.type = ANDROID_INPUT_METHOD;
+ event.ime.serial = ++event_serial;
+ event.ime.window = window;
+ event.ime.operation = ANDROID_IME_REPLACE_TEXT;
+ event.ime.start = start + 1;
+ event.ime.end = end + 1;
+ event.ime.length = length;
+ event.ime.position = new_cursor_position;
+ event.ime.text = text;
+ event.ime.counter = ++edit_counter;
+
+ android_write_event (&event);
+}
+
/* Structure describing the context used for a text query. */
struct android_conversion_query_context
@@ -6545,6 +6632,10 @@ Emacs is running on. */);
pdumper_do_now_and_after_load (android_set_build_fingerprint);
DEFSYM (Qx_underline_at_descent_line, "x-underline-at-descent-line");
+
+ /* Symbols defined for DND events. */
+ DEFSYM (Quri, "uri");
+ DEFSYM (Qtext, "text");
}
void
diff --git a/src/androidvfs.c b/src/androidvfs.c
index d099e4d636c..94c5d35ed2c 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -1921,6 +1921,21 @@ android_afs_open (struct android_vnode *vnode, int flags,
/* Size of the file. */
info->statb.st_size = AAsset_getLength (asset);
+ /* If the installation date can be ascertained, return that as
+ the file's modification time. */
+
+ if (timespec_valid_p (emacs_installation_time))
+ {
+#ifdef STAT_TIMESPEC
+ STAT_TIMESPEC (&info->statb, st_mtim) = emacs_installation_time;
+#else /* !STAT_TIMESPEC */
+ /* Headers supplied by the NDK r10b contain a `struct stat'
+ without POSIX fields for nano-second timestamps. */
+ info->statb.st_mtime = emacs_installation_time.tv_sec;
+ info->statb.st_mtime_nsec = emacs_installation_time.tv_nsec;
+#endif /* STAT_TIMESPEC */
+ }
+
/* Chain info onto afs_file_descriptors. */
afs_file_descriptors = info;
@@ -3980,8 +3995,11 @@ android_saf_exception_check (int n, ...)
/* First, check for an exception. */
if (!(*env)->ExceptionCheck (env))
- /* No exception has taken place. Return 0. */
- return 0;
+ {
+ /* No exception has taken place. Return 0. */
+ va_end (ap);
+ return 0;
+ }
/* Print the exception. */
(*env)->ExceptionDescribe (env);
@@ -4030,6 +4048,7 @@ android_saf_exception_check (int n, ...)
/* expression is still a local reference! */
ANDROID_DELETE_LOCAL_REF ((jobject) exception);
errno = new_errno;
+ va_end (ap);
return 1;
}
@@ -7365,6 +7384,21 @@ android_asset_fstat (struct android_fd_or_asset asset,
statb->st_uid = 0;
statb->st_gid = 0;
+ /* If the installation date can be ascertained, return that as the
+ file's modification time. */
+
+ if (timespec_valid_p (emacs_installation_time))
+ {
+#ifdef STAT_TIMESPEC
+ STAT_TIMESPEC (statb, st_mtim) = emacs_installation_time;
+#else /* !STAT_TIMESPEC */
+ /* Headers supplied by the NDK r10b contain a `struct stat'
+ without POSIX fields for nano-second timestamps. */
+ statb->st_mtime = emacs_installation_time.tv_sec;
+ statb->st_mtime_nsec = emacs_installation_time.tv_nsec;
+#endif /* STAT_TIMESPEC */
+ }
+
/* Size of the file. */
statb->st_size = AAsset_getLength (asset.asset);
return 0;
diff --git a/src/frame.h b/src/frame.h
index f4726f1c0e5..d826ae56e8b 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -90,6 +90,7 @@ enum text_conversion_operation
TEXTCONV_DELETE_SURROUNDING_TEXT,
TEXTCONV_REQUEST_POINT_UPDATE,
TEXTCONV_BARRIER,
+ TEXTCONV_REPLACE_TEXT,
};
/* Structure describing a single edit being performed by the input
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index de09ffe5fd3..3dd6390db10 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -88,7 +88,9 @@ dir_monitor_callback (GFileMonitor *monitor,
&& !NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint,
Qdeleted, Qcreated, Qmoved))))
|| (!NILP (Fmember (Qattribute_change, flags))
- && EQ (symbol, Qattribute_changed)))
+ && EQ (symbol, Qattribute_changed))
+ || (!NILP (Fmember (Qwatch_mounts, flags))
+ && EQ (symbol, Qunmounted)))
{
/* Construct an event. */
EVENT_INIT (event);
@@ -105,8 +107,8 @@ dir_monitor_callback (GFileMonitor *monitor,
/* XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg)); */
}
- /* Cancel monitor if file or directory is deleted. */
- if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved)))
+ /* Cancel monitor if file or directory is deleted or unmounted. */
+ if (!NILP (Fmember (symbol, list3 (Qdeleted, Qmoved, Qunmounted)))
&& strcmp (name, SSDATA (XCAR (XCDR (watch_object)))) == 0
&& !g_file_monitor_is_cancelled (monitor))
g_file_monitor_cancel (monitor);
diff --git a/src/image.c b/src/image.c
index 3652946077f..6e4f74c67b8 100644
--- a/src/image.c
+++ b/src/image.c
@@ -4357,6 +4357,27 @@ slurp_file (image_fd fd, ptrdiff_t *size)
return buf;
}
+/* Like slurp_file above, but with added error handling. Value is
+ null if an error occurred. Set SIZE to the size of the file.
+ IMAGE_TYPE describes the image type (e.g. "PNG"). */
+
+static char *
+slurp_image (Lisp_Object filename, ptrdiff_t *size, const char *image_type)
+{
+ image_fd fd;
+ Lisp_Object file = image_find_image_fd (filename, &fd);
+ if (!STRINGP (file))
+ {
+ image_not_found_error (filename);
+ return NULL;
+ }
+ char *result = slurp_file (fd, size);
+ if (result == NULL)
+ image_error ("Error loading %s image `%s'",
+ make_unibyte_string (image_type, strlen (image_type)),
+ file);
+ return result;
+}
/***********************************************************************
@@ -5075,22 +5096,10 @@ xbm_load (struct frame *f, struct image *img)
file_name = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (file_name))
{
- image_fd fd;
- Lisp_Object file = image_find_image_fd (file_name, &fd);
- if (!STRINGP (file))
- {
- image_not_found_error (file_name);
- return false;
- }
-
ptrdiff_t size;
- char *contents = slurp_file (fd, &size);
+ char *contents = slurp_image (file_name, &size, "XBM");
if (contents == NULL)
- {
- image_error ("Error loading XBM image `%s'", file);
- return 0;
- }
-
+ return false;
success_p = xbm_load_image (f, img, contents, contents + size);
xfree (contents);
}
@@ -6371,21 +6380,10 @@ xpm_load (struct frame *f,
file_name = image_spec_value (img->spec, QCfile, NULL);
if (STRINGP (file_name))
{
- image_fd fd;
- Lisp_Object file = image_find_image_fd (file_name, &fd);
- if (!STRINGP (file))
- {
- image_not_found_error (file_name);
- return false;
- }
-
ptrdiff_t size;
- char *contents = slurp_file (fd, &size);
+ char *contents = slurp_image (file_name, &size, "XPM");
if (contents == NULL)
- {
- image_error ("Error loading XPM image `%s'", file);
- return 0;
- }
+ return false;
success_p = xpm_load_image (f, img, contents, contents + size);
xfree (contents);
@@ -7400,21 +7398,10 @@ pbm_load (struct frame *f, struct image *img)
if (STRINGP (specified_file))
{
- image_fd fd;
- Lisp_Object file = image_find_image_fd (specified_file, &fd);
- if (!STRINGP (file))
- {
- image_not_found_error (specified_file);
- return false;
- }
-
ptrdiff_t size;
- contents = slurp_file (fd, &size);
+ contents = slurp_image (specified_file, &size, "PBM");
if (contents == NULL)
- {
- image_error ("Error reading `%s'", file);
- return 0;
- }
+ return false;
p = contents;
end = contents + size;
@@ -10304,20 +10291,9 @@ webp_load (struct frame *f, struct image *img)
if (NILP (specified_data))
{
- image_fd fd;
- file = image_find_image_fd (specified_file, &fd);
- if (!STRINGP (file))
- {
- image_not_found_error (specified_file);
- return false;
- }
-
- contents = (uint8_t *) slurp_file (fd, &size);
+ contents = (uint8_t *) slurp_image (specified_file, &size, "WebP");
if (contents == NULL)
- {
- image_error ("Error loading WebP image `%s'", file);
- return false;
- }
+ return false;
}
else
{
@@ -11724,7 +11700,7 @@ svg_load (struct frame *f, struct image *img)
if (contents == NULL)
{
image_error ("Error loading SVG image `%s'", file);
- return 0;
+ return false;
}
/* If the file was slurped into memory properly, parse it. */
if (!STRINGP (base_uri))
diff --git a/src/inotify.c b/src/inotify.c
index 105ff5a9d8a..f50b9ddcaa7 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -148,6 +148,11 @@ symbol_to_inotifymask (Lisp_Object symb)
else if (EQ (symb, Qonlydir))
return IN_ONLYDIR;
+ else if (EQ (symb, Qignored))
+ return IN_IGNORED;
+ else if (EQ (symb, Qunmount))
+ return IN_UNMOUNT;
+
else if (EQ (symb, Qt) || EQ (symb, Qall_events))
return IN_ALL_EVENTS;
else
@@ -512,12 +517,14 @@ it invalid. */)
#ifdef INOTIFY_DEBUG
DEFUN ("inotify-watch-list", Finotify_watch_list, Sinotify_watch_list, 0, 0, 0,
doc: /* Return a copy of the internal watch_list. */)
+ (void)
{
return Fcopy_sequence (watch_list);
}
DEFUN ("inotify-allocated-p", Finotify_allocated_p, Sinotify_allocated_p, 0,
0, 0,
doc: /* Return non-nil, if an inotify instance is allocated. */)
+ (void)
{
return inotifyfd < 0 ? Qnil : Qt;
}
diff --git a/src/keyboard.c b/src/keyboard.c
index f756f163e87..76dec637cb1 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4999,6 +4999,7 @@ const char *const lispy_function_keys[] =
function keys that Emacs recognizes. */
[111] = "escape",
[112] = "delete",
+ [116] = "scroll",
[120] = "sysrq",
[121] = "break",
[122] = "home",
@@ -5019,15 +5020,19 @@ const char *const lispy_function_keys[] =
[140] = "f10",
[141] = "f11",
[142] = "f12",
+ [143] = "kp-numlock",
[160] = "kp-ret",
[164] = "volume-mute",
+ [165] = "info",
[19] = "up",
[20] = "down",
+ [211] = "zenkaku-hankaku",
[213] = "muhenkan",
[214] = "henkan",
[215] = "hiragana-katakana",
[218] = "kana",
[21] = "left",
+ [223] = "sleep",
[22] = "right",
[23] = "select",
[24] = "volume-up",
@@ -5035,6 +5040,7 @@ const char *const lispy_function_keys[] =
[25] = "volume-down",
[268] = "kp-up-left",
[269] = "kp-down-left",
+ [26] = "power",
[270] = "kp-up-right",
[271] = "kp-down-right",
[272] = "media-skip-forward",
@@ -5042,7 +5048,9 @@ const char *const lispy_function_keys[] =
[277] = "cut",
[278] = "copy",
[279] = "paste",
+ [285] = "browser-refresh",
[28] = "clear",
+ [300] = "XF86Forward",
[4] = "XF86Back",
[61] = "tab",
[66] = "return",
@@ -5056,6 +5064,7 @@ const char *const lispy_function_keys[] =
[89] = "media-rewind",
[92] = "prior",
[93] = "next",
+ [95] = "mode-change",
};
#elif defined HAVE_NTGUI
diff --git a/src/kqueue.c b/src/kqueue.c
index 22c279b7ce3..43d5f40624b 100644
--- a/src/kqueue.c
+++ b/src/kqueue.c
@@ -320,13 +320,16 @@ kqueue_callback (int fd, void *data)
directory is monitored. */
if (kev.fflags & NOTE_RENAME)
actions = Fcons (Qrename, actions);
+ if (kev.fflags & NOTE_REVOKE)
+ actions = Fcons (Qrevoke, actions);
/* Create the event. */
if (! NILP (actions))
kqueue_generate_event (watch_object, actions, file, Qnil);
- /* Cancel monitor if file or directory is deleted or renamed. */
- if (kev.fflags & (NOTE_DELETE | NOTE_RENAME))
+ /* Cancel monitor if file or directory is deleted or renamed or
+ the file system is unmounted. */
+ if (kev.fflags & (NOTE_DELETE | NOTE_RENAME | NOTE_REVOKE))
Fkqueue_rm_watch (descriptor);
}
return;
@@ -351,6 +354,7 @@ following symbols:
`attrib' -- a FILE attribute was changed
`link' -- a FILE's link count was changed
`rename' -- FILE was moved to FILE1
+ `revoke' -- FILE was unmounted
When any event happens, Emacs will call the CALLBACK function passing
it a single argument EVENT, which is of the form
@@ -437,6 +441,7 @@ only when the upper directory of the renamed file is
watched. */)
if (! NILP (Fmember (Qattrib, flags))) fflags |= NOTE_ATTRIB;
if (! NILP (Fmember (Qlink, flags))) fflags |= NOTE_LINK;
if (! NILP (Fmember (Qrename, flags))) fflags |= NOTE_RENAME;
+ if (! NILP (Fmember (Qrevoke, flags))) fflags |= NOTE_REVOKE;
/* Register event. */
EV_SET (&kev, fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR,
@@ -526,6 +531,7 @@ syms_of_kqueue (void)
DEFSYM (Qattrib, "attrib"); /* NOTE_ATTRIB */
DEFSYM (Qlink, "link"); /* NOTE_LINK */
DEFSYM (Qrename, "rename"); /* NOTE_RENAME */
+ DEFSYM (Qrevoke, "revoke"); /* NOTE_REVOKE */
staticpro (&watch_list);
diff --git a/src/nsfns.m b/src/nsfns.m
index 082e06698b2..038a3fa23ad 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -3987,7 +3987,12 @@ be used as the image of the icon representing the frame.
*/);
DEFVAR_BOOL ("ns-use-proxy-icon", ns_use_proxy_icon,
doc: /* When non-nil display a proxy icon in the titlebar.
-Default is t. */);
+The proxy icon can be used to drag the file associated with the
+current buffer to other applications, a printer, the desktop, etc., in
+the same way you can from Finder. Note that you might have to disable
+`tool-bar-mode' to see the proxy icon.
+
+The default value is t. */);
ns_use_proxy_icon = true;
DEFVAR_LISP ("x-max-tooltip-size", Vx_max_tooltip_size,
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 4a86864176d..fb356c6b861 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -768,6 +768,10 @@ prettify_key (const char *key)
pressure: 0];
context_menu_value = -1;
+#ifdef NS_IMPL_COCOA
+ /* Don't let the system add a Services menu here. */
+ self.allowsContextMenuPlugIns = NO;
+#endif
[NSMenu popUpContextMenu: self withEvent: event forView: view];
retVal = context_menu_value;
context_menu_value = 0;
diff --git a/src/nsterm.m b/src/nsterm.m
index 4e0dfa58c63..11535f071eb 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -554,29 +554,32 @@ ns_init_locale (void)
/* macOS doesn't set any environment variables for the locale when run
from the GUI. Get the locale from the OS and set LANG. */
{
- NSLocale *locale = [NSLocale currentLocale];
-
NSTRACE ("ns_init_locale");
- /* If we were run from a terminal then assume an unset LANG variable
- is intentional and don't try to "fix" it. */
- if (!isatty (STDIN_FILENO))
+ /* Either use LANG, if set, or try to construct LANG from
+ NSLocale. */
+ const char *lang = getenv ("LANG");
+ if (lang == NULL || *lang == 0)
{
- char *oldLocale = setlocale (LC_ALL, NULL);
- /* It seems macOS should probably use UTF-8 everywhere.
- 'localeIdentifier' does not specify the encoding, and I can't
- find any way to get the OS to tell us which encoding to use,
- so hard-code '.UTF-8'. */
- NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8",
- [locale localeIdentifier]];
-
- /* Check the locale ID is valid and if so set LANG, but not if
- it is already set. */
- if (setlocale (LC_ALL, [localeID UTF8String]))
- setenv("LANG", [localeID UTF8String], 0);
+ const NSLocale *locale = [NSLocale currentLocale];
+ const NSString *localeID = [NSString stringWithFormat:@"%@.UTF-8",
+ [locale localeIdentifier]];
+ lang = [localeID UTF8String];
+ }
- setlocale (LC_ALL, oldLocale);
+ /* Check if LANG can be used for initializing the locale. If not,
+ use a default setting. Note that Emacs' main will undo the
+ setlocale below, initializing the locale from the
+ environment. */
+ if (setlocale (LC_ALL, lang) == NULL)
+ {
+ const char *const default_lang = "en_US.UTF-8";
+ fprintf (stderr, "LANG=%s cannot be used, using %s instead.\n",
+ lang, default_lang);
+ lang = default_lang;
}
+
+ setenv ("LANG", lang, 1);
}
@@ -6110,6 +6113,11 @@ ns_term_shutdown (int sig)
*/
+- (BOOL) applicationSupportsSecureRestorableState: (NSApplication *)app
+{
+ return YES;
+}
+
- (void) terminate: (id)sender
{
struct input_event ie;
diff --git a/src/process.c b/src/process.c
index 7f7ba8f8e9f..87ccdfda7d6 100644
--- a/src/process.c
+++ b/src/process.c
@@ -1279,7 +1279,8 @@ static void
update_process_mark (struct Lisp_Process *p)
{
Lisp_Object buffer = p->buffer;
- if (BUFFERP (buffer))
+ if (BUFFERP (buffer)
+ && XMARKER (p->mark)->buffer != XBUFFER (buffer))
set_marker_both (p->mark, buffer,
BUF_ZV (XBUFFER (buffer)),
BUF_ZV_BYTE (XBUFFER (buffer)));
@@ -2206,10 +2207,15 @@ create_process (Lisp_Object process, char **new_argv,
Lisp_Object current_dir)
inchannel = p->open_fd[READ_FROM_SUBPROCESS];
forkout = p->open_fd[SUBPROCESS_STDOUT];
-#if (defined (GNU_LINUX) || defined __ANDROID__) \
- && defined (F_SETPIPE_SZ)
- fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
-#endif /* (GNU_LINUX || __ANDROID__) && F_SETPIPE_SZ */
+#if defined(F_SETPIPE_SZ) && defined(F_GETPIPE_SZ)
+ /* If they requested larger reads than the default system pipe
+ capacity, try enlarging the capacity to match the request. */
+ if (read_process_output_max > fcntl (inchannel, F_GETPIPE_SZ))
+ {
+ int readmax = clip_to_bounds (1, read_process_output_max, INT_MAX);
+ fcntl (inchannel, F_SETPIPE_SZ, readmax);
+ }
+#endif
}
if (!NILP (p->stderrproc))
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index ffb8891d3a6..95c3366652d 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3899,6 +3899,7 @@ mutually_exclusive_charset (struct re_pattern_buffer
*bufp, re_char *p1,
struct mutexcl_data {
struct re_pattern_buffer *bufp;
re_char *p1;
+ bool unconstrained;
};
static bool
@@ -3907,7 +3908,32 @@ mutually_exclusive_one (re_char *p2, void *arg)
struct mutexcl_data *data = arg;
switch (*p2)
{
+ case succeed:
+ /* If `p1` matches, `succeed` can still match, so we should return
+ `false`. *BUT* when N iterations of `p1` and N+1 iterations of `p1`
+ match, the `succeed` that comes after N+1 always takes precedence
+ over the one after N because we always prefer a longer match, so
+ the succeed after N can actually be replaced by a "fail" without
+ changing the end result.
+ In this sense, "if `p1` matches, `succeed` can't match".
+ So we can return `true`.
+ *BUT* this only holds if we're sure that the N+1 will indeed succeed,
+ so we need to make sure there is no other matching operator between
+ the exit of the iteration and the `succeed`. */
+ return data->unconstrained;
+
+/* Remember that there may be an empty matching operator on the way.
+ If we return true, this is the "end" of this control flow path,
+ so it can't get in the way of a subsequent `succeed. */
+#define RETURN_CONSTRAIN(v) \
+ { bool tmp = (v); \
+ if (!tmp) \
+ data->unconstrained = false; \
+ return tmp; \
+ }
+
case endline:
+ RETURN_CONSTRAIN (mutually_exclusive_exactn (data->bufp, data->p1, p2));
case exactn:
return mutually_exclusive_exactn (data->bufp, data->p1, p2);
case charset:
@@ -3945,18 +3971,17 @@ mutually_exclusive_one (re_char *p2, void *arg)
return (*data->p1 == categoryspec && data->p1[1] == p2[1]);
case endbuf:
- case succeed:
return true;
case wordbeg:
- return (*data->p1 == notsyntaxspec && data->p1[1] == Sword);
+ RETURN_CONSTRAIN (*data->p1 == notsyntaxspec && data->p1[1] == Sword);
case wordend:
- return (*data->p1 == syntaxspec && data->p1[1] == Sword);
+ RETURN_CONSTRAIN (*data->p1 == syntaxspec && data->p1[1] == Sword);
case symbeg:
- return (*data->p1 == notsyntaxspec
- && (data->p1[1] == Ssymbol || data->p1[1] == Sword));
+ RETURN_CONSTRAIN (*data->p1 == notsyntaxspec
+ && (data->p1[1] == Ssymbol || data->p1[1] == Sword));
case symend:
- return (*data->p1 == syntaxspec
- && (data->p1[1] == Ssymbol || data->p1[1] == Sword));
+ RETURN_CONSTRAIN (*data->p1 == syntaxspec
+ && (data->p1[1] == Ssymbol || data->p1[1] == Sword));
case duplicate:
/* At this point, we know nothing about what this can match, sadly. */
@@ -3976,7 +4001,7 @@ static bool
mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
re_char *p2)
{
- struct mutexcl_data data = { bufp, p1 };
+ struct mutexcl_data data = { bufp, p1, true };
return forall_firstchar (bufp, p2, NULL, mutually_exclusive_one, &data);
}
diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c
index 53589078cda..e49615210eb 100644
--- a/src/sfntfont-android.c
+++ b/src/sfntfont-android.c
@@ -746,29 +746,54 @@ syms_of_sfntfont_android_for_pdumper (void)
void
init_sfntfont_android (void)
{
+ int api_level;
+
if (!android_init_gui)
return;
- /* Make sure to pick the right Sans Serif font depending on what
+ api_level = android_get_current_api_level ();
+
+ /* Make sure to pick the proper Sans Serif and Serif fonts for the
version of Android the device is running. */
- if (android_get_current_api_level () >= 15)
+
+ if (api_level >= 21)
+ /* Android 5.0 and later distribute Noto Serif in lieu of Droid
+ Serif. */
+ Vsfnt_default_family_alist
+ = list4 (Fcons (build_string ("Monospace"),
+ build_string ("Droid Sans Mono")),
+ /* Android doesn't come with a Monospace Serif font, so
+ this will have to do. */
+ Fcons (build_string ("Monospace Serif"),
+ build_string ("Droid Sans Mono")),
+ Fcons (build_string ("Sans Serif"),
+ build_string ("Roboto")),
+ Fcons (build_string ("DejaVu Serif"),
+ build_string ("Noto Serif")));
+ else if (api_level >= 15)
+ /* Android 4.0 and later distribute Roboto in lieu of Droid
+ Sans. */
Vsfnt_default_family_alist
- = list3 (Fcons (build_string ("Monospace"),
+ = list4 (Fcons (build_string ("Monospace"),
build_string ("Droid Sans Mono")),
/* Android doesn't come with a Monospace Serif font, so
this will have to do. */
Fcons (build_string ("Monospace Serif"),
build_string ("Droid Sans Mono")),
Fcons (build_string ("Sans Serif"),
- build_string ("Roboto")));
+ build_string ("Roboto")),
+ Fcons (build_string ("DejaVu Serif"),
+ build_string ("Droid Serif")));
else
Vsfnt_default_family_alist
- = list3 (Fcons (build_string ("Monospace"),
+ = list4 (Fcons (build_string ("Monospace"),
build_string ("Droid Sans Mono")),
Fcons (build_string ("Monospace Serif"),
build_string ("Droid Sans Mono")),
Fcons (build_string ("Sans Serif"),
- build_string ("Droid Sans")));
+ build_string ("Droid Sans")),
+ Fcons (build_string ("DejaVu Serif"),
+ build_string ("Droid Serif")));
/* Set up the user fonts directory. This directory is ``fonts'' in
the Emacs files directory. */
diff --git a/src/textconv.c b/src/textconv.c
index 57daa7e53b6..bd72562317f 100644
--- a/src/textconv.c
+++ b/src/textconv.c
@@ -616,6 +616,12 @@ really_commit_text (struct frame *f, EMACS_INT position,
end = max (mark, PT);
}
+ /* If it transpires that the start of the compose region is not
+ point, move point there. */
+
+ if (start != PT)
+ set_point (start);
+
/* Now delete whatever needs to go. */
del_range_1 (start, end, true, false);
@@ -635,7 +641,7 @@ really_commit_text (struct frame *f, EMACS_INT position,
record_buffer_change (start, PT, text);
}
- /* Move to a the position specified in POSITION. */
+ /* Move to the position specified in POSITION. */
if (position <= 0)
{
@@ -1154,6 +1160,135 @@ really_set_point_and_mark (struct frame *f, ptrdiff_t
point,
unbind_to (count, Qnil);
}
+/* Remove the composing region. Replace the text between START and
+ END in F's selected window with TEXT, then set point to POSITION
+ relative to it. If the mark is active, deactivate it. */
+
+static void
+really_replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end,
+ Lisp_Object text, ptrdiff_t position)
+{
+ specpdl_ref count;
+ ptrdiff_t new_start, new_end, wanted;
+ struct window *w;
+
+ /* If F's old selected window is no longer alive, fail. */
+
+ if (!WINDOW_LIVE_P (f->old_selected_window))
+ return;
+
+ count = SPECPDL_INDEX ();
+ record_unwind_protect (restore_selected_window,
+ selected_window);
+
+ /* Make the composition region markers point elsewhere. */
+
+ if (!NILP (f->conversion.compose_region_start))
+ {
+ Fset_marker (f->conversion.compose_region_start, Qnil, Qnil);
+ Fset_marker (f->conversion.compose_region_end, Qnil, Qnil);
+ f->conversion.compose_region_start = Qnil;
+ f->conversion.compose_region_end = Qnil;
+
+ /* Notify the IME of an update to the composition region,
+ inasmuch as the point might not change if START and END are
+ identical and TEXT is empty, among other circumstances. */
+
+ if (text_interface
+ && text_interface->compose_region_changed)
+ (*text_interface->compose_region_changed) (f);
+ }
+
+ /* Delete the composition region overlay. */
+
+ if (!NILP (f->conversion.compose_region_overlay))
+ Fdelete_overlay (f->conversion.compose_region_overlay);
+
+ /* Temporarily switch to F's selected window at the time of the last
+ redisplay. */
+ select_window (f->old_selected_window, Qt);
+
+ /* Sort START and END by magnitude. */
+ new_start = min (start, end);
+ new_end = max (start, end);
+
+ /* Now constrain both to the accessible region. */
+
+ if (new_start < BEGV)
+ new_start = BEGV;
+ else if (new_start > ZV)
+ new_start = ZV;
+
+ if (new_end < BEGV)
+ new_end = BEGV;
+ else if (new_end > ZV)
+ new_end = ZV;
+
+ start = new_start;
+ end = new_end;
+
+ /* This should deactivate the mark. */
+ call0 (Qdeactivate_mark);
+
+ /* Go to start. */
+ set_point (start);
+
+ /* Now delete the text in between, and save PT before TEXT is
+ inserted. */
+ del_range_1 (start, end, true, false);
+ record_buffer_change (start, start, Qt);
+ wanted = PT;
+
+ /* So long as TEXT isn't empty, insert it now. */
+
+ if (SCHARS (text))
+ {
+ /* Insert the new text. Make sure to inherit text properties
+ from the surroundings: if this doesn't happen, CC Mode
+ fontification might grow confused and become very slow. */
+
+ insert_from_string (text, 0, 0, SCHARS (text),
+ SBYTES (text), true);
+ record_buffer_change (start, PT, text);
+ }
+
+ /* Now, move point to the position designated by POSITION. */
+
+ if (position <= 0)
+ {
+ if (INT_ADD_WRAPV (wanted, position, &wanted)
+ || wanted < BEGV)
+ wanted = BEGV;
+
+ if (wanted > ZV)
+ wanted = ZV;
+
+ set_point (wanted);
+ }
+ else
+ {
+ wanted = PT;
+
+ if (INT_ADD_WRAPV (wanted, position - 1, &wanted)
+ || wanted > ZV)
+ wanted = ZV;
+
+ if (wanted < BEGV)
+ wanted = BEGV;
+
+ set_point (wanted);
+ }
+
+ /* Print some debugging information. */
+ TEXTCONV_DEBUG ("text inserted: %s, point now: %zd",
+ SSDATA (text), PT);
+
+ /* Update the ephemeral last point. */
+ w = XWINDOW (selected_window);
+ w->ephemeral_last_point = PT;
+ unbind_to (count, Qnil);
+}
+
/* Complete the edit specified by the counter value inside *TOKEN. */
static void
@@ -1325,6 +1460,13 @@ handle_pending_conversion_events_1 (struct frame *f,
if (w)
w->ephemeral_last_point = window_point (w);
break;
+
+ case TEXTCONV_REPLACE_TEXT:
+ really_replace_text (f, XFIXNUM (XCAR (data)),
+ XFIXNUM (XCAR (XCDR (data))),
+ XCAR (XCDR (XCDR (data))),
+ XFIXNUM (XCAR (XCDR (XCDR (XCDR (data))))));
+ break;
}
/* Signal success. */
@@ -1679,6 +1821,30 @@ textconv_barrier (struct frame *f, unsigned long counter)
input_pending = true;
}
+/* Remove the composing region. Replace the text between START and
+ END within F's selected window with TEXT; deactivate the mark if it
+ is active. Subsequently, set point to POSITION relative to TEXT,
+ much as `commit_text' would. */
+
+void
+replace_text (struct frame *f, ptrdiff_t start, ptrdiff_t end,
+ Lisp_Object text, ptrdiff_t position,
+ unsigned long counter)
+{
+ struct text_conversion_action *action, **last;
+
+ action = xmalloc (sizeof *action);
+ action->operation = TEXTCONV_REPLACE_TEXT;
+ action->data = list4 (make_fixnum (start), make_fixnum (end),
+ text, make_fixnum (position));
+ action->next = NULL;
+ action->counter = counter;
+ for (last = &f->conversion.actions; *last; last = &(*last)->next)
+ ;;
+ *last = action;
+ input_pending = true;
+}
+
/* Return N characters of text around point in frame F's old selected
window.
diff --git a/src/textconv.h b/src/textconv.h
index feac5b805af..c677c07e9aa 100644
--- a/src/textconv.h
+++ b/src/textconv.h
@@ -142,6 +142,9 @@ extern void delete_surrounding_text (struct frame *,
ptrdiff_t,
ptrdiff_t, unsigned long);
extern void request_point_update (struct frame *, unsigned long);
extern void textconv_barrier (struct frame *, unsigned long);
+extern void replace_text (struct frame *, ptrdiff_t, ptrdiff_t,
+ Lisp_Object, ptrdiff_t, unsigned long);
+
extern char *get_extracted_text (struct frame *, ptrdiff_t, ptrdiff_t *,
ptrdiff_t *, ptrdiff_t *, ptrdiff_t *,
ptrdiff_t *, bool *);
diff --git a/src/xdisp.c b/src/xdisp.c
index 2322ccc256a..300308e2f17 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -35545,12 +35545,10 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
note_tab_bar_highlight (f, x, y);
if (tab_bar__dragging_in_progress)
- {
cursor = FRAME_OUTPUT_DATA (f)->hand_cursor;
- goto set_cursor;
- }
else
- return;
+ cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor;
+ goto set_cursor;
}
else
{
@@ -35568,7 +35566,8 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (EQ (window, f->tool_bar_window))
{
note_tool_bar_highlight (f, x, y);
- return;
+ cursor = FRAME_OUTPUT_DATA (f)->nontext_cursor;
+ goto set_cursor;
}
#endif
@@ -37047,14 +37046,15 @@ See also `overlay-arrow-string'. */);
Voverlay_arrow_position = Qnil;
DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string,
- doc: /* String to display as an arrow in non-window frames.
+ doc: /* String to display as an arrow in text-mode frames.
See also `overlay-arrow-position'. */);
Voverlay_arrow_string = build_pure_c_string ("=>");
DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list,
doc: /* List of variables (symbols) which hold markers for overlay arrows.
The symbols on this list are examined during redisplay to determine
-where to display overlay arrows. */);
+where to display overlay arrows.
+See also `overlay-arrow-string'. */);
Voverlay_arrow_variable_list
= list1 (intern_c_string ("overlay-arrow-position"));
diff --git a/src/xterm.c b/src/xterm.c
index 18a6c51efb3..517bdf57aab 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -20297,20 +20297,23 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* See if keysym should make Emacs quit. */
- if (keysym == dpyinfo->quit_keysym
- && (xkey.time - dpyinfo->quit_keysym_time
- <= 350))
+ if (dpyinfo->quit_keysym)
{
- Vquit_flag = Qt;
- goto done_keysym;
- }
+ if (keysym == dpyinfo->quit_keysym
+ && (xkey.time - dpyinfo->quit_keysym_time
+ <= 350))
+ {
+ Vquit_flag = Qt;
+ goto done_keysym;
+ }
- if (keysym == dpyinfo->quit_keysym)
- {
- /* Otherwise, set the last time that keysym was
- pressed. */
- dpyinfo->quit_keysym_time = xkey.time;
- goto done_keysym;
+ if (keysym == dpyinfo->quit_keysym)
+ {
+ /* Otherwise, set the last time that keysym was
+ pressed. */
+ dpyinfo->quit_keysym_time = xkey.time;
+ goto done_keysym;
+ }
}
/* If not using XIM/XIC, and a compose sequence is in progress,
@@ -24227,20 +24230,23 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* See if keysym should make Emacs quit. */
- if (keysym == dpyinfo->quit_keysym
- && (xev->time - dpyinfo->quit_keysym_time
- <= 350))
+ if (dpyinfo->quit_keysym)
{
- Vquit_flag = Qt;
- goto xi_done_keysym;
- }
+ if (keysym == dpyinfo->quit_keysym
+ && (xev->time - dpyinfo->quit_keysym_time
+ <= 350))
+ {
+ Vquit_flag = Qt;
+ goto xi_done_keysym;
+ }
- if (keysym == dpyinfo->quit_keysym)
- {
- /* Otherwise, set the last time that keysym was
- pressed. */
- dpyinfo->quit_keysym_time = xev->time;
- goto xi_done_keysym;
+ if (keysym == dpyinfo->quit_keysym)
+ {
+ /* Otherwise, set the last time that keysym
+ was pressed. */
+ dpyinfo->quit_keysym_time = xev->time;
+ goto xi_done_keysym;
+ }
}
/* First deal with keysyms which have defined
diff --git a/test/lisp/erc/erc-fill-tests.el b/test/lisp/erc/erc-fill-tests.el
index b81d0c15558..f6c4c268017 100644
--- a/test/lisp/erc/erc-fill-tests.el
+++ b/test/lisp/erc/erc-fill-tests.el
@@ -31,10 +31,14 @@
(defun erc-fill-tests--insert-privmsg (speaker &rest msg-parts)
(declare (indent 1))
- (let ((msg (erc-format-privmessage speaker
- (apply #'concat msg-parts) nil t)))
- (put-text-property 0 (length msg) 'erc-command 'PRIVMSG msg)
- (erc-display-message nil nil (current-buffer) msg)))
+ (let* ((msg (erc-format-privmessage speaker
+ (apply #'concat msg-parts) nil t))
+ ;; (erc--msg-prop-overrides '((erc-msg . msg) (erc-cmd . PRIVMSG)))
+ (parsed (make-erc-response :unparsed msg :sender speaker
+ :command "PRIVMSG"
+ :command-args (list "#chan" msg)
+ :contents msg)))
+ (erc-display-message parsed nil (current-buffer) msg)))
(defun erc-fill-tests--wrap-populate (test)
(let ((original-window-buffer (window-buffer (selected-window)))
@@ -75,8 +79,8 @@
(erc-fill-tests--insert-privmsg "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.")
+ "What was done to Elbow's wife, that he hath cause to complain of?"
+ " Come me to what was done to her.")
;; Introduce an artificial gap in properties `line-prefix' and
;; `wrap-prefix' and later ensure they're not incremented twice.
@@ -111,6 +115,14 @@
(should (get-text-property (pos-bol) 'line-prefix))
(should (get-text-property (1- (pos-eol)) 'line-prefix))
(should-not (get-text-property (pos-eol) 'line-prefix))
+ ;; Spans entire line uninterrupted.
+ (let* ((val (get-text-property (pos-bol) 'line-prefix))
+ (end (text-property-not-all (pos-bol) (point-max)
+ 'line-prefix val)))
+ (when (and (/= end (pos-eol)) (= ?? (char-before end)))
+ (setq end (text-property-not-all (1+ end) (point-max)
+ 'line-prefix val)))
+ (should (eq end (pos-eol))))
(should (equal (get-text-property (pos-bol) 'wrap-prefix)
'(space :width erc-fill--wrap-value)))
(should-not (get-text-property (pos-eol) 'wrap-prefix))
@@ -145,7 +157,7 @@
(number-to-string erc-fill--wrap-value)
(prin1-to-string got))))
(with-current-buffer (generate-new-buffer name)
- (push name erc-fill-tests--buffers)
+ (push (current-buffer) erc-fill-tests--buffers)
(with-silent-modifications
(insert (setq got (read repr))))
(erc-mode))
@@ -153,15 +165,31 @@
(with-temp-file expect-file
(insert repr))
(if (file-exists-p expect-file)
- ;; Compare set-equal over intervals. This comparison is
- ;; less useful for messages treated by other modules because
- ;; it doesn't compare "nested" props belonging to
- ;; string-valued properties, like timestamps.
- (should (equal-including-properties
- (read repr)
- (read (with-temp-buffer
- (insert-file-contents-literally expect-file)
- (buffer-string)))))
+ ;; Ensure string-valued properties, like timestamps, aren't
+ ;; recursive (signals `max-lisp-eval-depth' exceeded).
+ (named-let assert-equal
+ ((latest (read repr))
+ (expect (read (with-temp-buffer
+ (insert-file-contents-literally expect-file)
+ (buffer-string)))))
+ (pcase latest
+ ((or "" 'nil) t)
+ ((pred stringp)
+ (should (equal-including-properties latest expect))
+ (let ((latest-intervals (object-intervals latest))
+ (expect-intervals (object-intervals expect)))
+ (while-let ((l-iv (pop latest-intervals))
+ (x-iv (pop expect-intervals))
+ (l-tab (map-into (nth 2 l-iv) 'hash-table))
+ (x-tab (map-into (nth 2 x-iv) 'hash-table)))
+ (pcase-dolist (`(,l-k . ,l-v) (map-pairs l-tab))
+ (assert-equal l-v (gethash l-k x-tab))
+ (remhash l-k x-tab))
+ (should (zerop (hash-table-count x-tab))))))
+ ((pred sequencep)
+ (assert-equal (seq-first latest) (seq-first expect))
+ (assert-equal (seq-rest latest) (seq-rest expect)))
+ (_ (should (equal latest expect)))))
(message "Snapshot file missing: %S" expect-file)))))
;; To inspect variable pitch, set `erc-mode-hook' to
@@ -206,6 +234,13 @@
(erc-fill-tests--wrap-check-prefixes "*** " "<alice> " "<bob> ")
(erc-fill-tests--compare "monospace-04-reset")))))
+(defun erc-fill-tests--simulate-refill ()
+ ;; Simulate `erc-fill-wrap-refill-buffer' synchronously and without
+ ;; a progress reporter.
+ (save-excursion
+ (with-silent-modifications
+ (erc-fill--wrap-rejigger-region (point-min) erc-insert-marker nil nil))))
+
(ert-deftest erc-fill-wrap--merge ()
:tags '(:unstable)
(unless (>= emacs-major-version 29)
@@ -217,7 +252,9 @@
(erc-update-channel-member
"#chan" "Dummy" "Dummy" t nil nil nil nil nil "fake" "~u" nil nil t)
- ;; Set this here so that the first few messages are from 1970
+ ;; Set this here so that the first few messages are from 1970.
+ ;; Following the current date stamp, the speaker isn't merged
+ ;; even though it's continued: "<bob> zero."
(let ((erc-fill-tests--time-vals (lambda () 1680332400)))
(erc-fill-tests--insert-privmsg "bob" "zero.")
(erc-fill-tests--insert-privmsg "alice" "one.")
@@ -239,7 +276,12 @@
(erc-fill-tests--wrap-check-prefixes
"*** " "<alice> " "<bob> "
"<bob> " "<alice> " "<alice> " "<bob> " "<bob> " "<Dummy> " "<Dummy> ")
- (erc-fill-tests--compare "merge-02-right")))))
+ (erc-fill-tests--compare "merge-02-right")
+
+ (ert-info ("Command `erc-fill-wrap-refill-buffer' is idempotent")
+ (kill-buffer (pop erc-fill-tests--buffers))
+ (erc-fill-tests--simulate-refill) ; idempotent
+ (erc-fill-tests--compare "merge-02-right"))))))
(ert-deftest erc-fill-wrap--merge-action ()
:tags '(:unstable)
diff --git a/test/lisp/erc/erc-scenarios-log.el
b/test/lisp/erc/erc-scenarios-log.el
index fd030d90c2f..f7e7d61c92e 100644
--- a/test/lisp/erc/erc-scenarios-log.el
+++ b/test/lisp/erc/erc-scenarios-log.el
@@ -81,6 +81,7 @@
(ert-deftest erc-scenarios-log--clear-stamp ()
:tags '(:expensive-test)
+ (require 'erc-stamp)
(erc-scenarios-common-with-cleanup
((erc-scenarios-common-dialog "base/assoc/bouncer-history")
(dumb-server (erc-d-run "localhost" t 'foonet))
diff --git a/test/lisp/erc/erc-scenarios-match.el
b/test/lisp/erc/erc-scenarios-match.el
index cd899fddb98..17f7649566e 100644
--- a/test/lisp/erc/erc-scenarios-match.el
+++ b/test/lisp/erc/erc-scenarios-match.el
@@ -55,7 +55,8 @@
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
;; The "match type" is `current-nick'.
(funcall expect 5 "tester")
(should (eq (get-text-property (1- (point)) 'font-lock-face)
@@ -91,7 +92,8 @@
:nick "tester")
;; Module `timestamp' follows `match' in insertion hooks.
(should (memq 'erc-add-timestamp
- (memq 'erc-match-message erc-insert-modify-hook)))
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
(funcall expect 5 "This server is in debug mode")))
(ert-info ("Ensure lines featuring \"bob\" are invisible")
@@ -132,7 +134,7 @@
;; Leading stamp has combined `invisible' property value.
(should (equal (get-text-property (pos-bol) 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; Message proper has the `invisible' property `match-fools'.
(let ((msg-beg (next-single-property-change (pos-bol) 'invisible)))
@@ -151,29 +153,13 @@
(= (next-single-property-change msg-beg 'invisible nil (pos-eol))
(pos-eol))))))))
-(defun erc-scenarios-match--find-bol ()
- (save-excursion
- (should (get-text-property (1- (point)) 'erc-command))
- (goto-char (should (previous-single-property-change (point) 'erc-command)))
- (pos-bol)))
-
-(defun erc-scenarios-match--find-eol ()
- (save-excursion
- (if-let ((next (next-single-property-change (point) 'erc-command)))
- (goto-char next)
- ;; We're already at the end of the message.
- (should (get-text-property (1- (point)) 'erc-command)))
- (pos-eol)))
-
;; In most cases, `erc-hide-fools' makes line endings invisible.
(defun erc-scenarios-match--stamp-right-fools-invisible ()
- :tags '(:expensive-test)
(let ((erc-insert-timestamp-function #'erc-insert-timestamp-right))
(erc-scenarios-match--invisible-stamp
(lambda ()
- (let ((beg (erc-scenarios-match--find-bol))
- (end (erc-scenarios-match--find-eol)))
+ (pcase-let ((`(,beg . ,end) (erc--get-inserted-msg-bounds)))
;; The end of the message is a newline.
(should (= ?\n (char-after end)))
@@ -182,7 +168,7 @@
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- end) 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; The final newline is hidden by `match', not `stamps'
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
@@ -198,14 +184,14 @@
;; It ends just before the timestamp.
(let ((msg-end (next-single-property-change (pos-bol) 'invisible)))
(should (equal (get-text-property msg-end 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; Stamp's `invisible' property extends throughout the stamp
;; and ends before the trailing newline.
(should (= (next-single-property-change msg-end 'invisible) end)))))
(lambda ()
- (let ((end (erc-scenarios-match--find-eol)))
+ (let ((end (erc--get-inserted-msg-bounds 'end)))
;; This message has a time stamp like all the others.
(should (eq (field-at-pos (1- end)) 'erc-timestamp))
@@ -244,7 +230,7 @@
;; Stamps have a combined `invisible' property value.
(should (equal (get-text-property (1- (pos-eol)) 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; The message proper has the `invisible' property `match-fools',
;; which starts at the preceding newline...
@@ -253,7 +239,7 @@
;; ... and ends just before the timestamp.
(let ((msgend (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (equal (get-text-property msgend 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; The newline before `erc-insert-marker' is still visible.
(should-not (get-text-property (pos-eol) 'invisible))
@@ -271,7 +257,172 @@
(let ((inv-beg (next-single-property-change (1- (pos-bol)) 'invisible)))
(should (eq (get-text-property inv-beg 'invisible) 'timestamp)))))))
-(defun erc-scenarios-match--stamp-both-invisible-fill-static ()
+(defun erc-scenarios-match--fill-wrap-stamp-dedented-p (point)
+ (pcase (get-text-property point 'line-prefix)
+ (`(space :width (- erc-fill--wrap-value (,n)))
+ (if (display-graphic-p) (< 100 n 200) (< 10 n 30)))
+ (`(space :width (- erc-fill--wrap-value ,n))
+ (< 10 n 30))))
+
+(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap ()
+
+ ;; Rewind the clock to known date artificially. We should probably
+ ;; use a ticks/hz cons on 29+.
+ (let ((erc-stamp--current-time 704591940)
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (bob-utterance-counter 0))
+
+ (erc-scenarios-match--invisible-stamp
+
+ (lambda ()
+ (ert-info ("Baseline check")
+ ;; False date printed initially before anyone speaks.
+ (when (zerop bob-utterance-counter)
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "[Wed Apr 29 1992]")
+ ;; First stamp in a buffer is not invisible from previous
+ ;; newline (before stamp's own leading newline).
+ (should (= 4 (match-beginning 0)))
+ (should (get-text-property 3 'invisible))
+ (should-not (get-text-property 2 'invisible))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p 4))
+ (search-forward "[23:59]"))))
+
+ (ert-info ("Line endings in Bob's messages are invisible")
+ ;; The message proper has the `invisible' property `match-fools'.
+ (should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mend))
+ (should-not (field-at-pos mbeg))
+
+ (when (= bob-utterance-counter 1)
+ (let ((right-stamp (field-end mbeg)))
+ (should (eq 'erc-timestamp (field-at-pos right-stamp)))
+ (should (= mend (field-end right-stamp)))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp))))
+
+ ;; The `erc-ts' property is present in prop stack.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+
+ ;; Line ending has the `invisible' property `match-fools'.
+ (should (eq (get-text-property mbeg 'invisible) 'match-fools))
+ (should-not (get-text-property mend 'invisible))))
+
+ ;; Only the message right after Alice speaks contains stamps.
+ (when (= 1 bob-utterance-counter)
+
+ (ert-info ("Date stamp occupying previous line is invisible")
+ (should (eq 'match-fools (get-text-property (point) 'invisible)))
+ (save-excursion
+ (forward-line -1)
+ (goto-char (pos-bol))
+ (should (looking-at (rx "[Mon May 4 1992]")))
+ (ert-info ("Stamp's NL `invisible' as fool, not timestamp")
+ (let ((end (match-end 0)))
+ (should (eq (char-after end) ?\n))
+ (should (eq 'timestamp
+ (get-text-property (1- end) 'invisible)))
+ (should (eq 'match-fools
+ (get-text-property end 'invisible)))))
+ (should (erc-scenarios-match--fill-wrap-stamp-dedented-p (point)))
+ ;; Date stamp has a combined `invisible' property value
+ ;; that starts at the previous message's trailing newline
+ ;; and extends until the start of the message proper.
+ (should (equal ?\n (char-before (point))))
+ (should (equal ?\n (char-before (1- (point)))))
+ (let ((val (get-text-property (- (point) 2) 'invisible)))
+ (should (equal val 'timestamp))
+ (should (= (text-property-not-all (- (point) 2) (point-max)
+ 'invisible val)
+ (pos-eol))))))
+
+ (ert-info ("Current message's RHS stamp is hidden")
+ ;; Right stamp has `match-fools' property.
+ (save-excursion
+ (should-not (field-at-pos (point)))
+ (should (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp)))
+
+ ;; Stamp invisibility starts where message's ends.
+ (let ((msgend (next-single-property-change (pos-bol) 'invisible)))
+ ;; Stamp has a combined `invisible' property value.
+ (should (equal (get-text-property msgend 'invisible)
+ '(match-fools timestamp)))
+
+ ;; Combined `invisible' property spans entire timestamp.
+ (should (= (next-single-property-change msgend 'invisible)
+ (pos-eol))))))
+
+ (cl-incf bob-utterance-counter))
+
+ ;; Alice.
+ (lambda ()
+ ;; Set clock ahead a week or so.
+ (setq erc-stamp--current-time 704962800)
+
+ ;; This message has no time stamp and is completely visible.
+ (should-not (eq (field-at-pos (1- (pos-eol))) 'erc-timestamp))
+ (should-not (next-single-property-change (pos-bol) 'invisible))))))
+
+;; This asserts that speaker hiding by `erc-fill-wrap-merge' doesn't
+;; take place after a series of hidden fool messages with an
+;; intervening outgoing message followed immediately by a non-fool
+;; message from the last non-hidden speaker (other than the user).
+(ert-deftest erc-scenarios-match--hide-fools/stamp-both/fill-wrap/speak ()
+
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "match/fools")
+ (erc-stamp--current-time 704591940)
+ (dumb-server (erc-d-run "localhost" t 'fill-wrap))
+ (erc-stamp--tz t)
+ (erc-fill-function #'erc-fill-wrap)
+ (port (process-contact dumb-server :service))
+ (erc-server-flood-penalty 0.1)
+ (erc-timestamp-only-if-changed-flag nil)
+ (erc-fools '("bob"))
+ (erc-text-matched-hook '(erc-hide-fools))
+ (erc-autojoin-channels-alist '((FooNet "#chan")))
+ (expect (erc-d-t-make-expecter)))
+
+ (ert-info ("Connect")
+ (with-current-buffer (erc :server "127.0.0.1"
+ :port port
+ :full-name "tester"
+ :password "changeme"
+ :nick "tester")
+ ;; Module `timestamp' follows `match' in insertion hooks.
+ (should (memq 'erc-add-timestamp
+ (memq 'erc-match-message
+ (default-value 'erc-insert-modify-hook))))
+ (funcall expect 5 "This server is in debug mode")))
+
+ (ert-info ("Ensure lines featuring \"bob\" are invisible")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (should (funcall expect 10 "<alice> None better than"))
+ (should (funcall expect 10 "<alice> bob: Still we went"))
+ (should (funcall expect 10 "<bob> alice: Give me your hand"))
+ (erc-scenarios-common-say "hey")
+ (should (funcall expect 10 "<bob> You have paid the heavens"))
+ (should (funcall expect 10 "<alice> bob: In the sick air"))
+ (should (funcall expect 10 "<alice> The web of our life"))
+
+ ;; Regression (see leading comment).
+ (should-not (equal "" (get-text-property (pos-bol) 'display)))
+
+ ;; No remaining meta-data positions, no more timestamps.
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
+ ;; No remaining invisible messages.
+ (should-not (text-property-not-all (pos-bol) erc-insert-marker
+ 'invisible nil))
+
+ (should (funcall expect 10 "ERC>"))
+ (should-not (get-text-property (pos-bol) 'invisible))
+ (should-not (get-text-property (point) 'invisible))))))
+
+(defun erc-scenarios-match--stamp-both-invisible-fill-static (assert-ds)
(should (eq erc-insert-timestamp-function
#'erc-insert-timestamp-left-and-right))
@@ -295,21 +446,20 @@
(ert-info ("Line endings in Bob's messages are invisible")
;; The message proper has the `invisible' property `match-fools'.
(should (eq (get-text-property (pos-bol) 'invisible) 'match-fools))
- (let* ((mbeg (next-single-property-change (pos-bol) 'erc-command))
- (mend (next-single-property-change mbeg 'erc-command)))
+ (pcase-let ((`(,mbeg . ,mend) (erc--get-inserted-msg-bounds)))
- (if (/= 1 bob-utterance-counter)
- (should-not (field-at-pos mend))
+ (should (= (char-after mend) ?\n))
+ (should-not (field-at-pos mbeg))
+ (should-not (field-at-pos mend))
+ (when (= 1 bob-utterance-counter)
;; For Bob's stamped message, check newline after stamp.
- (should (eq (field-at-pos mend) 'erc-timestamp))
- (setq mend (field-end mend)))
+ (should (eq (field-at-pos (field-end mbeg)) 'erc-timestamp))
+ (should (eq (field-at-pos (1- mend)) 'erc-timestamp)))
- ;; The `erc-timestamp' property spans entire messages,
- ;; including stamps and filled text, which makes for
- ;; convenient traversal when `erc-stamp-mode' is enabled.
- (should (get-text-property (pos-bol) 'erc-timestamp))
- (should (= (next-single-property-change (pos-bol) 'erc-timestamp)
- mend))
+ ;; The `erc-ts' property is present in the message's
+ ;; width 1 prop collection at its first char.
+ (should (get-text-property (pos-bol) 'erc-ts))
+ (should-not (next-single-property-change (1+ (pos-bol)) 'erc-ts))
;; Line ending has the `invisible' property `match-fools'.
(should (= (char-after mend) ?\n))
@@ -327,12 +477,8 @@
(forward-line -1)
(goto-char (pos-bol))
(should (looking-at (rx "[Mon May 4 1992]")))
- ;; Date stamp has a combined `invisible' property value
- ;; that extends until the start of the message proper.
- (should (equal (get-text-property (point) 'invisible)
- '(timestamp match-fools)))
- (should (= (next-single-property-change (point) 'invisible)
- (1+ (pos-eol))))))
+ (should (= ?\n (char-after (- (point) 2)))) ; welcome!\n
+ (funcall assert-ds))) ; "assert date stamp"
(ert-info ("Folding preserved despite invisibility")
;; Message has a trailing time stamp, but it's been folded
@@ -346,7 +492,7 @@
(let ((msgend (next-single-property-change (pos-bol) 'invisible)))
;; Stamp has a combined `invisible' property value.
(should (equal (get-text-property msgend 'invisible)
- '(timestamp match-fools)))
+ '(match-fools timestamp)))
;; Combined `invisible' property spans entire timestamp.
(should (= (next-single-property-change msgend 'invisible)
@@ -365,13 +511,45 @@
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static ()
:tags '(:expensive-test)
- (erc-scenarios-match--stamp-both-invisible-fill-static))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that starts from the
+ ;; newline delimiting the current and previous messages and
+ ;; extends until the stamp's final newline. It is not combined
+ ;; with the old value, `match-fools'.
+ (let ((delim-pos (- (point) 2)))
+ (should (equal 'timestamp (get-text-property delim-pos 'invisible)))
+ ;; Stamp-only invisibility ends before its last newline.
+ (should (= (text-property-not-all delim-pos (point-max)
+ 'invisible 'timestamp)
+ (match-end 0))))))) ; pos-eol
(ert-deftest erc-scenarios-match--stamp-both-invisible-fill-static--nooffset ()
:tags '(:expensive-test)
(with-suppressed-warnings ((obsolete erc-legacy-invisible-bounds-p))
(should-not erc-legacy-invisible-bounds-p)
+
(let ((erc-legacy-invisible-bounds-p t))
- (erc-scenarios-match--stamp-both-invisible-fill-static))))
+ (erc-scenarios-match--stamp-both-invisible-fill-static
+
+ (lambda ()
+ ;; Date stamp has an `invisible' property that covers its
+ ;; format string exactly. It is not combined with the old
+ ;; value, `match-fools'.
+ (let ((delim-prev (- (point) 2)))
+ (should-not (get-text-property delim-prev 'invisible))
+ (should (eq 'erc-timestamp (field-at-pos (point))))
+ (should (= (next-single-property-change delim-prev 'invisible)
+ (field-beginning (point))))
+ (should (equal 'timestamp
+ (get-text-property (1- (point)) 'invisible)))
+ ;; Field stops before final newline because the date stamp
+ ;; is (now, as of ERC 5.6) its own standalone message.
+ (should (= ?\n (char-after (field-end (point)))))
+ ;; Stamp-only invisibility includes last newline.
+ (should (= (text-property-not-all (1- (point)) (point-max)
+ 'invisible 'timestamp)
+ (1+ (field-end (point)))))))))))
;;; erc-scenarios-match.el ends here
diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el
b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el
index 7d256bf711b..68ea0b1b070 100644
--- a/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el
+++ b/test/lisp/erc/erc-scenarios-scrolltobottom-relaxed.el
@@ -1,4 +1,4 @@
-;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-relaxed -*-
lexical-binding: t -*-
+;;; erc-scenarios-scrolltobottom-relaxed.el --- erc-scrolltobottom-all relaxed
-*- lexical-binding: t -*-
;; Copyright (C) 2023 Free Software Foundation, Inc.
@@ -40,8 +40,7 @@
(dumb-server (erc-d-run "localhost" t 'help))
(port (process-contact dumb-server :service))
(erc-modules `(scrolltobottom fill-wrap ,@erc-modules))
- (erc-scrolltobottom-all t)
- (erc-scrolltobottom-relaxed t)
+ (erc-scrolltobottom-all 'relaxed)
(erc-server-flood-penalty 0.1)
(expect (erc-d-t-make-expecter))
lower upper)
diff --git a/test/lisp/erc/erc-scenarios-scrolltobottom.el
b/test/lisp/erc/erc-scenarios-scrolltobottom.el
index dd0a8612388..206687ccab5 100644
--- a/test/lisp/erc/erc-scenarios-scrolltobottom.el
+++ b/test/lisp/erc/erc-scenarios-scrolltobottom.el
@@ -35,7 +35,7 @@
(should-not erc-scrolltobottom-all)
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion doesn't anchor prompt in other window")
(let ((w (next-window)))
@@ -52,7 +52,7 @@
(let ((erc-scrolltobottom-all t))
- (erc-scenarios-scrolltobottom--normal
+ (erc-scenarios-common-scrolltobottom--normal
(lambda ()
(ert-info ("New insertion anchors prompt in other window")
(let ((w (next-window)))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index 46a05729066..cc61d599387 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -279,7 +279,7 @@
(should-not erc-echo-timestamps)
(should-not erc-stamp--last-stamp)
- (insert (propertize "abc" 'erc-timestamp 433483200))
+ (insert (propertize "a" 'erc-ts 433483200 'erc-msg 'msg) "bc")
(goto-char (point-min))
(let ((inhibit-message t)
(erc-echo-timestamp-format "%Y-%m-%d %H:%M:%S %Z")
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 05d45b2d027..4f4662f5075 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -292,7 +292,9 @@
(cl-incf counter))))
erc-accidental-paste-threshold-seconds
erc-insert-modify-hook
- erc--input-review-functions
+ (erc-modules (remq 'stamp erc-modules))
+ (erc-send-input-line-function #'ignore)
+ (erc--input-review-functions erc--input-review-functions)
erc-send-completed-hook)
(ert-info ("Server buffer")
@@ -356,7 +358,11 @@
(should (looking-back "#chan@ServNet 11> "))
(should (= (point) erc-input-marker))
(insert "/query bob")
- (erc-send-current-line)
+ (let (erc-modules)
+ (erc-send-current-line))
+ ;; Last command not inserted
+ (save-excursion (forward-line -1)
+ (should (looking-at "<tester> Howdy")))
;; Query does not redraw (nor /help, only message input)
(should (looking-back "#chan@ServNet 11> "))
;; No sign of old prompts
@@ -793,18 +799,15 @@
(should (erc--valid-local-channel-p "&local")))))
(ert-deftest erc--restore-initialize-priors ()
- ;; This `pcase' expands to 100+k. Guess we could do something like
- ;; (and `(,_ ((,e . ,_) . ,_) . ,_) v) first and then return a
- ;; (equal `(if-let* ((,e ...)...)...) v) to cut it down to < 1k.
(should (pcase (macroexpand-1 '(erc--restore-initialize-priors erc-my-mode
foo (ignore 1 2 3)
- bar #'spam))
- (`(if-let* ((,e (or erc--server-reconnecting erc--target-priors))
- ((alist-get 'erc-my-mode ,e)))
- (setq foo (alist-get 'foo ,e)
- bar (alist-get 'bar ,e))
- (setq foo (ignore 1 2 3)
- bar #'spam))
+ bar #'spam
+ baz nil))
+ (`(let* ((,p (or erc--server-reconnecting erc--target-priors))
+ (,q (and ,p (alist-get 'erc-my-mode ,p))))
+ (setq foo (if ,q (alist-get 'foo ,p) (ignore 1 2 3))
+ bar (if ,q (alist-get 'bar ,p) #'spam)
+ baz (if ,q (alist-get 'baz ,p) nil)))
t))))
(ert-deftest erc--target-from-string ()
@@ -877,11 +880,12 @@
(with-current-buffer (get-buffer-create "*#fake*")
(erc-mode)
(erc-tests--send-prep)
+ (setq erc-server-current-nick "tester")
(setq-local erc-last-input-time 0)
(should-not (local-variable-if-set-p 'erc-send-completed-hook))
(set (make-local-variable 'erc-send-completed-hook) nil) ; skip t (globals)
;; Just in case erc-ring-mode is already on
- (setq-local erc--input-review-functions nil)
+ (setq-local erc--input-review-functions erc--input-review-functions)
(add-hook 'erc--input-review-functions #'erc-add-to-input-ring)
;;
(cl-letf (((symbol-function 'erc-process-input-line)
@@ -1056,43 +1060,6 @@
(should (equal '("" "" "") (split-string "\n\n" p)))
(should (equal '("" "" "") (split-string "\n\r" p)))))
-(ert-deftest erc--blank-in-multiline-input-p ()
- (let ((check (lambda (s)
- (erc--blank-in-multiline-input-p
- (split-string s erc--input-line-delim-regexp)))))
-
- (ert-info ("With `erc-send-whitespace-lines'")
- (let ((erc-send-whitespace-lines t))
- (should (funcall check ""))
- (should-not (funcall check "\na"))
- (should-not (funcall check "/msg a\n")) ; real /cmd
- (should-not (funcall check "a\n\nb")) ; "" allowed
- (should-not (funcall check "/msg a\n\nb")) ; non-/cmd
- (should-not (funcall check " "))
- (should-not (funcall check "\t"))
- (should-not (funcall check "a\nb"))
- (should-not (funcall check "a\n "))
- (should-not (funcall check "a\n \t"))
- (should-not (funcall check "a\n \f"))
- (should-not (funcall check "a\n \nb"))
- (should-not (funcall check "a\n \t\nb"))
- (should-not (funcall check "a\n \f\nb"))))
-
- (should (funcall check ""))
- (should (funcall check " "))
- (should (funcall check "\t"))
- (should (funcall check "a\n\nb"))
- (should (funcall check "a\n\nb"))
- (should (funcall check "a\n "))
- (should (funcall check "a\n \t"))
- (should (funcall check "a\n \f"))
- (should (funcall check "a\n \nb"))
- (should (funcall check "a\n \t\nb"))
-
- (should-not (funcall check "a\rb"))
- (should-not (funcall check "a\nb"))
- (should-not (funcall check "a\r\nb"))))
-
(defun erc-tests--with-process-input-spy (test)
(with-current-buffer (get-buffer-create "FakeNet")
(let* ((erc--input-review-functions
@@ -1138,7 +1105,7 @@
(delete-region (point) (point-max))
(insert "one\n")
(let ((e (should-error (erc-send-current-line))))
- (should (equal "Blank line - ignoring..." (cadr e))))
+ (should (string-prefix-p "Trailing line detected" (cadr e))))
(goto-char (point-max))
(ert-info ("Input remains untouched")
(should (save-excursion (goto-char erc-input-marker)
@@ -1180,6 +1147,137 @@
(should (consp erc-last-input-time)))))
+(ert-deftest erc--discard-trailing-multiline-nulls ()
+ (pcase-dolist (`(,input ,want) '((("") (""))
+ (("" "") (""))
+ (("a") ("a"))
+ (("a" "") ("a"))
+ (("" "a") ("" "a"))
+ (("" "a" "") ("" "a"))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (let ((s (make-erc--input-split :lines input)))
+ (erc--discard-trailing-multiline-nulls s)
+ (should (equal (erc--input-split-lines s) want))))))
+
+(ert-deftest erc--count-blank-lines ()
+ (pcase-dolist (`(,input ,want) '((() (0 0 0))
+ (("") (1 1 0))
+ (("" "") (2 1 1))
+ (("" "" "") (3 1 2))
+ ((" " "") (2 0 1))
+ ((" " "" "") (3 0 2))
+ (("" " " "") (3 1 1))
+ (("" "" " ") (3 2 0))
+ (("a") (0 0 0))
+ (("a" "") (1 0 1))
+ (("a" " " "") (2 0 1))
+ (("a" "" "") (2 0 2))
+ (("a" "b") (0 0 0))
+ (("a" "" "b") (1 1 0))
+ (("a" " " "b") (1 0 0))
+ (("" "a") (1 1 0))
+ ((" " "a") (1 0 0))
+ (("" "a" "") (2 1 1))
+ (("" " " "a" "" " ") (4 2 0))
+ (("" " " "a" "" " " "") (5 2 1))))
+ (ert-info ((format "Input: %S, want: %S" input want))
+ (should (equal (erc--count-blank-lines input) want)))))
+
+;; Opt `wb': `erc-warn-about-blank-lines'
+;; Opt `sw': `erc-send-whitespace-lines'
+;; `s': " \n",`a': "a\n",`b': "b\n"
+(defvar erc-tests--check-prompt-input--expect
+ ;; opts "" " " "\n" "\n " " \n" "\n\n" "a\n" "a\n " "a\n \nb"
+ '(((+wb -sw) err err err err err err err err err)
+ ((-wb -sw) nop nop nop nop nop nop nop nop nop)
+ ((+wb +sw) err (s) (0 s) (1 s s) (s) (0 s) (0 a) (a s) (a s b))
+ ((-wb +sw) nop (s) (s) (s s) (s) (s) (a) (a s) (a s b))))
+
+;; Help messages echoed (not IRC message) was emitted
+(defvar erc-tests--check-prompt-input-messages
+ '("Stripping" "Padding"))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks ()
+ (erc-tests--with-process-input-spy
+ (lambda (next)
+ (erc-tests--set-fake-server-process "sleep" "1")
+ (should-not erc-send-whitespace-lines)
+ (should erc-warn-about-blank-lines)
+
+ (pcase-dolist (`((,wb ,sw) . ,ex) erc-tests--check-prompt-input--expect)
+ (let ((print-escape-newlines t)
+ (erc-warn-about-blank-lines (eq wb '+wb))
+ (erc-send-whitespace-lines (eq sw '+sw))
+ (samples '("" " " "\n" "\n " " \n" "\n\n"
+ "a\n" "a\n " "a\n \nb")))
+ (setq ex `(,@ex (a) (a b)) ; baseline, same for all combos
+ samples `(,@samples "a" "a\nb"))
+ (dolist (input samples)
+ (insert input)
+ (ert-info ((format "Opts: %S, Input: %S, want: %S"
+ (list wb sw) input (car ex)))
+ (ert-with-message-capture messages
+ (pcase-exhaustive (pop ex)
+ ('err (let ((e (should-error (erc-send-current-line))))
+ (should (string-match (rx (| "trailing" "blank"))
+ (cadr e))))
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('nop (erc-send-current-line)
+ (should (equal (erc-user-input) input))
+ (should-not (funcall next)))
+ ('clr (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (should-not (funcall next)))
+ ((and (pred consp) v)
+ (erc-send-current-line)
+ (should (string-empty-p (erc-user-input)))
+ (setq v (reverse v)) ; don't use `nreverse' here
+ (while v
+ (pcase (pop v)
+ ((and (pred integerp) n)
+ (should (string-search
+ (nth n erc-tests--check-prompt-input-messages)
+ messages)))
+ ('s (should (equal " \n" (car (funcall next)))))
+ ('a (should (equal "a\n" (car (funcall next)))))
+ ('b (should (equal "b\n" (car (funcall next)))))))
+ (should-not (funcall next))))))
+ (delete-region erc-input-marker (point-max))))))))
+
+(ert-deftest erc--check-prompt-input-for-multiline-blanks/explanations ()
+ (should erc-warn-about-blank-lines)
+ (should-not erc-send-whitespace-lines)
+
+ (let ((erc-send-whitespace-lines t))
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Padding (1) blank line")
+ (("" " ") "Padding (1) blank line")
+ ((" " "") "Stripping (1) blank line")
+ (("a" "") "Stripping (1) blank line")
+ (("" "") "Stripping (1) and padding (1) blank lines")
+ (("" "" "") "Stripping (2) and padding (1) blank lines")
+ (("" "a" "" "b" "" "c" "" "")
+ "Stripping (2) and padding (3) blank lines")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let (erc--check-prompt-explanation)
+ (should-not (erc--check-prompt-input-for-multiline-blanks nil input))
+ (should (equal (list msg) erc--check-prompt-explanation))))))
+
+ (pcase-dolist (`(,input ,msg)
+ '((("") "Blank line detected")
+ (("" " ") "2 blank lines detected")
+ ((" " "") "2 blank (1 trailing) lines detected")
+ (("a" "") "Trailing line detected")
+ (("" "") "2 blank (1 trailing) lines detected")
+ (("a" "" "") "2 trailing lines detected")
+ (("" "a" "" "b" "" "c" "" "")
+ "5 blank (2 trailing) lines detected")))
+ (ert-info ((format "Input: %S, Msg: %S" input msg))
+ (let ((rv (erc--check-prompt-input-for-multiline-blanks nil input)))
+ (should (equal (concat msg " (see `erc-send-whitespace-lines')")
+ rv ))))))
+
(ert-deftest erc-send-whitespace-lines ()
(erc-tests--with-process-input-spy
(lambda (next)
@@ -1196,7 +1294,7 @@
(erc-bol)
(should (eq (point) (point-max))))
(should (equal (funcall next) '("two\n" nil t)))
- (should (equal (funcall next) '("\n" nil t)))
+ (should (equal (funcall next) '(" \n" nil t)))
(should (equal (funcall next) '("one\n" nil t))))
(ert-info ("Multiline hunk with trailing newline filtered")
@@ -1218,17 +1316,12 @@
(should-not (funcall next)))
(ert-info ("Multiline command with trailing blank filtered")
- (pcase-dolist (`(,p . ,q)
- '(("/a b\r" "/a b\n") ("/a b\n" "/a b\n")
- ("/a b\n\n" "/a b\n") ("/a b\r\n" "/a b\n")
- ("/a b\n\n\n" "/a b\n")))
+ (dolist (p '("/a b" "/a b\n" "/a b\n\n" "/a b\n\n\n"))
(insert p)
(erc-send-current-line)
(erc-bol)
(should (eq (point) (point-max)))
- (while q
- (should (pcase (funcall next)
- (`(,cmd ,_ nil) (equal cmd (pop q))))))
+ (should (pcase (funcall next) (`(,cmd ,_ nil) (equal cmd "/a b\n"))))
(should-not (funcall next))))
(ert-info ("Multiline command with non-blanks errors")
@@ -1341,6 +1434,44 @@
(should-not calls))))))
+(ert-deftest erc--order-text-properties-from-hash ()
+ (let ((table (map-into '((a . 1)
+ (erc-ts . 0)
+ (erc-msg . s005)
+ (b . 2)
+ (erc-cmd . 5)
+ (c . 3))
+ 'hash-table)))
+ (with-temp-buffer
+ (erc-mode)
+ (insert "abc\n")
+ (add-text-properties 1 2 (erc--order-text-properties-from-hash table))
+ (should (equal '( erc-msg s005
+ erc-ts 0
+ erc-cmd 5
+ a 1
+ b 2
+ c 3)
+ (text-properties-at (point-min)))))))
+
+(ert-deftest erc--check-msg-prop ()
+ (let ((erc--msg-props (map-into '((a . 1) (b . x)) 'hash-table)))
+ (should (eq 1 (erc--check-msg-prop 'a)))
+ (should (erc--check-msg-prop 'a 1))
+ (should-not (erc--check-msg-prop 'a 2))
+
+ (should (eq 'x (erc--check-msg-prop 'b)))
+ (should (erc--check-msg-prop 'b 'x))
+ (should-not (erc--check-msg-prop 'b 1))
+
+ (should (erc--check-msg-prop 'a '(1 42)))
+ (should-not (erc--check-msg-prop 'a '(2 42)))
+
+ (let ((props '(42 x)))
+ (should (erc--check-msg-prop 'b props)))
+ (let ((v '(42 y)))
+ (should-not (erc--check-msg-prop 'b v)))))
+
(defmacro erc-tests--equal-including-properties (a b)
(list (if (< emacs-major-version 29)
'ert-equal-including-properties
@@ -1385,6 +1516,175 @@
(when noninteractive
(kill-buffer))))
+(ert-deftest erc--remove-from-prop-value-list ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'b)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'y)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x))
+ 1 2 (erc-test e)
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'd)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'f)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'e)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'z)
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i y))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'x)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test g)
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i y)))))
+ (erc--remove-from-prop-value-list 1 2 'erc-test 'g) ; narrowed
+ (erc--remove-from-prop-value-list 3 4 'erc-test 'i) ; narrowed
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test y))))
+
+ ;; Pathological (,c) case (hopefully not created by ERC)
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(k))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'k)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl" 0 1 (erc-test (j x)))))
+
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest erc--remove-from-prop-value-list/many ()
+ (with-current-buffer (get-buffer-create "*erc-test*")
+ ;; Non-list match.
+ (insert "abc\n")
+ (put-text-property 1 2 'erc-test 'a)
+ (put-text-property 2 3 'erc-test 'b)
+ (put-text-property 3 4 'erc-test 'c)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc"
+ 0 1 (erc-test a)
+ 1 2 (erc-test b)
+ 2 3 (erc-test c))))
+
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(a b))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test 'a)
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("abc" 2 3 (erc-test c))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(c))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "abc"))
+
+ ;; List match.
+ (goto-char (point-min))
+ (insert "def\n")
+ (put-text-property 1 2 'erc-test '(d x y))
+ (put-text-property 2 3 'erc-test '(e y))
+ (put-text-property 3 4 'erc-test '(f z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test (d x y))
+ 1 2 (erc-test (e y))
+ 2 3 (erc-test (f z)))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(d y f))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("def"
+ 0 1 (erc-test x)
+ 1 2 (erc-test e)
+ 2 3 (erc-test z))))
+ (erc--remove-from-prop-value-list 1 4 'erc-test '(e z x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) "def"))
+
+ ;; Narrowed beg.
+ (goto-char (point-min))
+ (insert "ghi\n")
+ (put-text-property 1 2 'erc-test '(g x))
+ (put-text-property 2 3 'erc-test '(h x))
+ (put-text-property 3 4 'erc-test '(i x))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 0 1 (erc-test (g x))
+ 1 2 (erc-test (h x))
+ 2 3 (erc-test (i x)))))
+ (erc--remove-from-prop-value-list 1 3 'erc-test '(x g i))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("ghi"
+ 1 2 (erc-test h)
+ 2 3 (erc-test (i x)))))
+
+ ;; Narrowed middle.
+ (goto-char (point-min))
+ (insert "jkl\n")
+ (put-text-property 1 2 'erc-test '(j x))
+ (put-text-property 2 3 'erc-test '(k))
+ (put-text-property 3 4 'erc-test '(l y z))
+ (erc--remove-from-prop-value-list 3 4 'erc-test '(k x y z))
+ (should (erc-tests--equal-including-properties
+ (buffer-substring 1 4) #("jkl"
+ 0 1 (erc-test (j x))
+ 1 2 (erc-test (k))
+ 2 3 (erc-test l))))
+
+ (when noninteractive
+ (kill-buffer))))
+
(ert-deftest erc--split-string-shell-cmd ()
;; Leading and trailing space
@@ -2155,14 +2455,14 @@
'( :erc-insert-modify-hook (erc-controls-highlight ; 0
erc-button-add-buttons ; 30
- erc-fill ; 40
erc-match-message ; 50
- erc-add-timestamp) ; 60
+ erc-fill ; 60
+ erc-add-timestamp) ; 70
:erc-send-modify-hook ( erc-controls-highlight ; 0
erc-button-add-buttons ; 30
erc-fill ; 40
- erc-add-timestamp)))) ; 50
+ erc-add-timestamp)))) ; 70
(ert-deftest erc-migrate-modules ()
(should (equal (erc-migrate-modules '(autojoin timestamp button))
@@ -2203,65 +2503,130 @@
(should (eq (erc--find-group 'smiley nil) 'erc))
(should (eq (erc--find-group 'unmorse nil) 'erc)))
-(ert-deftest erc--update-modules ()
- (let (calls
- erc-modules
- erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+(ert-deftest erc--sort-modules ()
+ (should (equal (erc--sort-modules '(networks foo fill bar fill stamp bar))
+ ;; Third-party mods appear in original order.
+ '(fill networks stamp foo bar))))
+
+(defun erc-tests--update-modules (fn)
+ (let* ((calls nil)
+ (custom-modes nil)
+ (on-load nil)
+
+ (get-calls (lambda () (prog1 (nreverse calls) (setq calls nil))))
+
+ (add-onload (lambda (m k v)
+ (put (intern m) 'erc--feature k)
+ (push (cons k (lambda () (funcall v m))) on-load)))
+
+ (mk-cmd (lambda (module)
+ (let ((mode (intern (format "erc-%s-mode" module))))
+ (fset mode (lambda (n) (push (cons mode n) calls))))))
- ;; This `lbaz' module is unknown, so ERC looks for it via the
- ;; symbol proerty `erc--feature' and, failing that, by
- ;; `require'ing its "erc-" prefixed symbol.
- (should-not (intern-soft "erc-lbaz-mode"))
+ (mk-builtin (lambda (module-string)
+ (let ((s (intern module-string)))
+ (put s 'erc--module s))))
+
+ (mk-global (lambda (module)
+ (push (intern (format "erc-%s-mode" module))
+ custom-modes))))
(cl-letf (((symbol-function 'require)
(lambda (s &rest _)
- (when (eq s 'erc--lbaz-feature)
- (fset (intern "erc-lbaz-mode") ; local module
- (lambda (n) (push (cons 'lbaz n) calls))))
- (push s calls)))
-
- ;; Local modules
- ((symbol-function 'erc-lbar-mode)
- (lambda (n) (push (cons 'lbar n) calls)))
- ((get 'lbaz 'erc--feature) 'erc--lbaz-feature)
-
- ;; Global modules
- ((symbol-function 'erc-gfoo-mode)
- (lambda (n) (push (cons 'gfoo n) calls)))
- ((get 'erc-gfoo-mode 'standard-value) 'ignore)
+ ;; Simulate library being loaded, things defined.
+ (when-let ((h (alist-get s on-load))) (funcall h))
+ (push (cons 'req s) calls)))
+
+ ;; Spoof global module detection.
+ ((symbol-function 'custom-variable-p)
+ (lambda (v) (memq v custom-modes))))
+
+ (funcall fn get-calls add-onload mk-cmd mk-builtin mk-global))
+ (should-not erc--aberrant-modules)))
+
+(ert-deftest erc--update-modules/unknown ()
+ (erc-tests--update-modules
+
+ (lambda (get-calls _ mk-cmd _ mk-global)
+
+ (ert-info ("Baseline")
+ (let* ((erc-modules '(foo))
+ (obarray (obarray-make))
+ (err (should-error (erc--update-modules erc-modules))))
+ (should (equal (cadr err) "`foo' is not a known ERC module"))
+ (should (equal (funcall get-calls)
+ `((req . ,(intern-soft "erc-foo")))))))
+
+ ;; Module's mode command exists but lacks an associated file.
+ (ert-info ("Bad autoload flagged as suspect")
+ (should-not erc--aberrant-modules)
+ (let* ((erc--aberrant-modules nil)
+ (obarray (obarray-make))
+ (erc-modules (list (intern "foo"))))
+
+ ;; Create a mode activation command.
+ (funcall mk-cmd "foo")
+
+ ;; Make the mode var global.
+ (funcall mk-global "foo")
+
+ ;; No local modules to return.
+ (should-not (erc--update-modules erc-modules))
+ (should (equal (mapcar #'prin1-to-string erc--aberrant-modules)
+ '("foo")))
+ ;; ERC requires the library via prefixed module name.
+ (should (equal (mapcar #'prin1-to-string (funcall get-calls))
+ `("(req . erc-foo)" "(erc-foo-mode . 1)"))))))))
+
+;; A local module (here, `lo2') lacks a mode toggle, so ERC tries to
+;; load its defining library, first via the symbol property
+;; `erc--feature', and then via an "erc-" prefixed symbol.
+(ert-deftest erc--update-modules/local ()
+ (erc-tests--update-modules
+
+ (lambda (get-calls add-onload mk-cmd mk-builtin mk-global)
+
+ (let* ((obarray (obarray-make 20))
+ (erc-modules (mapcar #'intern '("glo" "lo1" "lo2"))))
+
+ ;; Create a global and a local module.
+ (mapc mk-cmd '("glo" "lo1"))
+ (mapc mk-builtin '("glo" "lo1"))
+ (funcall mk-global "glo")
+ (funcall add-onload "lo2" 'explicit-feature-lib mk-cmd)
+
+ ;; Returns local modules.
+ (should (equal (mapcar #'symbol-name (erc--update-modules erc-modules))
+ '("erc-lo2-mode" "erc-lo1-mode")))
+
+ ;; Requiring `erc-lo2' defines `erc-lo2-mode'.
+ (should (equal (mapcar #'prin1-to-string (funcall get-calls))
+ `("(erc-glo-mode . 1)"
+ "(req . explicit-feature-lib)")))))))
+
+(ert-deftest erc--update-modules/realistic ()
+ (let ((calls nil)
+ ;; Module `pcomplete' "resolves" to `completion'.
+ (erc-modules '(pcomplete autojoin networks)))
+ (cl-letf (((symbol-function 'require)
+ (lambda (s &rest _) (push (cons 'req s) calls)))
+
+ ;; Spoof global module detection.
+ ((symbol-function 'custom-variable-p)
+ (lambda (v)
+ (memq v '(erc-autojoin-mode erc-networks-mode
+ erc-completion-mode))))
+ ;; Mock and spy real builtins.
((symbol-function 'erc-autojoin-mode)
(lambda (n) (push (cons 'autojoin n) calls)))
- ((get 'erc-autojoin-mode 'standard-value) 'ignore)
((symbol-function 'erc-networks-mode)
(lambda (n) (push (cons 'networks n) calls)))
- ((get 'erc-networks-mode 'standard-value) 'ignore)
((symbol-function 'erc-completion-mode)
- (lambda (n) (push (cons 'completion n) calls)))
- ((get 'erc-completion-mode 'standard-value) 'ignore))
-
- (ert-info ("Unknown module")
- (setq erc-modules '(lfoo))
- (should-error (erc--update-modules))
- (should (equal (pop calls) 'erc-lfoo))
- (should-not calls))
+ (lambda (n) (push (cons 'completion n) calls))))
- (ert-info ("Local modules")
- (setq erc-modules '(gfoo lbar lbaz))
- ;; Don't expose the mode here
- (should (equal (mapcar #'symbol-name (erc--update-modules))
- '("erc-lbaz-mode" "erc-lbar-mode")))
- ;; Lbaz required because unknown.
- (should (equal (nreverse calls) '((gfoo . 1) erc--lbaz-feature)))
- (fmakunbound (intern "erc-lbaz-mode"))
- (unintern (intern "erc-lbaz-mode") obarray)
- (setq calls nil))
-
- (ert-info ("Global modules") ; `pcomplete' resolved to `completion'
- (setq erc-modules '(pcomplete autojoin networks))
- (should-not (erc--update-modules)) ; no locals
- (should (equal (nreverse calls)
- '((completion . 1) (autojoin . 1) (networks . 1))))
- (setq calls nil)))))
+ (should-not (erc--update-modules erc-modules)) ; no locals
+ (should (equal (nreverse calls)
+ '((completion . 1) (autojoin . 1) (networks . 1)))))))
(ert-deftest erc--merge-local-modes ()
(cl-letf (((get 'erc-b-mode 'erc-module) 'b)
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
index c62a22a11c7..4c2b1d61e24 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/barnet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.barnet.org 001 tester :Welcome to the barnet IRC Network tester")
(0 ":irc.barnet.org 002 tester :Your host is irc.barnet.org, running version
oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.barnet.org 003 tester :This server was created Tue, 04 May 2021
05:06:19 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.barnet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.barnet.org 221 tester +i")
(0 ":irc.barnet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@jnu48g2wrycbw.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@mike joe tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620104779")
(0.1 ":mike!~u@kd7gmjbnbkn8c.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
index f30b7deca11..bfa324642ce 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
+++ b/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
@@ -1,7 +1,7 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
-((nick 1 "NICK tester"))
-((user 1 "USER user 0 * :tester")
+((pass 10 "PASS :changeme"))
+((nick 10 "NICK tester"))
+((user 10 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
(0 ":irc.foonet.org 002 tester :Your host is irc.foonet.org, running version
oragono-2.6.0-7481bf0385b95b16")
(0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021
05:06:18 UTC")
@@ -18,16 +18,16 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
-((join 2 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
index 686a47f68a3..04959954c4f 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/barnet-drop.eld
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.barnet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
(0 ":irc.barnet.org 353 tester = #chan :@joe mike tester")
(0 ":irc.barnet.org 366 tester #chan :End of NAMES list")
(0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!")
(0 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.barnet.org 324 tester #chan +nt")
(0 ":irc.barnet.org 329 tester #chan 1620805269")
(0.1 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: But you have outfaced
them all.")
diff --git a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
index b99621cc311..d0445cd1dd5 100644
--- a/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
+++ b/test/lisp/erc/resources/base/netid/bouncer/foonet-drop.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :foonet:changeme"))
+((pass 10 "PASS :foonet:changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
@@ -22,14 +22,14 @@
(0 ":irc.znc.in 306 tester :You have been marked as being away")
(0 ":irc.foonet.org 305 tester :You are no longer marked as being away"))
-((join 1 "JOIN #chan")
+((join 10 "JOIN #chan")
(0 ":tester!~u@ertp7idh9jtgi.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :@alice bob tester")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!")
(0 ":bob!~u@ertp7idh9jtgi.irc PRIVMSG #chan :tester, welcome!"))
-((mode 1 "MODE #chan")
+((mode 10 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805271")
(0.1 ":alice!~u@ertp7idh9jtgi.irc PRIVMSG #chan :bob: He cannot be heard of.
Out of doubt he is transported.")
diff --git a/test/lisp/erc/resources/erc-d/erc-d.el
b/test/lisp/erc/resources/erc-d/erc-d.el
index b86769220dd..f072c6b93b2 100644
--- a/test/lisp/erc/resources/erc-d/erc-d.el
+++ b/test/lisp/erc/resources/erc-d/erc-d.el
@@ -254,7 +254,7 @@ return a replacement.")
(ending (process-get process :dialog-ending))
(dialog (make-erc-d-dialog :name name
:process process
- :queue (make-ring 5)
+ :queue (make-ring 10)
:exchanges (make-ring 10)
:match-handlers mat-h
:server-fqdn fqdn)))
@@ -292,33 +292,27 @@ With int SKIP, advance past that many exchanges."
(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
-(defmacro erc-d--m (process format-string &rest args)
- "Output ARGS using FORMAT-STRING somewhere depending on context.
-PROCESS should be a client connection or a server network process."
- `(let ((format-string (if erc-d--m-debug
- (concat (format-time-string "%s.%N: ")
- ,format-string)
- ,format-string))
- (want-insert (and ,process erc-d--in-process))
- (buffer (process-buffer (process-get ,process :server))))
- (when (and want-insert (buffer-live-p buffer))
- (with-current-buffer buffer
- (goto-char (point-max))
- (insert (concat (format ,format-string ,@args) "\n"))))
- (when (or erc-d--m-debug (not want-insert))
- (message format-string ,@args))))
-
-(defmacro erc-d--log (process string &optional outbound)
- "Log STRING sent to (OUTBOUND) or received from PROCESS peer."
- `(let ((id (or (process-get ,process :log-id)
- (let ((port (erc-d-u--get-remote-port ,process)))
- (process-put ,process :log-id port)
- port)))
- (name (erc-d-dialog-name (process-get ,process :dialog))))
- (if ,outbound
- (erc-d--m process "-> %s:%s %s" name id ,string)
- (dolist (line (split-string ,string (process-get process :ending)))
- (erc-d--m process "<- %s:%s %s" name id line)))))
+(defun erc-d--m (process format-string &rest args)
+ "Output ARGS using FORMAT-STRING to PROCESS's buffer or elsewhere."
+ (when erc-d--m-debug
+ (setq format-string (concat (format-time-string "%s.%N: ") format-string)))
+ (let ((insertp (and process erc-d--in-process))
+ (buffer (process-buffer (process-get process :server))))
+ (when (and insertp (buffer-live-p buffer))
+ (princ (concat (apply #'format format-string args) "\n") buffer))
+ (when (or erc-d--m-debug (not insertp))
+ (apply #'message format-string args))))
+
+(defun erc-d--log (process string &optional outbound)
+ "Log STRING received from or OUTBOUND to PROCESS peer."
+ (let ((id (or (process-get process :log-id)
+ (let ((port (erc-d-u--get-remote-port process)))
+ (process-put process :log-id port) port)))
+ (name (erc-d-dialog-name (process-get process :dialog))))
+ (if outbound
+ (erc-d--m process "-> %s:%s %s" name id string)
+ (dolist (line (split-string string (process-get process :ending)))
+ (erc-d--m process "<- %s:%s %s" name id line)))))
(defun erc-d--log-process-event (server process msg)
(erc-d--m server "%s: %s" process (string-trim-right msg)))
diff --git a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
index 4855c178861..e5532980644 100644
--- a/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
+++ b/test/lisp/erc/resources/erc-d/resources/dynamic-foonet.eld
@@ -24,7 +24,7 @@
(0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com
@%+bob!~bob@example.org")
(0 ":irc.foonet.org 366 alice #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 3 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620805269")
(0.1 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: Yes, a dozen; and as
many to the vantage, as would store the world they played for.")
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index 19f26bf08bd..5354b300b47 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -341,7 +341,7 @@ See Info node `(emacs) Term Mode' for the various commands."
;;;; Fixtures
-(defun erc-scenarios-scrolltobottom--normal (test)
+(defun erc-scenarios-common-scrolltobottom--normal (test)
(erc-scenarios-common-with-noninteractive-in-term
((erc-scenarios-common-dialog "scrolltobottom")
(dumb-server (erc-d-run "localhost" t 'help))
@@ -402,6 +402,7 @@ See Info node `(emacs) Term Mode' for the various commands."
(erc-cmd-MSG "NickServ help register")
(save-excursion (erc-d-t-search-for 10 "End of NickServ"))
(should (= 1 (point)))
+ (redisplay)
(should (zerop (count-screen-lines (window-start) (window-point))))
(should (erc-scenarios-common--prompt-past-win-end-p)))
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 689bacc7012..238d8cc73c2 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +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<alic [...]
\ No newline at end of file
+#("\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<alic [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index 9fa23a7d332..d1ce9198e69 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +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<alic [...]
\ No newline at end of file
+#("\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<alic [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index a3d533c87b5..d70184724ba 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +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
+#("\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/monospace-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +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" 2 20
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
+#("\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" 2 3 (erc-msg
datestamp erc-ts 0 field erc-ti [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index e675695f660..be3e2b33cfd 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +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" 2 20
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
+#("\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" 2 3 (erc-msg
datestamp erc-ts 0 field erc-ti [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index a6070c2e3ff..098257d0b49 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +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" 2 20
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
+#("\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" 2 3 (erc-msg
datestamp erc-ts 0 field erc-ti [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index 80c9e1d80f5..def97738ce6 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +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" 2 20
(erc-timestamp 0 line-prefix (space :wi [...]
\ No newline at end of file
+#("\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" 2 3 (erc-msg
datestamp erc-ts 0 field erc-ti [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 2b8766c27f4..360b3dafafd 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +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<bob> This
buffer is for text.\n*** one two th [...]
\ No newline at end of file
+#("\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<bob> This
buffer is for text.\n*** one two th [...]
diff --git a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
index f62b65cd170..cd3537d3c94 100644
--- a/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/stamps-left-01.eld
@@ -1 +1 @@
-#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned
mistress is dead, or she's outprized by a trifle.\n" 2 9 (erc-timestamp 0
display (#4=(margin left-margi [...]
\ No newline at end of file
+#("\n\n[00:00]*** 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.\n[00:00]<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[00:00]<bob> alice: Either your unparagoned
mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc-msg unknown
erc-ts 0 display #3=(#5=(margi [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
b/test/lisp/erc/resources/match/fools/fill-wrap.eld
similarity index 51%
copy from test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
copy to test/lisp/erc/resources/match/fools/fill-wrap.eld
index f30b7deca11..dff75ef9cd2 100644
--- a/test/lisp/erc/resources/base/assoc/multi-net/foonet.eld
+++ b/test/lisp/erc/resources/match/fools/fill-wrap.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 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
@@ -7,7 +7,7 @@
(0 ":irc.foonet.org 003 tester :This server was created Tue, 04 May 2021
05:06:18 UTC")
(0 ":irc.foonet.org 004 tester irc.foonet.org oragono-2.6.0-7481bf0385b95b16
BERTZios CEIMRUabefhiklmnoqstuv Iabefhkloqv")
(0 ":irc.foonet.org 005 tester AWAYLEN=390 BOT=B CASEMAPPING=ascii
CHANLIMIT=#:100 CHANMODES=Ibe,k,fl,CEMRUimnstu CHANNELLEN=64 CHANTYPES=#
ELIST=U EXCEPTS EXTBAN=,m FORWARD=f INVEX KICKLEN=390 :are supported by this
server")
- (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100
NETWORK=foonet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
+ (0 ":irc.foonet.org 005 tester MAXLIST=beI:60 MAXTARGETS=4 MODES MONITOR=100
NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ STATUSMSG=~&@%+
TARGMAX=NAMES:1,LIST:1,KICK:1,WHOIS:1,USERHOST:10,PRIVMSG:4,TAGMSG:4,NOTICE:4,MONITOR:100
TOPICLEN=390 UTF8MAPPING=rfc8265 UTF8ONLY WHOX :are supported by this server")
(0 ":irc.foonet.org 005 tester draft/CHATHISTORY=100 :are supported by this
server")
(0 ":irc.foonet.org 251 tester :There are 0 users and 3 invisible on 1
server(s)")
(0 ":irc.foonet.org 252 tester 0 :IRC Operators online")
@@ -18,28 +18,24 @@
(0 ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
(0 ":irc.foonet.org 422 tester :MOTD File is missing"))
-((mode-user 8 "MODE tester +i")
+((mode-user 10 "MODE tester +i")
(0 ":irc.foonet.org 221 tester +i")
(0 ":irc.foonet.org NOTICE tester :This server is in debug mode and is
logging all user I/O. If you do not wish for everything you send to be readable
by the server owner(s), please disconnect."))
-((join 2 "JOIN #chan")
+((join 6 "JOIN #chan")
(0 ":tester!~u@9g6b728983yd2.irc JOIN #chan")
(0 ":irc.foonet.org 353 tester = #chan :alice tester @bob")
(0 ":irc.foonet.org 366 tester #chan :End of NAMES list"))
-((mode 2 "MODE #chan")
+((mode 5 "MODE #chan")
(0 ":irc.foonet.org 324 tester #chan +nt")
(0 ":irc.foonet.org 329 tester #chan 1620104779")
(0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :tester, welcome!")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: But, as it seems, did
violence on herself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Well, this is the
forest of Arden.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Signior Iachimo will
not from it. Pray, let us follow 'em.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Our queen and all her
elves come here anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: The ground is bloody;
search about the churchyard.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: You have discharged
this honestly: keep it to yourself. Many likelihoods informed me of this
before, which hung so tottering in the balance that I could neither believe nor
misdoubt. Pray you, leave me: stall this in your bosom; and I thank you for
your honest care. I will speak with you further anon.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me that mattock,
and the wrenching iron.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Stand you! You have
land enough of your own; but he added to your having, gave you some ground.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Excellent workman! Thou
canst not paint a man so bad as is thyself.")
- (0.1 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: And will you, being a
man of your breeding, be married under a bush, like a beggar ? Get you to
church, and have a good priest that can tell you what marriage is: this fellow
will but join you together as they join wainscot; then one of you will prove a
shrunk panel, and like green timber, warp, warp.")
- (0.1 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Live, and be
prosperous; and farewell, good fellow."))
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :None better than to let him
fetch off his drum, which you hear him so confidently undertake to do.")
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: Still we went coupled and
inseparable.")
+ (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :alice: Give me your hand. This
hand is moist, my lady."))
+
+((privmsg 5 "PRIVMSG #chan :hey")
+ (0 ":bob!~u@rz2v467q4rwhy.irc PRIVMSG #chan :You have paid the heavens your
function, and the prisoner the very debt of your calling. I have laboured for
the poor gentleman to the extremest shore of my modesty; but my brother justice
have I found so severe, that he hath forced me to tell him he is indeed
Justice.")
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :bob: In the sick air: let not
thy sword skip one.")
+ (0 ":alice!~u@rz2v467q4rwhy.irc PRIVMSG #chan :The web of our life is of a
mingled yarn, good and ill together: our virtues would be proud if our faults
whipped them not; and our crimes would despair if they were not cherished by
our virtues."))
diff --git a/test/lisp/erc/resources/sasl/scram-sha-1.eld
b/test/lisp/erc/resources/sasl/scram-sha-1.eld
index 49980e9e12a..d6adf529c5d 100644
--- a/test/lisp/erc/resources/sasl/scram-sha-1.eld
+++ b/test/lisp/erc/resources/sasl/scram-sha-1.eld
@@ -42,6 +42,6 @@
(0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
(0 ":jaguar.test 376 jilles :End of message of the day."))
-((mode-user 1.2 "MODE jilles +i")
+((mode-user 10 "MODE jilles +i")
(0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
(0 ":jaguar.test 306 jilles :You have been marked as being away"))
diff --git a/test/lisp/erc/resources/sasl/scram-sha-256.eld
b/test/lisp/erc/resources/sasl/scram-sha-256.eld
index 74de9a23ecf..8b16f7109cf 100644
--- a/test/lisp/erc/resources/sasl/scram-sha-256.eld
+++ b/test/lisp/erc/resources/sasl/scram-sha-256.eld
@@ -42,6 +42,6 @@
(0 ":jaguar.test 372 jilles : ~~ or rkpryyrag gb rnpu bgure ~~")
(0 ":jaguar.test 376 jilles :End of message of the day."))
-((mode-user 1.2 "MODE jilles +i")
+((mode-user 10 "MODE jilles +i")
(0 ":jilles!~jilles@127.0.0.1 MODE jilles :+ri")
(0 ":jaguar.test 306 jilles :You have been marked as being away"))
diff --git a/test/lisp/eshell/em-script-tests.el
b/test/lisp/eshell/em-script-tests.el
index 74328844778..02e4125d827 100644
--- a/test/lisp/eshell/em-script-tests.el
+++ b/test/lisp/eshell/em-script-tests.el
@@ -63,6 +63,19 @@
"\\`\\'"))
(should (equal (buffer-string) "hibye")))))
+(ert-deftest em-script-test/source-script/background ()
+ "Test sourcing a script in the background."
+ (skip-unless (executable-find "echo"))
+ (ert-with-temp-file temp-file
+ :text "*echo hi\nif {[ foo = foo ]} {*echo bye}"
+ (eshell-with-temp-buffer bufname "old"
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "source %s > #<%s> &" temp-file bufname)
+ "\\`\\'")
+ (eshell-wait-for-subprocess t))
+ (should (equal (buffer-string) "hi\nbye\n")))))
+
(ert-deftest em-script-test/source-script/arg-vars ()
"Test sourcing script with $0, $1, ... variables."
(ert-with-temp-file temp-file :text "printnl $0 \"$1 $2\""
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index 643038f89ff..e0783b26ad6 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -104,6 +104,32 @@ bug#59469."
"value\nexternal\nvalue\n")))
+;; Background command invocation
+
+(ert-deftest esh-cmd-test/background/simple-command ()
+ "Test invocation with a simple background command."
+ (skip-unless (executable-find "echo"))
+ (eshell-with-temp-buffer bufname ""
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "*echo hi > #<%s> &" bufname)
+ (rx "[echo" (? ".exe") "] " (+ digit) "\n"))
+ (eshell-wait-for-subprocess t))
+ (should (equal (buffer-string) "hi\n"))))
+
+(ert-deftest esh-cmd-test/background/subcommand ()
+ "Test invocation with a background command containing subcommands."
+ (skip-unless (and (executable-find "echo")
+ (executable-find "rev")))
+ (eshell-with-temp-buffer bufname ""
+ (with-temp-eshell
+ (eshell-match-command-output
+ (format "*echo ${*echo hello | rev} > #<%s> &" bufname)
+ (rx "[echo" (? ".exe") "] " (+ digit) "\n"))
+ (eshell-wait-for-subprocess t))
+ (should (equal (buffer-string) "olleh\n"))))
+
+
;; Lisp forms
(ert-deftest esh-cmd-test/quoted-lisp-form ()
@@ -453,8 +479,7 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"echo hi; (throw 'tag 42); echo bye"))
42))
(should (eshell-match-output "\\`hi\n\\'"))
- (should-not eshell-current-command)
- (should-not eshell-last-async-procs)
+ (should-not eshell-foreground-command)
;; Make sure we can call another command after throwing.
(eshell-match-command-output "echo again" "\\`again\n")))
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 25c8cfd389c..d2ef44ae507 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -58,6 +58,18 @@ This test uses a pipeline for the command."
(eshell-command "*echo hi | *cat" t)
(should (equal (buffer-string) "hi\n"))))))
+(ert-deftest eshell-test/eshell-command/pipeline-wait ()
+ "Check that `eshell-command' waits for all its processes before returning."
+ (skip-unless (and (executable-find "echo")
+ (executable-find "sh")
+ (executable-find "rev")))
+ (ert-with-temp-directory eshell-directory-name
+ (let ((eshell-history-file-name nil))
+ (with-temp-buffer
+ (eshell-command
+ "*echo hello | sh -c 'sleep 1; rev' 1>&2 | *echo goodbye" t)
+ (should (equal (buffer-string) "goodbye\nolleh\n"))))))
+
(ert-deftest eshell-test/eshell-command/background ()
"Test that `eshell-command' works for background commands."
(skip-unless (executable-find "echo"))
@@ -132,7 +144,7 @@ insert the queued one at the next prompt, and finally run
it."
(eshell-insert-command "sleep 1; echo slept")
(eshell-insert-command "echo alpha" #'eshell-queue-input)
(let ((start (marker-position (eshell-beginning-of-output))))
- (eshell-wait-for (lambda () (not eshell-current-command)))
+ (eshell-wait-for (lambda () (not eshell-foreground-command)))
(should (string-match "^slept\n.*echo alpha\nalpha\n$"
(buffer-substring-no-properties
start (eshell-end-of-output)))))))
@@ -183,6 +195,25 @@ insert the queued one at the next prompt, and finally run
it."
(eshell-send-input)
(eshell-match-output "(\"hello\" \"there\")")))
+(ert-deftest eshell-test/yank-output ()
+ "Test that yanking a line of output into the next prompt works (bug#66469)."
+ (with-temp-eshell
+ (eshell-insert-command "echo hello")
+ ;; Go to the output and kill the line of text.
+ (forward-line -1)
+ (kill-line)
+ ;; Go to the last prompt and yank the previous output.
+ (goto-char (point-max))
+ (yank)
+ ;; Go to the beginning of the prompt and add some text.
+ (move-beginning-of-line 1)
+ (insert-and-inherit "echo ")
+ ;; Make sure when we go to the beginning of the line, we go to the
+ ;; right spot (before the "echo").
+ (move-end-of-line 1)
+ (move-beginning-of-line 1)
+ (should (looking-at "echo hello"))))
+
(provide 'eshell-tests)
;;; eshell-tests.el ends here
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 57099add08b..eb485a10a92 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -973,8 +973,7 @@ delivered."
(setq file-notify--test-desc auto-revert-notify-watch-descriptor)
;; GKqueueFileMonitor does not report the `changed' event.
- (skip-unless
- (not (eq (file-notify--test-monitor) 'GKqueueFileMonitor)))
+ (skip-when (eq (file-notify--test-monitor) 'GKqueueFileMonitor))
;; Check, that file notification has been used.
(should auto-revert-mode)
@@ -1708,6 +1707,71 @@ the file watch."
(file-notify--deftest-remote file-notify-test11-symlinks
"Check `file-notify-test11-symlinks' for remote files.")
+(ert-deftest file-notify-test12-unmount ()
+ "Check that file notification stop after unmounting the filesystem."
+ :tags '(:expensive-test)
+ (skip-unless (file-notify--test-local-enabled))
+ ;; This test does not work for w32notify.
+ (skip-when (string-equal (file-notify--test-library) "w32notify"))
+
+ (unwind-protect
+ (progn
+ (setq file-notify--test-tmpfile (file-notify--test-make-temp-name))
+ ;; File monitors like kqueue insist, that the watched file
+ ;; exists. Directory monitors are not bound to this
+ ;; restriction.
+ (when (string-equal (file-notify--test-library) "kqueue")
+ (write-region
+ "any text" nil file-notify--test-tmpfile nil 'no-message))
+
+ (should
+ (setq file-notify--test-desc
+ (file-notify--test-add-watch
+ file-notify--test-tmpfile
+ '(attribute-change change) #'file-notify--test-event-handler)))
+ (should (file-notify-valid-p file-notify--test-desc))
+
+ ;; Unmounting the filesystem should stop watching.
+ (file-notify--test-with-actions '(stopped)
+ ;; We emulate unmounting by calling
+ ;; `file-notify-handle-event' with a corresponding event.
+ (file-notify-handle-event
+ (make-file-notify
+ :-event
+ (list file-notify--test-desc
+ (pcase (file-notify--test-library)
+ ((or "inotify" "inotifywait") '(unmount isdir))
+ ((or "gfilenotify" "gio") '(unmounted))
+ ("kqueue" '(revoke))
+ (err (ert-fail (format "Library %s not supported" err))))
+ (pcase (file-notify--test-library)
+ ("kqueue" (file-local-name file-notify--test-tmpfile))
+ (_ (file-local-name file-notify--test-tmpdir)))
+ ;; In the inotify case, there is a 4th slot `cookie'.
+ ;; Since it is unused for `unmount', we ignore it.
+ )
+ :-callback
+ (pcase (file-notify--test-library)
+ ("inotify" #'file-notify--callback-inotify)
+ ("gfilenotify" #'file-notify--callback-gfilenotify)
+ ("kqueue" #'file-notify--callback-kqueue)
+ ((or "inotifywait" "gio") #'file-notify-callback)
+ (err (ert-fail (format "Library %s not supported" err)))))))
+
+ ;; The watch has been stopped.
+ (should-not (file-notify-valid-p file-notify--test-desc))
+
+ ;; The environment shall be cleaned up.
+ (when (string-equal (file-notify--test-library) "kqueue")
+ (delete-file file-notify--test-tmpfile))
+ (file-notify--test-cleanup-p))
+
+ ;; Cleanup.
+ (file-notify--test-cleanup)))
+
+(file-notify--deftest-remote file-notify-test12-unmount
+ "Check `file-notify-test12-unmount' for remote files.")
+
(defun file-notify-test-all (&optional interactive)
"Run all tests for \\[file-notify]."
(interactive "p")
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 0136e0abd5b..a2460686e96 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2325,6 +2325,17 @@ is greater than 10.
(should (string-equal (expand-file-name local dir) dir))
(should (string-equal (expand-file-name (concat dir local)) dir)))))
+;; The following test is inspired by Bug#65685.
+(ert-deftest tramp-test05-expand-file-name-tilde ()
+ "Check `expand-file-name'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (not (tramp--test-ange-ftp-p)))
+
+ (let ((dir (file-remote-p ert-remote-temporary-file-directory))
+ (tramp-tolerate-tilde t))
+ (should (string-equal (expand-file-name (concat dir "~"))
+ (expand-file-name (concat dir "/:~"))))))
+
(ert-deftest tramp-test06-directory-file-name ()
"Check `directory-file-name'.
This checks also `file-name-as-directory', `file-name-directory',
diff --git a/test/lisp/progmodes/compile-tests.el
b/test/lisp/progmodes/compile-tests.el
index 078eef36774..d497644c389 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -121,9 +121,7 @@
;; cucumber
(cucumber "Scenario: undefined step # features/cucumber.feature:3"
29 nil 3 "features/cucumber.feature")
- ;; This rule is actually handled by the `cucumber' pattern but when
- ;; `omake' is included, then `gnu' matches it first.
- (gnu " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'"
+ (cucumber " /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion'"
1 nil 500 "/home/gusev/.rvm/foo/bar.rb")
;; edg-1 edg-2
(edg-1 "build/intel/debug/../../../struct.cpp(42): error: identifier
\"foo\" is undefined"
@@ -312,10 +310,6 @@
1 nil 109 "..\\src\\ctrl\\lister.c")
(watcom "..\\src\\ctrl\\lister.c(120): Warning! W201: Unreachable code"
1 nil 120 "..\\src\\ctrl\\lister.c")
- ;; omake
- ;; FIXME: This doesn't actually test the omake rule.
- (gnu " alpha.c:5:15: error: expected ';' after expression"
- 1 15 5 "alpha.c")
;; oracle
(oracle "Semantic error at line 528, column 5, file erosacqdb.pc:"
1 5 528 "erosacqdb.pc")
@@ -497,8 +491,22 @@ The test data is in `compile-tests--test-regexps-data'."
(font-lock-mode -1)
(let ((compilation-num-errors-found 0)
(compilation-num-warnings-found 0)
- (compilation-num-infos-found 0))
- (mapc #'compile--test-error-line compile-tests--test-regexps-data)
+ (compilation-num-infos-found 0)
+ (all-rules (mapcar #'car compilation-error-regexp-alist-alist)))
+
+ ;; Test all built-in rules except `omake' to avoid interference.
+ (let ((compilation-error-regexp-alist (remq 'omake all-rules)))
+ (mapc #'compile--test-error-line compile-tests--test-regexps-data))
+
+ ;; Test the `omake' rule separately.
+ ;; This doesn't actually test the `omake' rule itself but its
+ ;; indirect effects.
+ (let ((compilation-error-regexp-alist all-rules)
+ (test
+ '(gnu " alpha.c:5:15: error: expected ';' after expression"
+ 1 15 5 "alpha.c")))
+ (compile--test-error-line test))
+
(should (eq compilation-num-errors-found 100))
(should (eq compilation-num-warnings-found 35))
(should (eq compilation-num-infos-found 28)))))
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl
new file mode 100644
index 00000000000..70f12346ded
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66145.pl
@@ -0,0 +1,62 @@
+# The original code, from the bug report, with variables renamed
+
+sub foo {
+ # Here we do something like
+ # this: $array_comment [ num_things ]->{key_comment}
+}
+
+# --------------------------------------------------
+# Comments containing hash and array sigils
+
+# This is an @array, and this is a %hash
+# $array_comment[$index] = $hash_comment{key_comment}
+# The last element has the index $#array_comment
+# my @a_slice = @array_comment[1,2,3];
+# my @h_slice = @hash_comment{qw(a b c)};
+# my %a_set = %array_comment[1,2,3];
+# my %h_set = %hash_comment{qw(a b c)};
+
+# --------------------------------------------------
+# in POD
+
+=head1 NAME
+
+cperl-bug-66145 - don't fontify arrays and hashes in POD
+
+=head1 SYNOPSIS
+
+ $array_comment[$index] = $hash_comment{key_comment};
+ @array_comment = qw(in pod);
+ %hash_comment = key_comment => q(pod);
+ @array_comment = @array_comment[1,2,3];
+ @array_comment = @hash_comment{qw(a b c)};
+ %hash_comment = %array_comment[1,2,3];
+ %hash_comment = %hash_comment{qw(a b c)};
+
+=cut
+
+# --------------------------------------------------
+# in strings
+
+my @strings = (
+ q/$array_string[$index] = $hash_string{key_string};/,
+ q/my @array_string = qw(in unquoted string);/,
+ q/my %hash_string = (key_string => q(pod);)/,
+ q/@array_string = @array_string[1,2,3];/,
+ q/@array_string = @hash_string{qw(a b c)};/,
+ q/%hash_string = %array_string[1,2,3];/,
+ q/%hash_string = %hash_string{qw(a b c)};/,
+);
+
+# --------------------------------------------------
+# in a HERE-document (perl-mode has an extra face for that)
+
+my $here = <<DONE;
+ $array_here[$index_here] = $hash_here{key_here};
+ @array_here = qw(in a hrere-document);
+ %hash_here = key_here => q(pod);
+ @array_here = @array_here[1,2,3];
+ @array_here = @hash_here{qw(a b c)};
+ %hash_here = %array_here[1,2,3];
+ %hash_here = %hash_here{qw(a b c)};
+DONE
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl
new file mode 100644
index 00000000000..e39cfdd3b24
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-66161.pl
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+print("Hello World\n");
+
+__END__
+
+TODO:
+What's happening?
+
+It's all messed up.
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index a29ee54b6b9..de7a614496f 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -1379,6 +1379,43 @@ as a regex."
(forward-line 1))))
(cperl-set-style-back))
+(ert-deftest cperl-test-bug-66145 ()
+ "Verify that hashes and arrays are only fontified in code.
+In strings, comments and POD the syntaxified faces should
+prevail. The tests exercise all combinations of sigils $@% and
+parenthesess [{ for comments, POD, strings and HERE-documents.
+Fontification in code for `cperl-mode' is done in the tests
+beginning with `cperl-test-unicode`."
+ (let ((types '("array" "hash" "key"))
+ (faces `(("string" . font-lock-string-face)
+ ("comment" . font-lock-comment-face)
+ ("here" . ,(if (equal cperl-test-mode 'perl-mode)
+ 'perl-heredoc
+ font-lock-string-face)))))
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-66145.pl"))
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (dolist (type types)
+ (goto-char (point-min))
+ (while (re-search-forward (concat type "_\\([a-z]+\\)") nil t)
+ (should (equal (get-text-property (match-beginning 1) 'face)
+ (cdr (assoc (match-string-no-properties 1)
+ faces)))))))))
+
+(ert-deftest cperl-test-bug-66161 ()
+ "Verify that text after \"__END__\" is fontified as comment.
+For `cperl-mode', this needs the custom variable
+`cperl-fontify-trailer' to be set to `comment'. Per default,
+cperl-mode fontifies text after the delimiter as Perl code."
+ (with-temp-buffer
+ (insert-file-contents (ert-resource-file "cperl-bug-66161.pl"))
+ (setq cperl-fontify-trailer 'comment)
+ (funcall cperl-test-mode)
+ (font-lock-ensure)
+ (search-forward "TODO") ; leaves point before the colon
+ (should (equal (get-text-property (point) 'face)
+ font-lock-comment-face))))
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "cperl-indents.erts")))
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index 621e4dbe2c0..615d905e140 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -555,10 +555,10 @@ known/benign differences in behavior.")
(defconst regex-tests-PTESTS-whitelist
[
- ;; emacs doesn't see DEL (0x7f) as a [:cntrl:] character
+ ;; Emacs doesn't see DEL (0x7f) as a [:cntrl:] character
138
- ;; emacs doesn't barf on weird ranges such as [b-a], but simply
+ ;; Emacs doesn't barf on weird ranges such as [b-a], but simply
;; fails to match
168
]
@@ -872,14 +872,14 @@ This evaluates the TESTS test cases from glibc."
(should (equal (string-match "\\`\\(?:ab\\)*\\'" "a") nil))
(should (equal (string-match "\\`a\\{2\\}*\\'" "a") nil)))
-(ert-deftest regexp-tests-backtrack-optimization () ;bug#61514
+(ert-deftest regexp-tests-backtrack-optimization ()
;; Make sure we don't use up the regexp stack needlessly.
(with-current-buffer (get-buffer-create "*bug*")
(erase-buffer)
(insert (make-string 1000000 ?x) "=")
(goto-char (point-min))
;; Make sure we do perform the optimization (if we don't, the
- ;; below will burp with regexp-stack-overflow).
+ ;; below will burp with regexp-stack-overflow). ;bug#61514
(should (looking-at "x*=*"))
(should (looking-at "x*\\(=\\|:\\)"))
(should (looking-at "x*\\(=\\|:\\)*"))
@@ -908,6 +908,7 @@ This evaluates the TESTS test cases from glibc."
(should (eq 0 (string-match "\\(ca*\\|ab\\)+d" "cabd")))
(should (string-match "\\(aa*\\|b\\)*c" "ababc"))
(should (string-match " \\sw*\\bfoo" " foo"))
+ (should (string-match ".*\\>" "hello "))
))
(ert-deftest regexp-tests-zero-width-assertion-repetition ()