[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/pkg df03640254d 1/3: Merge remote-tracking branch 'origin/master
|
From: |
Gerd Moellmann |
|
Subject: |
scratch/pkg df03640254d 1/3: Merge remote-tracking branch 'origin/master' into scratch/pkg |
|
Date: |
Mon, 2 Oct 2023 04:11:20 -0400 (EDT) |
branch: scratch/pkg
commit df03640254d0a01819fed1d4035255fee3f858dc
Merge: 9e3eaaa4391 db704687bb9
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>
Merge remote-tracking branch 'origin/master' into scratch/pkg
---
.clangd | 2 +-
.gitignore | 1 +
admin/notes/tree-sitter/performance | 10 +
configure.ac | 16 +-
doc/emacs/android.texi | 9 +
doc/emacs/input.texi | 7 +-
doc/emacs/msdos.texi | 4 +-
doc/lispref/searching.texi | 11 +
doc/misc/efaq.texi | 10 +-
etc/NEWS | 21 +-
etc/NEWS.29 | 19 +-
java/AndroidManifest.xml.in | 5 +-
java/org/gnu/emacs/EmacsDesktopNotification.java | 2 +-
java/org/gnu/emacs/EmacsOpenActivity.java | 6 +
java/org/gnu/emacs/EmacsService.java | 9 +-
leim/Makefile.in | 9 +-
lisp/align.el | 50 +-
lisp/bind-key.el | 3 +
lisp/calendar/diary-lib.el | 4 +-
lisp/calendar/icalendar.el | 4 +-
lisp/calendar/todo-mode.el | 60 +-
lisp/dired-aux.el | 16 +
lisp/doc-view.el | 3 +-
lisp/emacs-lisp/advice.el | 2 +-
lisp/emacs-lisp/bytecomp.el | 41 +-
lisp/emacs-lisp/checkdoc.el | 6 +-
lisp/emacs-lisp/cl-macs.el | 4 +-
lisp/emacs-lisp/cl-print.el | 47 +-
lisp/emacs-lisp/elint.el | 20 +-
lisp/emacs-lisp/map.el | 3 +
lisp/emacs-lisp/package.el | 2 +-
lisp/erc/erc.el | 3 +
lisp/eshell/esh-cmd.el | 111 +-
lisp/eshell/esh-io.el | 7 +-
lisp/eshell/esh-proc.el | 16 +-
lisp/external-completion.el | 3 +
lisp/gnus/gnus-cloud.el | 1 +
lisp/gnus/message.el | 9 +-
lisp/gnus/mm-decode.el | 6 +-
lisp/help-fns.el | 2 +-
lisp/international/ja-dic-cnv.el | 2 +
lisp/ls-lisp.el | 8 +-
lisp/mail/sendmail.el | 10 +-
lisp/menu-bar.el | 27 +-
lisp/misearch.el | 151 +++
lisp/net/eww.el | 10 +-
lisp/net/gnutls.el | 2 +-
lisp/net/ntlm.el | 5 +-
lisp/net/soap-client.el | 3 +
lisp/net/tramp-sh.el | 29 +-
lisp/net/tramp-sshfs.el | 4 +-
lisp/net/tramp.el | 14 +-
lisp/org/org.el | 1 +
lisp/org/ox-html.el | 1 +
lisp/progmodes/cc-awk.el | 16 +-
lisp/progmodes/cc-defs.el | 57 +-
lisp/progmodes/cc-engine.el | 52 +-
lisp/progmodes/cc-mode.el | 4 +-
lisp/progmodes/elixir-ts-mode.el | 36 +-
lisp/progmodes/idlwave.el | 2 +-
lisp/progmodes/java-ts-mode.el | 13 +-
lisp/progmodes/lua-ts-mode.el | 56 +-
lisp/progmodes/perl-mode.el | 30 +-
lisp/progmodes/ps-mode.el | 6 +-
lisp/progmodes/python.el | 3 +
lisp/svg.el | 3 +
lisp/tab-line.el | 81 +-
lisp/textmodes/glyphless-mode.el | 1 -
lisp/tmm.el | 3 +-
lisp/treesit.el | 16 +-
lisp/uniquify.el | 4 +-
lisp/use-package/use-package.el | 3 +
lisp/vc/diff-mode.el | 35 +
lisp/vc/ediff-util.el | 52 +-
lisp/vc/vc-annotate.el | 33 +-
make-dist | 5 +-
src/android.c | 11 +-
src/androidfns.c | 8 +
src/androidmenu.c | 19 +-
src/itree.c | 2 +-
src/keyboard.c | 5 +
src/regex-emacs.c | 1164 ++++++++++----------
src/regex-emacs.h | 4 +
src/search.c | 41 +
src/sfntfont.c | 7 +-
src/xterm.c | 9 +-
test/lisp/emacs-lisp/cl-print-tests.el | 19 +-
test/lisp/eshell/esh-cmd-tests.el | 16 +
test/lisp/eshell/esh-proc-tests.el | 20 +-
test/lisp/net/tramp-tests.el | 81 +-
.../cperl-mode-resources/cperl-bug-35925.pl | 36 +
test/lisp/progmodes/cperl-mode-tests.el | 24 +-
.../progmodes/elixir-ts-mode-resources/indent.erts | 16 +
test/src/regex-emacs-tests.el | 29 +-
test/src/regex-resources/PTESTS | 1 +
95 files changed, 1801 insertions(+), 1053 deletions(-)
diff --git a/.clangd b/.clangd
index 131d0af5843..469d33dfd03 100644
--- a/.clangd
+++ b/.clangd
@@ -1,5 +1,5 @@
---
If:
- PathMatch: "src/.*\.c"
+ PathMatch: "src/*.c"
CompileFlags:
Add: [-Wno-unused-macros, -include=config.h]
diff --git a/.gitignore b/.gitignore
index fcdb1ae38f0..1b837a9f64c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -127,6 +127,7 @@ lisp/cedet/semantic/grammar-wy.el
lisp/eshell/esh-groups.el
lisp/finder-inf.el
lisp/leim/ja-dic/
+leim/small-ja-dic-option
lisp/leim/leim-list.el
lisp/leim/quail/4Corner.el
lisp/leim/quail/ARRAY30.el
diff --git a/admin/notes/tree-sitter/performance
b/admin/notes/tree-sitter/performance
index 315a550be34..23f84743ced 100644
--- a/admin/notes/tree-sitter/performance
+++ b/admin/notes/tree-sitter/performance
@@ -13,3 +13,13 @@ range, so you have to update the ranges every time before
parsing. Fortunately, changing ranges doesn’t invalidate incremental
parsing, so there isn’t any performance lost in update ranges
frequently.
+
+* Experiments
+
+Using regexp by default in treesit-simple-indent-rules seems wasteful,
+so I tried replacing all string-match-p to equal in
+treesit-simple-indent-presets, and indent xdisp.c for a comparison.
+Turns out using regexp by default is faster: regexp-based indent took
+45s and equal-based indent took 75s.
+
+I could be missing something, further experiments are welcome.
diff --git a/configure.ac b/configure.ac
index 855c4ec7df1..9ae0dec3867 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1664,13 +1664,13 @@ AC_ARG_ENABLE([gcc-warnings],
# however, if there is also a .tarball-version file it is probably
# just a release imported into Git for patch management.
gl_gcc_warnings=no
- if test -d "$srcdir"/.git && test ! -f "$srcdir"/.tarball-version; then
- # Clang typically identifies itself as GCC 4.2 or something similar
- # even if it is recent enough to accept the warnings we enable.
- AS_IF([test "$emacs_cv_clang" = yes],
- [gl_gcc_warnings=warn-only],
- [gl_GCC_VERSION_IFELSE([5], [3], [gl_gcc_warnings=warn-only])])
- fi])
+ AS_IF([test -d "$srcdir"/.git || test -f "$srcdir"/.git],
+ [AS_IF([test -f "$srcdir"/.tarball-version], [],
+ # Clang typically identifies itself as GCC 4.2 or something similar
+ # even if it is recent enough to accept the warnings we enable.
+ [AS_IF([test "$emacs_cv_clang" = yes],
+ [gl_gcc_warnings=warn-only],
+ [gl_GCC_VERSION_IFELSE([5], [3], [gl_gcc_warnings=warn-only])])])])])
NATIVE_COMPILATION_AOT=no
AC_ARG_WITH([native-compilation],
@@ -6263,7 +6263,7 @@ AC_FUNC_FORK
dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs
dnl the current CFLAGS etc.
-AC_CHECK_FUNCS([snprintf])
+AC_CHECK_FUNCS([snprintf open_memstream])
dnl posix_spawn. The chdir and setsid functionality is relatively
dnl recent, so we check for it specifically.
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index 07b689ca23b..9f3cca2b137 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -690,6 +690,15 @@ these key sequences before they can be filtered by the
input method.
disabled by setting the variable
@code{android-intercept-control-space} to @code{nil}.
+@vindex android-keyboard-bell-duration
+@cindex keyboard bell, android
+ The keyboard bell installed within Android systems takes the form of
+a vibrating element that is activated for a number of milliseconds
+whenever the bell is rung. The duration of this vibration can be
+customized through altering the variable
+@code{android-keyboard-bell-duration} to any value between @code{10}
+and @code{1000}.
+
@node Android Fonts
@section Font Backends and Selection under Android
@cindex fonts, android
diff --git a/doc/emacs/input.texi b/doc/emacs/input.texi
index 4f49ca3cece..db0e88a1c9c 100644
--- a/doc/emacs/input.texi
+++ b/doc/emacs/input.texi
@@ -145,9 +145,10 @@ of a hardware button that is always present on the device
results in
Emacs quitting. @xref{Quitting}.
@vindex x-quit-keysym
- Which button is used to do this depends on the window system in use:
-on X, it is defined in the variable @code{x-quit-keysym}, and on
-Android, it is always the volume down button.
+ The button afforded such special treatment varies; under X, no such
+button exists by default, but one can be configured through the
+variable @code{x-quit-keysym}, whereas under Android it is always the
+volume down buttons.
@cindex text conversion, keyboards
Most input methods designed to work with on-screen keyboards perform
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 52561ec9a33..8401a2aa596 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -412,10 +412,10 @@ this option can be one of the following symbols:
@itemx nil
Emulate @sc{gnu} systems; this is the default. This sets
@code{ls-lisp-ignore-case} and @code{ls-lisp-dirs-first} to
-@code{nil}, and @code{ls-lisp-verbosity} to @code{(links uid gid)}.
+@code{nil}, and @code{ls-lisp-verbosity} to @code{(links uid gid modes)}.
@item UNIX
Emulate Unix systems. Like @code{GNU}, but sets
-@code{ls-lisp-verbosity} to @code{(links uid)}.
+@code{ls-lisp-verbosity} to @code{(links uid modes)}.
@item MacOS
Emulate macOS@. Sets @code{ls-lisp-ignore-case} to @code{t}, and
@code{ls-lisp-dirs-first} and @code{ls-lisp-verbosity} to @code{nil}.
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 66b33316faa..cb269fcacc5 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -1972,6 +1972,17 @@ advice, don't be afraid of performing the matching in
multiple
function calls, each using a simpler regexp where backtracking can
more easily be contained.
+@defun re--describe-compiled regexp &optional raw
+To help diagnose problems in your regexps or in the regexp engine
+itself, this function returns a string describing the compiled
+form of @var{regexp}. To make sense of it, it can be necessary
+to read at least the description of the @code{re_opcode_t} type in the
+@code{src/regex-emacs.c} file in Emacs' source code.
+
+It is currently able to give a meaningful description only if Emacs
+was compiled with @code{--enable-checking}.
+@end defun
+
@node Regexp Search
@section Regular Expression Searching
@cindex regular expression searching
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 600f4435e62..2fc8e60d400 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -3301,12 +3301,12 @@ Emacs has an inherent fixed limitation on the size of
buffers. This
limit is stricter than the maximum size of objects supported by other
programs on the same architecture.
-The maximum buffer size on 32-bit machines is 512 MBytes. If Emacs
-was built using the @code{--with-wide-int} flag, the maximum buffer
-size on 32-bit machines is 2 GB.
+The maximum buffer size on 64-bit machines is 2.3 exabytes
+(@code{most-positive-fixnum}).
-Emacs compiled on a 64-bit machine can handle much larger buffers; up
-to @code{most-positive-fixnum} (2.3 exabytes).
+Emacs compiled on a 32-bit machine can handle buffers up to 512
+MBytes. If Emacs was built using the @code{--with-wide-int} flag, the
+maximum buffer size on 32-bit machines is 2 GB.
Due to things like decoding of multibyte characters, you can only
visit files with a size that is roughly half the buffer size limit.
diff --git a/etc/NEWS b/etc/NEWS
index 290111a213f..b3c7d3a8693 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -69,7 +69,7 @@ For native compiled Lisp functions 'describe-function' prints
(after
the signature) the automatically inferred function type as well.
---
-** New user option 'describe-bindings-outline-rules'.
+*** New user option 'describe-bindings-outline-rules'.
This user option controls outline visibility in the output buffer of
'describe-bindings' when 'describe-bindings-outline' is non-nil.
@@ -321,6 +321,21 @@ This allows changing which type of whitespace changes are
ignored when
regenerating hunks with 'diff-ignore-whitespace-hunk'. Defaults to
the previously hard-coded "-b".
+*** New command 'diff-apply-buffer' bound to 'C-c RET a'.
+It applies the diff in the entire diff buffer and
+saves all modified file buffers.
+
+** Isearch and Replace
+
+*** New command 'replace-regexp-as-diff'.
+It reads a regexp to search for and a string to replace with, then
+displays a buffer with replacements as diffs. After reviewing the
+changes in the output buffer you can apply the replacements as
+a patch to the current file buffer. There are also new commands
+'multi-file-replace-regexp-as-diff' that shows as diffs replacements
+in a list of specified files, and 'dired-do-replace-regexp-as-diff'
+that shows as diffs replacements in the marked files in Dired.
+
** Dired
---
@@ -961,6 +976,10 @@ Use 'define-minor-mode' and 'define-globalized-minor-mode'
instead.
* Lisp Changes in Emacs 30.1
+** New function 're--describe-compiled' 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.
+
+++
** XLFDs are no longer restricted to 255 characters.
'font-xlfd-name' now returns an XLFD even if it is greater than 255
diff --git a/etc/NEWS.29 b/etc/NEWS.29
index f6add757c08..1b3532b5657 100644
--- a/etc/NEWS.29
+++ b/etc/NEWS.29
@@ -27,6 +27,19 @@ applies, and please also update docstrings as needed.
* Startup Changes in Emacs 29.2
+** On GNU/Linux, Emacs is now the default application for 'org-protocol'.
+Org mode provides a way to quickly capture bookmarks, notes, and links
+using 'emacsclient':
+
+ emacsclient "org-protocol://store-link?url=URL&title=TITLE"
+
+Previously, users had to manually configure their GNU/Linux desktop
+environment to open 'org-protocol' links in Emacs. These links should
+now open in Emacs automatically, as the "emacsclient.desktop" file now
+arranges for Emacs to be the default application for the 'org-protocol'
+URI scheme. See the Org mode manual, Info node "(org) Protocols" for
+more details.
+
* Changes in Emacs 29.2
@@ -2004,7 +2017,7 @@ The intention is that this command can be used to access
a wide
variety of version control system-specific functionality from VC
without complexifying either the VC command set or the backend API.
-*** 'C-x v v' in a diffs buffer allows committing only some of the changes.
+*** 'C-x v v' in a diffs buffer allows to commit only some of the changes.
This command is intended to allow you to commit only some of the
changes you have in your working tree. Begin by creating a buffer
with the changes against the last commit, e.g. with 'C-x v D'
@@ -3501,7 +3514,7 @@ The variables 'connection-local-profile-alist' and
make it more convenient to inspect and modify them.
*** New function 'connection-local-update-profile-variables'.
-This function allows modifying the settings of an existing
+This function allows to modify the settings of an existing
connection-local profile.
*** New macro 'with-connection-local-application-variables'.
@@ -4018,7 +4031,7 @@ measured will be counted for the purpose of calculating
the text
dimensions.
** 'window-text-pixel-size' understands a new meaning of FROM.
-Specifying a cons as the FROM argument allows measuring text starting
+Specifying a cons as the FROM argument allows to start measuring text
from a specified amount of pixels above or below a position.
** 'window-body-width' and 'window-body-height' can use remapped faces.
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index d4017a055dd..9ba9dabde81 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -110,7 +110,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
<action android:name="android.intent.action.EDIT"/>
<action android:name="android.intent.action.PICK"/>
<category android:name="android.intent.category.DEFAULT"/>
- <data android:mimeType="*/*"/>
+ <!-- Don't offer to start Emacs for URLs that designate
+ resources other than files. -->
+ <data android:mimeType="*/*" android:scheme="file"/>
+ <data android:mimeType="*/*" android:scheme="content"/>
</intent-filter>
<!-- Facilitate opening org-protocol:// URLs as well, the same
diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java
b/java/org/gnu/emacs/EmacsDesktopNotification.java
index 56ed984d497..4a6bbf7a606 100644
--- a/java/org/gnu/emacs/EmacsDesktopNotification.java
+++ b/java/org/gnu/emacs/EmacsDesktopNotification.java
@@ -137,7 +137,7 @@ public final class EmacsDesktopNotification
priority = Notification.PRIORITY_HIGH;
break;
}
-
+
notification = (new Notification.Builder (context)
.setContentTitle (title)
.setContentText (content)
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java
b/java/org/gnu/emacs/EmacsOpenActivity.java
index d27139e98bc..202b3c8c5dc 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -438,6 +438,12 @@ public final class EmacsOpenActivity extends Activity
scheme = uri.getScheme ();
+ /* It is possible for scheme to be NULL, under Android 2.3 at
+ least. */
+
+ if (scheme == null)
+ return;
+
/* If URL is a mailto URI, call `message-mailto' much the same
way emacsclient-mail.desktop does. */
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 05952f98cf1..997c6923fcc 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -448,12 +448,13 @@ public final class EmacsService extends Service
@SuppressWarnings ("deprecation")
public void
- ringBell ()
+ ringBell (int duration)
{
Vibrator vibrator;
VibrationEffect effect;
VibratorManager vibratorManager;
Object tem;
+ int amplitude;
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.S)
{
@@ -467,13 +468,13 @@ public final class EmacsService extends Service
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.O)
{
+ amplitude = VibrationEffect.DEFAULT_AMPLITUDE;
effect
- = VibrationEffect.createOneShot (50,
- VibrationEffect.DEFAULT_AMPLITUDE);
+ = VibrationEffect.createOneShot (duration, amplitude);
vibrator.vibrate (effect);
}
else
- vibrator.vibrate (50);
+ vibrator.vibrate (duration);
}
public short[]
diff --git a/leim/Makefile.in b/leim/Makefile.in
index 4c6c3179283..f7dfdf66f30 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -26,6 +26,7 @@ SHELL = @SHELL@
# Here are the things that we expect ../configure to edit.
srcdir=@srcdir@
top_builddir = @top_builddir@
+top_srcdir = @top_srcdir@
# Where the generated files go.
leimdir = ${srcdir}/../lisp/leim
@@ -134,9 +135,15 @@ ${leimdir}/leim-list.el: ${srcdir}/leim-ext.el ${TIT_MISC}
${leimdir}/ja-dic/ja-dic.el: | $(leimdir)/ja-dic
+# This is used to support regeneration of ja-dic when the SMALL_JA_DIC
+# option is flipped by the configure-time option.
+small-ja-dic-option: ../config.status
+ $(AM_V_GEN)echo "Small ja-dic option: $(SMALL_JA_DIC)" > $@.$$$$ && \
+ ${top_srcdir}/build-aux/move-if-change $@.$$$$ $@
+
.PHONY: generate-ja-dic
generate-ja-dic: ${leimdir}/ja-dic/ja-dic.el
-${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L
+${leimdir}/ja-dic/ja-dic.el: $(srcdir)/SKK-DIC/SKK-JISYO.L small-ja-dic-option
$(AM_V_GEN)$(RUN_EMACS) -batch -l ja-dic-cnv \
-f batch-skkdic-convert -dir "$(leimdir)/ja-dic"
$(JA_DIC_NO_REDUCTION_OPTION) "$<"
diff --git a/lisp/align.el b/lisp/align.el
index 4f7e97dfc6a..a286addb51f 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -1337,12 +1337,18 @@ aligner would have dealt with are."
(thissep (if rulesep (cdr rulesep) separate))
same (eol 0)
search-start
- groups ;; group-c
- spacing spacing-c
- tab-stop tab-stop-c
- repeat repeat-c
- valid valid-c
- first
+ (groups (ensure-list (or (cdr (assq 'group rule)) 1)))
+ (spacing (cdr (assq 'spacing rule)))
+ (tab-stop (let ((rule-ts (assq 'tab-stop rule)))
+ (cond (rule-ts
+ (cdr rule-ts))
+ ((symbolp align-to-tab-stop)
+ (symbol-value align-to-tab-stop))
+ (t
+ align-to-tab-stop))))
+ (repeat (cdr (assq 'repeat rule)))
+ (valid (assq 'valid rule))
+ (first (car groups))
regions index
last-point
save-match-data
@@ -1459,44 +1465,12 @@ aligner would have dealt with are."
(if (and (bolp) (> (point) search-start))
(forward-char -1))
- ;; lookup the `group' attribute the first time
- ;; that we need it
- (unless nil ;; group-c
- (setq groups (or (cdr (assq 'group rule)) 1))
- (setq groups (ensure-list groups))
- (setq first (car groups)))
-
- (unless spacing-c
- (setq spacing (cdr (assq 'spacing rule))
- spacing-c t))
-
- (unless tab-stop-c
- (setq tab-stop
- (let ((rule-ts (assq 'tab-stop rule)))
- (cond (rule-ts
- (cdr rule-ts))
- ((symbolp align-to-tab-stop)
- (symbol-value align-to-tab-stop))
- (t
- align-to-tab-stop)))
- tab-stop-c t))
-
;; test whether we have found a match on the same
;; line as a previous match
(when (> (point) eol)
(setq same nil)
(align--set-marker eol (line-end-position)))
- ;; lookup the `repeat' attribute the first time
- (or repeat-c
- (setq repeat (cdr (assq 'repeat rule))
- repeat-c t))
-
- ;; lookup the `valid' attribute the first time
- (or valid-c
- (setq valid (assq 'valid rule)
- valid-c t))
-
;; remember the beginning position of this rule
;; match, and save the match-data, since either
;; the `valid' form, or the code that searches for
diff --git a/lisp/bind-key.el b/lisp/bind-key.el
index c45b9e546f7..3cff0f7f3a9 100644
--- a/lisp/bind-key.el
+++ b/lisp/bind-key.el
@@ -10,6 +10,9 @@
;; Keywords: keys keybinding config dotemacs extensions
;; URL: https://github.com/jwiegley/use-package
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 946cf0e7236..0d894f10013 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -167,8 +167,8 @@ form of ((MONTH DAY YEAR) STRING), where string is the diary
entry for the given date. This can be used, for example, to
produce a different buffer for display (perhaps combined with
holidays), or hard copy output."
- :type '(choice (const diary-fancy-display :tag "Fancy display")
- (const diary-simple-display :tag "Basic display")
+ :type '(choice (const :tag "Fancy display" diary-fancy-display)
+ (const :tag "Basic display" diary-simple-display)
(const :tag "No display" ignore)
(function :tag "User-specified function"))
:initialize 'custom-initialize-default
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index e51251d6d9f..51e6a7d1170 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -276,9 +276,9 @@ other sexp entries are enumerated in any case."
:value 10)
(set :tag "Alarm type"
(list :tag "Audio"
- (const audio :tag "Audio"))
+ (const :tag "Audio" audio))
(list :tag "Display"
- (const display :tag "Display"))
+ (const :tag "Display" display))
(list :tag "Email"
(const email)
(repeat :tag "Attendees"
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index ffb7b7168dd..093ea0e22b6 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -200,7 +200,7 @@ The final element is \"*\", indicating an unspecified
month.")
(month "\\(?7:[0-9]+\\|\\*\\)")
(day "\\(?8:[0-9]+\\|\\*\\)")
(year "-?\\(?9:[0-9]+\\|\\*\\)"))
- (mapconcat #'eval calendar-date-display-form ""))
+ (mapconcat #'eval calendar-date-display-form))
"\\)"))
"Regular expression matching a todo item date header.")
@@ -1206,7 +1206,7 @@ visiting the deleted files."
(let ((sexp (read (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(print-length nil)
(print-level nil))
(mapc (lambda (x) (aset (cdr x) 3 0)) sexp)
@@ -1304,7 +1304,7 @@ return the new category number."
(widen)
(goto-char (point-max))
(save-excursion ; Save point for todo-category-select.
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(insert todo-category-beg cat "\n\n" todo-category-done "\n")))
(todo-update-categories-sexp)
;; If invoked by user, display the newly added category, if
@@ -1486,7 +1486,7 @@ the archive of the file moved to, creating it if it does
not exist."
nfile-short)
(format "the category \"%s\";\n" cat)
"enter a new category name: "))
- (buffer-read-only nil)
+ (inhibit-read-only t)
(print-length nil)
(print-level nil))
(widen)
@@ -1528,7 +1528,7 @@ the archive of the file moved to, creating it if it does
not exist."
;; Delete the category from the old file, and if that was the
;; last category, delete the file. Also handle archive file
;; if necessary.
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(widen)
(remove-overlays beg end)
(delete-region beg end)
@@ -1581,7 +1581,7 @@ archive file and the source category is deleted."
here)
(with-current-buffer (get-buffer (find-file-noselect tfile))
(widen)
- (let* ((buffer-read-only nil)
+ (let* ((inhibit-read-only t)
(cbeg (progn
(re-search-backward
(concat "^" (regexp-quote todo-category-beg)) nil t)
@@ -1609,7 +1609,7 @@ archive file and the source category is deleted."
(unless (derived-mode-p 'todo-mode) (todo-mode))
(widen)
(goto-char (point-min))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
;; Merge any todo items.
(unless (zerop (length todo))
(re-search-forward
@@ -1647,7 +1647,7 @@ archive file and the source category is deleted."
(with-current-buffer (get-buffer (find-file-noselect tarchive))
(widen)
(goto-char (point-min))
- (let* ((buffer-read-only nil)
+ (let* ((inhibit-read-only t)
(cbeg (progn
(when (re-search-forward
(concat "^" (regexp-quote
@@ -1967,7 +1967,7 @@ their associated keys and their effects."
(setq todo-current-todo-file file)
(unless todo-global-current-todo-file
(setq todo-global-current-todo-file todo-current-todo-file))
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
done-only item-added)
(unless copy
(setq new-item
@@ -2197,9 +2197,9 @@ the item at point."
end t)
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(delete-region (match-beginning 0) (match-end 0))))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(replace-match (save-match-data
(prog1 (let ((buffer-read-only t))
(read-string
@@ -2216,7 +2216,7 @@ the item at point."
nil nil nil 1)))
(if comment-delete
(user-error "There is no comment to delete")
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(insert " [" todo-comment-string ": "
(prog1 (let ((buffer-read-only t))
(read-string prompt))
@@ -2261,7 +2261,7 @@ the item at point."
(todo-category-number ocat)
(todo-category-select)
(goto-char opoint))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(todo-remove-item)
(todo-insert-with-overlays new))
(move-to-column item-beg)))))))))
@@ -2493,8 +2493,8 @@ made in the number or names of categories."
(month month)
(day day)
(dayname nil)) ;; dayname
- (mapconcat #'eval calendar-date-display-form "")))))
- (let ((buffer-read-only nil))
+ (mapconcat #'eval calendar-date-display-form)))))
+ (let ((inhibit-read-only t))
(when ndate (replace-match ndate nil nil nil 1))
;; Add new time string to the header, if it was supplied.
(when ntime
@@ -2754,7 +2754,7 @@ meaning to raise or lower the item's priority by one."
(when match
(user-error (concat "Cannot reprioritize items from the same "
"category in this mode, only in Todo
mode")))))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
;; Interactively or with non-nil ARG, relocate the item within its
;; category.
(when (or arg (called-interactively-p 'any))
@@ -2877,7 +2877,7 @@ section in the category moved to."
(setq here (point))
(while todo-items
(todo-forward-item)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(todo-insert-with-overlays (pop todo-items)))))
;; Move done items en bloc to top of done items section.
(when done-items
@@ -2892,7 +2892,7 @@ section in the category moved to."
(forward-line)
(unless here (setq here (point)))
(while done-items
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(todo-insert-with-overlays (pop done-items)))
(todo-item-end)
(forward-line)))
@@ -2933,13 +2933,13 @@ section in the category moved to."
(goto-char beg)
(while (< (point) end)
(if (todo-marked-item-p)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(todo-remove-item))
(todo-forward-item)))
(setq todo-categories-with-marks
(assq-delete-all cat1
todo-categories-with-marks)))
(if ov (delete-overlay ov))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(todo-remove-item)))))
(when todo (todo-update-count 'todo (- todo) cat1))
(when diary (todo-update-count 'diary (- diary) cat1))
@@ -2999,7 +2999,7 @@ visible."
(show-done (save-excursion
(goto-char (point-min))
(re-search-forward todo-done-string-start nil t)))
- (buffer-read-only nil)
+ (inhibit-read-only t)
header item done-items
(opoint (point)))
;; Don't add empty comment to done item.
@@ -3131,7 +3131,7 @@ comments without asking."
(when ov (delete-overlay ov))
(if (not undone)
(goto-char opoint)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(if marked
(progn
(setq item nil)
@@ -3299,7 +3299,7 @@ this category does not exist in the archive, it is
created."
(todo-archive-mode))
(if headers-hidden (todo-toggle-item-header))))
(with-current-buffer tbuf
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(cond
(all
(save-excursion
@@ -3602,7 +3602,7 @@ decreasing or increasing its number."
;; Category's name and items counts list.
(catcons (nth (1- curnum) todo-categories))
(todo-categories (nconc head (list catcons) tail))
- (buffer-read-only nil)
+ (inhibit-read-only t)
newcats)
(when lower (setq todo-categories (nreverse todo-categories)))
(setq todo-categories (delete-dups todo-categories))
@@ -3823,8 +3823,7 @@ which is the value of the user option
(cons todo-categories-diary-label 'diary)
(cons todo-categories-done-label 'done)
(cons todo-categories-archived-label
- 'archived)))
- "")
+ 'archived))))
" ") ; Make highlighting on last column look better.
'face (if (and todo-skip-archived-categories
(zerop (todo-get-count 'todo cat))
@@ -3932,8 +3931,7 @@ which is the value of the user option
(list (cons todo-categories-todo-label 0)
(cons todo-categories-diary-label 1)
(cons todo-categories-done-label 2)
- (cons todo-categories-archived-label 3)))
- ""))
+ (cons todo-categories-archived-label 3)))))
;; Put cursor on Category button initially.
(if pt (goto-char pt))
(setq buffer-read-only t)))
@@ -4758,7 +4756,7 @@ Helper function for `todo-convert-legacy-files'."
(time (match-string 4))
dayname)
(replace-match "")
- (insert (mapconcat #'eval calendar-date-display-form "")
+ (insert (mapconcat #'eval calendar-date-display-form)
(when time (concat " " time)))))
(defun todo-convert-legacy-files ()
@@ -5112,7 +5110,7 @@ With nil or omitted CATEGORY, default to the current
category."
(defun todo-update-categories-sexp ()
"Update the `todo-categories' sexp at the top of the file."
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
(print-length nil)
(print-level nil))
(save-excursion
@@ -6180,7 +6178,7 @@ number of the last the day of the month."
(if (memq 'month calendar-date-display-form)
month
monthname)))
- (mapconcat #'eval calendar-date-display-form ""))))
+ (mapconcat #'eval calendar-date-display-form))))
(defun todo-read-dayname ()
"Choose name of a day of the week with completion and return it."
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28513a2c61a..2ff620065a5 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -3655,6 +3655,22 @@ resume the query replace with the command
\\[fileloop-continue]."
delimited)
(fileloop-continue))
+;;;###autoload
+(defun dired-do-replace-regexp-as-diff (from to &optional delimited)
+ "Do `replace-regexp' of FROM with TO as diff, on all marked files.
+Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
+The replacements are displayed in the buffer *replace-diff* that
+you can later apply as a patch after reviewing the changes."
+ (interactive
+ (let ((common
+ (query-replace-read-args
+ "Replace regexp as diff in marked files" t t)))
+ (list (nth 0 common) (nth 1 common) (nth 2 common))))
+ (dired-post-do-command)
+ (multi-file-replace-regexp-as-diff
+ (dired-get-marked-files nil nil #'dired-nondirectory-p)
+ from to delimited))
+
(declare-function xref-query-replace-in-results "xref")
(declare-function project--files-in-directory "project")
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index a2ad4660f73..210b7ace7d6 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -1280,7 +1280,8 @@ The test is performed using `doc-view-pdfdraw-program'."
(expand-file-name
doc-view-epub-user-stylesheet)))))))
(doc-view-start-process
- "pdf->png" doc-view-pdfdraw-program
+ (concat "pdf->" (symbol-name doc-view--image-type))
+ doc-view-pdfdraw-program
`(,@(doc-view-pdfdraw-program-subcommand)
,@options
,pdf
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 3265809f592..7fbdd963e0e 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -3131,7 +3131,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION]
[ARGLIST] FLAG...)
[DOCSTRING] [INTERACTIVE-FORM]
BODY...)"
(declare (doc-string 3) (indent 2)
- (obsolete "use advice-add or define-advice" "30.1")
+ (obsolete "use `advice-add' or `define-advice'" "30.1")
(debug (&define name ;; thing being advised.
(name ;; class is [&or "before" "around" "after"
;; "activation" "deactivation"]
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 362815a9ad4..c41b123ac2f 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -339,7 +339,8 @@ suppress. For example, (not free-vars) will suppress the
`free-vars' warning.
The t value means \"all non experimental warning types\", and
excludes the types in `byte-compile--emacs-build-warning-types'.
A value of `all' really means all."
- :type `(choice (const :tag "All" t)
+ :type `(choice (const :tag "Default selection" t)
+ (const :tag "All" all)
(set :menu-tag "Some"
,@(mapcar (lambda (x) `(const ,x))
byte-compile-warning-types))))
@@ -1735,8 +1736,11 @@ Warn if documentation string of FORM is too wide.
It is too wide if it has any lines longer than the largest of
`fill-column' and `byte-compile-docstring-max-column'."
(when (byte-compile-warning-enabled-p 'docstrings)
- (let ((col (max byte-compile-docstring-max-column fill-column))
- kind name docs)
+ (let* ((kind nil) (name nil) (docs nil)
+ (prefix (lambda ()
+ (format "%s%s"
+ kind
+ (if name (format-message " `%s' " name) "")))))
(pcase (car form)
((or 'autoload 'custom-declare-variable 'defalias
'defconst 'define-abbrev-table
@@ -1744,20 +1748,18 @@ It is too wide if it has any lines longer than the
largest of
'custom-declare-face)
(setq kind (nth 0 form))
(setq name (nth 1 form))
+ (when (and (consp name) (eq (car name) 'quote))
+ (setq name (cadr name)))
(setq docs (nth 3 form)))
('lambda
(setq kind "") ; can't be "function", unfortunately
- (setq docs (and (stringp (nth 2 form))
- (nth 2 form)))))
- (when (and (consp name) (eq (car name) 'quote))
- (setq name (cadr name)))
- (setq name (if name (format " `%s' " name) ""))
+ (setq docs (nth 2 form))))
(when (and kind docs (stringp docs))
- (when (byte-compile--wide-docstring-p docs col)
- (byte-compile-warn-x
- name
- "%s%sdocstring wider than %s characters"
- kind name col))
+ (let ((col (max byte-compile-docstring-max-column fill-column)))
+ (when (byte-compile--wide-docstring-p docs col)
+ (byte-compile-warn-x
+ name
+ "%sdocstring wider than %s characters" (funcall prefix) col)))
;; There's a "naked" ' character before a symbol/list, so it
;; should probably be quoted with \=.
(when (string-match-p (rx (| (in " \t") bol)
@@ -1767,16 +1769,19 @@ It is too wide if it has any lines longer than the
largest of
docs)
(byte-compile-warn-x
name
- (concat "%s%sdocstring has wrong usage of unescaped single quotes"
+ (concat "%sdocstring has wrong usage of unescaped single quotes"
" (use \\=%c or different quoting such as %c...%c)")
- kind name ?' ?` ?'))
+ (funcall prefix) ?' ?` ?'))
;; There's a "Unicode quote" in the string -- it should probably
;; be an ASCII one instead.
(when (byte-compile-warning-enabled-p 'docstrings-non-ascii-quotes)
- (when (string-match-p "\\( \"\\|[ \t]\\|^\\)[‘’]" docs)
+ (when (string-match-p (rx (| " \"" (in " \t") bol)
+ (in "‘’"))
+ docs)
(byte-compile-warn-x
- name "%s%sdocstring has wrong usage of \"fancy\" single quotation
marks"
- kind name))))))
+ name
+ "%sdocstring uses curved single quotes; use %s instead of ‘...’"
+ (funcall prefix) "`...'"))))))
form)
;; If we have compiled any calls to functions which are not known to be
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index cf7b7c318f6..440e133f44b 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2584,11 +2584,11 @@ Argument END is the maximum bounds to search in."
(rx "("
(* (syntax whitespace))
(group
- (or (seq (* (group (or wordchar (syntax symbol))))
+ (or (seq (* (or wordchar (syntax symbol)))
"error")
- (seq (* (group (or wordchar (syntax symbol))))
+ (seq (* (or wordchar (syntax symbol)))
(or "y-or-n-p" "yes-or-no-p")
- (? (group "-with-timeout")))
+ (? "-with-timeout"))
"checkdoc-autofix-ask-replace"))
(+ (any "\n\t ")))
end t))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 7c207d372fc..8025a64f1bf 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3200,8 +3200,8 @@ To see the documentation for a defined struct type, use
;; choose to avoid the byte-compiler
;; warnings.
(if (>= (length long-docstring)
- (or (and (boundp
'byte-compile-docstring-max-column)
- byte-compile-docstring-max-column)
+ (or (bound-and-true-p
+ byte-compile-docstring-max-column)
80))
(concat
(internal--format-docstring-line
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 627b6cc3089..d0bfcab4082 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -261,20 +261,44 @@ into a button whose action shows the function's
disassembly.")
(cl-defmethod cl-print-object-contents ((object cl-structure-object) start
stream)
(cl-print--struct-contents object start stream)) ;FIXME: η-redex!
+(defvar cl-print-string-length nil
+ "Maximum length of string to print before abbreviating.
+A value of nil means no limit.
+
+When Emacs abbreviates a string, it prints the first
+`cl-print-string-length' characters of the string, followed by
+\"...\". You can type RET, or click on this ellipsis to expand
+the string.
+
+This variable has effect only in the `cl-prin*' functions, not in
+primitives such as `prin1'.")
+
(cl-defmethod cl-print-object ((object string) stream)
(unless stream (setq stream standard-output))
(let* ((has-properties (or (text-properties-at 0 object)
- (next-property-change 0 object))))
+ (next-property-change 0 object)))
+ (len (length object))
+ (limit (if (natnump cl-print-string-length)
+ (min cl-print-string-length len)
+ len)))
(if (and has-properties
cl-print--depth
(natnump print-level)
(> cl-print--depth print-level))
(cl-print-insert-ellipsis object nil stream)
- ;; Print the string.
+ ;; Print all or part of the string
(when has-properties
(princ "#(" stream))
- (prin1 (if has-properties (substring-no-properties object) object)
- stream)
+ (if (= limit len)
+ (prin1 (if has-properties (substring-no-properties object) object)
+ stream)
+ (let ((part (concat (substring-no-properties object 0 limit) "...")))
+ (prin1 part stream)
+ (when (bufferp stream)
+ (with-current-buffer stream
+ (cl-print-propertize-ellipsis object limit
+ (- (point) 4)
+ (- (point) 1) stream)))))
;; Print the property list.
(when has-properties
(cl-print--string-props object 0 stream)
@@ -315,8 +339,9 @@ into a button whose action shows the function's
disassembly.")
(let* ((len (length object)))
(if (atom start)
;; Print part of the string.
- (let* ((limit (if (natnump print-length)
- (min (+ start print-length) len) len))
+ (let* ((limit (if (natnump cl-print-string-length)
+ (min (+ start cl-print-string-length) len)
+ len))
(substr (substring-no-properties object start limit))
(printed (prin1-to-string substr))
(trimmed (substring printed 1 -1)))
@@ -547,6 +572,11 @@ abbreviating it with ellipses to fit within a size limit."
((null limit) nil)
((eq limit t) print-level)
(t (min 8 (truncate (log limit))))))
+ (cl-print-string-length
+ (cond
+ ((or (null limit) (zerop limit)) nil)
+ ((eq limit t) cl-print-string-length)
+ (t (max 0 (- limit 3)))))
(delta-length (when (natnump limit)
(max 1 (truncate (/ print-length print-level))))))
(with-temp-buffer
@@ -562,7 +592,10 @@ abbreviating it with ellipses to fit within a size limit."
(let* ((ratio (/ result limit))
(delta-level (max 1 (min (- print-level 2) ratio))))
(cl-decf print-level delta-level)
- (cl-decf print-length (* delta-length delta-level)))))))))
+ (cl-decf print-length (* delta-length delta-level))
+ (when cl-print-string-length
+ (cl-decf cl-print-string-length
+ (ceiling cl-print-string-length 4.0))))))))))
(provide 'cl-print)
;;; cl-print.el ends here
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index 9812c663ea8..700f007d6b4 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -79,16 +79,16 @@ are as follows, and suppress messages about the indicated
features:
empty-let - let-bindings with empty variable lists"
:type '(choice (const :tag "Don't suppress any warnings" nil)
(repeat :tag "List of issues to ignore"
- (choice (const undefined-functions
- :tag "Calls to unknown functions")
- (const unbound-reference
- :tag "Reference to unknown variables")
- (const unbound-assignment
- :tag "Assignment to unknown variables")
- (const macro-expansion
- :tag "Failure to expand macros")
- (const empty-let
- :tag "Let-binding with empty
varlist"))))
+ (choice (const :tag "Calls to unknown functions"
+ undefined-functions)
+ (const :tag "Reference to unknown variables"
+ unbound-reference)
+ (const :tag "Assignment to unknown variables"
+ unbound-assignment)
+ (const :tag "Failure to expand macros"
+ macro-expansion)
+ (const :tag "Let-binding with empty varlist"
+ empty-let))))
:safe (lambda (value) (or (null value)
(and (listp value)
(equal value
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index b55eb431668..b46c74343c0 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -8,6 +8,9 @@
;; Version: 3.3.1
;; Package-Requires: ((emacs "26"))
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 5a508882dc3..e23a61c58a4 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1986,7 +1986,7 @@ Used to populate `package-selected-packages'."
;; It is valid to set it to nil, for example when the last package
;; is uninstalled. But it shouldn't be done at init time, to
;; avoid overwriting configurations that haven't yet been loaded.
- (setq package-selected-packages value))
+ (setq package-selected-packages (sort value #'string<)))
(if after-init-time
(customize-save-variable 'package-selected-packages
package-selected-packages)
(add-hook 'after-init-hook #'package--save-selected-packages)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index ec4fae548c7..8b7f4c2cfa5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -17,6 +17,9 @@
;; Keywords: IRC, chat, client, Internet
;; URL: https://www.gnu.org/software/emacs/erc.html
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index b4d9b044a7b..1d828bd7f82 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -319,17 +319,6 @@ This only returns external (non-Lisp) processes."
(setq-local eshell-last-async-procs nil)
(add-hook 'eshell-kill-hook #'eshell-resume-command nil t)
-
- ;; make sure that if a command is over, and no process is being
- ;; waited for, that `eshell-current-command' is set to nil. This
- ;; situation can occur, for example, if a Lisp function results in
- ;; `debug' being called, and the user then types \\[top-level]
- (add-hook 'eshell-post-command-hook
- (lambda ()
- (setq eshell-current-command nil
- eshell-last-async-procs nil))
- nil t)
-
(add-hook 'eshell-parse-argument-hook
#'eshell-parse-subcommand-argument nil t)
(add-hook 'eshell-parse-argument-hook
@@ -432,8 +421,9 @@ command hooks should be run before and after the command."
(if toplevel
`(eshell-commands (progn
(run-hooks 'eshell-pre-command-hook)
- (catch 'top-level (progn ,@commands))
- (run-hooks 'eshell-post-command-hook)))
+ (unwind-protect
+ (progn ,@commands)
+ (run-hooks 'eshell-post-command-hook))))
(macroexp-progn commands))))
(defun eshell-debug-show-parsed-args (terms)
@@ -772,15 +762,14 @@ to this hook using `nconc', and *not* `add-hook'.
Someday, when Scheme will become the dominant Emacs language, all of
this grossness will be made to disappear by using `call/cc'..."
- `(let ((eshell-this-command-hook '(ignore)))
- (eshell-condition-case err
- (prog1
- ,object
- (mapc #'funcall eshell-this-command-hook))
- (error
- (mapc #'funcall eshell-this-command-hook)
- (eshell-errorn (error-message-string err))
- (eshell-close-handles 1)))))
+ `(eshell-condition-case err
+ (let ((eshell-this-command-hook '(ignore)))
+ (unwind-protect
+ ,object
+ (mapc #'funcall eshell-this-command-hook)))
+ (error
+ (eshell-errorn (error-message-string err))
+ (eshell-close-handles 1))))
(defvar eshell-output-handle) ;Defined in esh-io.el.
(defvar eshell-error-handle) ;Defined in esh-io.el.
@@ -1015,30 +1004,41 @@ process(es) in a cons cell like:
(defun eshell-resume-command (proc status)
"Resume the current command when a pipeline ends."
(when (and proc
- ;; Make sure STATUS is something we want to handle.
- (stringp status)
- (not (string= "stopped" status))
- (not (string-match eshell-reset-signals status))
;; 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)))
- (eshell-resume-eval)))
+ (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 (catch 'eshell-defer
- (ignore
- (setq retval
- (eshell-do-eval
- eshell-current-command))))))
- (if retval
- (cadr retval)
- (ignore (setq eshell-last-async-procs procs))))
+ (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)
+ ;; 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))))))
@@ -1051,9 +1051,10 @@ process(es) in a cons cell like:
(let ((,tag-symbol ,tag))
(eshell-always-debug-command 'form
"%s\n\n%s" ,tag-symbol (eshell-stringify ,form))
- ,@body
- (eshell-always-debug-command 'form
- "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form))))))
+ (unwind-protect
+ (progn ,@body)
+ (eshell-always-debug-command 'form
+ "done %s\n\n%s" ,tag-symbol (eshell-stringify ,form)))))))
(defun eshell-do-eval (form &optional synchronous-p)
"Evaluate FORM, simplifying it as we go.
@@ -1181,20 +1182,40 @@ have been replaced by constants."
;; If we get here, there was no `eshell-defer' thrown, so
;; just return the `let' body's result.
result)))
- ((memq (car form) '(catch condition-case unwind-protect))
- ;; `condition-case' and `unwind-protect' have to be
- ;; handled specially, because we only want to call
- ;; `eshell-do-eval' on their first form.
+ ((memq (car form) '(catch condition-case))
+ ;; `catch' and `condition-case' have to be handled specially,
+ ;; because we only want to call `eshell-do-eval' on their
+ ;; second forms.
;;
;; NOTE: This requires obedience by all forms which this
;; function might encounter, that they do not contain
;; other special forms.
- (unless (eq (car form) 'unwind-protect)
- (setq args (cdr args)))
+ (setq args (cdr args))
(unless (eq (caar args) 'eshell-do-eval)
(eshell-manipulate form "handling special form"
(setcar args `(eshell-do-eval ',(car args) ,synchronous-p))))
(eval form))
+ ((eq (car form) 'unwind-protect)
+ ;; `unwind-protect' has to be handled specially, because we
+ ;; only want to call `eshell-do-eval' on its first form, and
+ ;; we need to ensure we let `eshell-defer' through without
+ ;; evaluating the unwind forms.
+ (let (deferred)
+ (unwind-protect
+ (eshell-manipulate form "handling `unwind-protect' body form"
+ (setq deferred
+ (catch 'eshell-defer
+ (ignore
+ (setcar args (eshell-do-eval
+ (car args) synchronous-p)))))
+ (car args))
+ (if deferred
+ (throw 'eshell-defer deferred)
+ (eshell-manipulate form "handling `unwind-protect' unwind forms"
+ (pop args)
+ (while args
+ (setcar args (eshell-do-eval (car args) synchronous-p))
+ (pop args)))))))
((eq (car form) 'setq)
(if (cddr args) (error "Unsupported form (setq X1 E1 X2 E2..)"))
(eshell-manipulate form "evaluating arguments to setq"
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index cd0cee6e21d..d0f1e04e925 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -648,8 +648,11 @@ Returns what was actually sent, or nil if nothing was
sent.")
(process-send-string target object)
(error
;; If `process-send-string' raises an error and the process has
- ;; finished, treat it as a broken pipe. Otherwise, just
- ;; re-throw the signal.
+ ;; finished, treat it as a broken pipe. Otherwise, just re-raise
+ ;; the signal. NOTE: When running Emacs in batch mode
+ ;; (e.g. during regression tests), Emacs can abort due to SIGPIPE
+ ;; here. Maybe `process-send-string' should handle SIGPIPE even
+ ;; in batch mode (bug#66186).
(if (process-live-p target)
(signal (car err) (cdr err))
(signal 'eshell-pipe-broken (list target)))))
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index e564c755320..d15e1e7d09b 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -129,6 +129,7 @@ To add or remove elements of this list, see
"Function run when killing a process.
Runs `eshell-reset-after-proc' and `eshell-kill-hook', passing arguments
PROC and STATUS to functions on the latter."
+ (declare (obsolete nil "30.1"))
;; Was there till 24.1, but it is not optional.
(remove-hook 'eshell-kill-hook #'eshell-reset-after-proc)
;; Only reset the prompt if this process is running interactively.
@@ -151,6 +152,7 @@ PROC and STATUS to functions on the latter."
"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)
@@ -434,7 +436,7 @@ Used only on systems which do not support async
subprocesses.")
(eshell-close-handles
(if (numberp exit-status) exit-status -1)
(list 'quote (and (numberp exit-status) (= exit-status 0))))
- (eshell-kill-process-function command exit-status)
+ (run-hook-with-args 'eshell-kill-hook command exit-status)
(or (bound-and-true-p eshell-in-pipeline-p)
(setq eshell-last-sync-output-start nil))
(if (not (numberp exit-status))
@@ -550,7 +552,7 @@ PROC is the process that's exiting. STRING is the exit
message."
(eshell-debug-command 'process
"finished external process `%s'" proc)
(if primary
- (eshell-kill-process-function proc string)
+ (run-hook-with-args 'eshell-kill-hook proc
string)
(setcar stderr-live nil))))))
(funcall finish-io)))
(when-let ((entry (assq proc eshell-process-list)))
@@ -647,25 +649,25 @@ See the variable `eshell-kill-processes-on-exit'."
"Interrupt a process."
(interactive)
(unless (eshell-process-interact 'interrupt-process)
- (eshell-kill-process-function nil "interrupt")))
+ (run-hook-with-args 'eshell-kill-hook nil "interrupt")))
(defun eshell-kill-process ()
"Kill a process."
(interactive)
(unless (eshell-process-interact 'kill-process)
- (eshell-kill-process-function nil "killed")))
+ (run-hook-with-args 'eshell-kill-hook nil "killed")))
(defun eshell-quit-process ()
"Send quit signal to process."
(interactive)
(unless (eshell-process-interact 'quit-process)
- (eshell-kill-process-function nil "quit")))
+ (run-hook-with-args 'eshell-kill-hook nil "quit")))
;(defun eshell-stop-process ()
; "Send STOP signal to process."
; (interactive)
; (unless (eshell-process-interact 'stop-process)
-; (eshell-kill-process-function nil "stopped")))
+; (run-hook-with-args 'eshell-kill-hook nil "stopped")))
;(defun eshell-continue-process ()
; "Send CONTINUE signal to process."
@@ -674,7 +676,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'.
-; (eshell-kill-process-function nil "continue")))
+; (run-hook-with-args 'eshell-kill-hook nil "continue")))
(provide 'esh-proc)
;;; esh-proc.el ends here
diff --git a/lisp/external-completion.el b/lisp/external-completion.el
index 3f80be1c0a4..dd2710602fe 100644
--- a/lisp/external-completion.el
+++ b/lisp/external-completion.el
@@ -7,6 +7,9 @@
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Keywords:
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index ae4c4cc0d71..a21d57d86ff 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -148,6 +148,7 @@ easy interactive way to set this from the Server buffer."
(defun gnus-cloud-decode-data ()
(cond
+ ;; FIXME: Duplicated value in ‘cond’: base64-gzip.
((memq gnus-cloud-storage-method '(base64 base64-gzip))
(base64-decode-region (point-min) (point-max)))
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index b6b9927a788..969589bb942 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -747,16 +747,14 @@ default is system dependent and determined by the function
`message-send-mail-function'.
See also `send-mail-function'."
- :type '(radio (function-item message--default-send-mail-function
- :tag "Use send-mail-function")
+ :type '(radio (function-item message--default-send-mail-function)
(function-item message-send-mail-with-sendmail)
(function-item message-send-mail-with-mh)
(function-item message-send-mail-with-qmail)
(function-item message-smtpmail-send-it)
- (function-item smtpmail-send-it)
+ (function-item :doc "Use SMTPmail package." smtpmail-send-it)
(function-item feedmail-send-it)
- (function-item message-send-mail-with-mailclient
- :tag "Use Mailclient package")
+ (function-item message-send-mail-with-mailclient)
(function :tag "Other"))
:group 'message-sending
:version "27.1"
@@ -8210,7 +8208,6 @@ which specify the range to operate on."
It can be either a list or a symbol referring to a list. See
`gmm-tool-bar-from-list' for the format of the list. The
default key map is `message-mode-map'."
- :type '(repeat gmm-tool-bar-list-item)
:type '(choice (repeat :tag "User defined list" gmm-tool-bar-item)
(symbol))
:version "29.1"
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index b9beedf6c5c..3c7d1e7e073 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -119,7 +119,7 @@
((executable-find "links") 'links)
((executable-find "lynx") 'lynx)
(t 'shr))
- "Render of HTML contents.
+ "Renderer of HTML contents.
It is one of defined renderer types, or a rendering function.
The defined renderer types are:
`shr': use the built-in Gnus HTML renderer;
@@ -131,8 +131,8 @@ The defined renderer types are:
:version "29.1"
:type '(choice (const shr)
(const gnus-w3m)
- (const w3m :tag "emacs-w3m")
- (const w3m-standalone :tag "standalone w3m" )
+ (const :tag "emacs-w3m" w3m)
+ (const :tag "standalone w3m" w3m-standalone)
(const links)
(const lynx)
(function))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index b34778773a9..e93c535bbef 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -767,7 +767,7 @@ the C sources, too."
" is obsolete")
(when (nth 2 obsolete)
(insert (format " since %s" (nth 2 obsolete))))
- (insert (cond ((stringp use) (concat "; " use))
+ (insert (cond ((stringp use) (concat "; " (substitute-quotes use)))
(use (format-message "; use `%s' instead." use))
(t "."))
"\n")
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index 5477473ae8c..81d5a1acdf4 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -346,6 +346,8 @@ If NO-REDUCTION is non-nil, do not reduce the dictionary
vocabulary."
(erase-buffer)
(buffer-disable-undo)
(generate-lisp-file-heading ja-dic-filename 'skkdic-convert :code nil)
+ (insert (format ";; Generated with small ja-dic option: %s\n\n"
+ (if no-reduction "no" "yes")))
(insert ";; Original SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
"\n\n"
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index b0f86839740..efc06ffbbf8 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -161,8 +161,8 @@ systems, set your locale instead."
((eq ls-lisp-emulation 'MS-Windows)
(if (and (fboundp 'w32-using-nt) (w32-using-nt))
'(links))) ; distinguish NT/2K from 9x
- ((eq ls-lisp-emulation 'UNIX) '(links uid)) ; UNIX ls
- (t '(links uid gid))) ; GNU ls
+ ((eq ls-lisp-emulation 'UNIX) '(links uid modes)) ; UNIX ls
+ (t '(links uid gid modes))) ; GNU ls
"A list of optional file attributes that ls-lisp should display.
It should contain none or more of the symbols: links, uid, gid.
A value of nil (or an empty list) means display none of them.
@@ -808,7 +808,9 @@ SWITCHES and TIME-INDEX give the full switch list and time
data."
(* 1024.0 (fceiling (/ file-size 1024.0)))))
(format ls-lisp-filesize-b-fmt
(fceiling (/ file-size 1024.0)))))
- drwxrwxrwx ; attribute string
+ (if (memq 'modes ls-lisp-verbosity)
+ drwxrwxrwx ; modes string
+ (substring drwxrwxrwx 0 1)) ; "d" or "-" for directory vs file
(if (memq 'links ls-lisp-verbosity)
(format "%3d" (file-attribute-link-number file-attr)))
;; Numeric uid/gid are more confusing than helpful;
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 8d7e90ccacf..8306bd3b30c 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -151,11 +151,11 @@ not a valid RFC 822 (or later) header or continuation
line,
that matches the variable `mail-header-separator'.
This is used by the default mail-sending commands. See also
`message-send-mail-function' for use with the Message package."
- :type '(radio (function-item sendmail-send-it :tag "Use Sendmail package")
- (function-item sendmail-query-once :tag "Query the user")
- (function-item smtpmail-send-it :tag "Use SMTPmail package")
- (function-item feedmail-send-it :tag "Use Feedmail package")
- (function-item mailclient-send-it :tag "Use Mailclient package")
+ :type '(radio (function-item sendmail-send-it)
+ (function-item sendmail-query-once)
+ (function-item :doc "Use SMTPmail package." smtpmail-send-it)
+ (function-item feedmail-send-it)
+ (function-item mailclient-send-it)
function)
:version "24.1")
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 5e837485db3..3a348ebcdc6 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -2227,7 +2227,7 @@ otherwise it could decide to silently do nothing."
((not (menu-bar-menu-frame-live-and-visible-p)))
((menu-bar-non-minibuffer-window-p)
(kill-buffer (current-buffer))
- ;; Also close the current window if `menu-bar-close-windows' is
+ ;; Also close the current window if `menu-bar-close-window' is
;; set.
(when menu-bar-close-window
(ignore-errors (delete-window))))
@@ -2314,14 +2314,16 @@ The menu shows all the killed text sequences stored in
`kill-ring'."
;;; Buffers Menu
-(defcustom buffers-menu-max-size 10
+(defcustom buffers-menu-max-size (if (display-graphic-p) 15 10)
"Maximum number of entries which may appear on the Buffers menu.
-If this is 10, then only the ten most-recently-selected buffers are shown.
-If this is nil, then all buffers are shown.
-A large number or nil slows down menu responsiveness."
- :type '(choice integer
- (const :tag "All" nil))
- :group '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
+ :version "30.1")
(defcustom buffers-menu-buffer-name-length 30
"Maximum length of the buffer name on the Buffers menu.
@@ -2465,9 +2467,12 @@ It must accept a buffer as its only required argument.")
;; Make the menu of buffers proper.
(setq buffers-menu
(let ((i 0)
- (limit (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1)
- buffers-menu-max-size))
+ (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))
alist)
;; Put into each element of buffer-list
;; the name for actual display,
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 9ac28c26c48..2873a2542f9 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -387,6 +387,157 @@ whose file names match the specified wildcard."
(goto-char (if isearch-forward (point-min) (point-max)))
(isearch-forward-regexp nil t)))
+
+;;; Global multi-file replacements as diff
+
+(defcustom multi-file-diff-unsaved 'save-buffers
+ "What to do with unsaved edits when showing multi-file replacements as diffs.
+If the value is `save-buffers', save unsaved buffers before creating diff.
+If the value is `use-file', use text from the file even when the
+file-visiting buffer is modified.
+If the value is `use-modified-buffer', use text from the file-visiting
+modified buffer to be able to use unsaved changes."
+ :type '(choice
+ (const :tag "Save buffers" save-buffers)
+ (const :tag "Use file" use-file)
+ (const :tag "Use modified buffer" use-modified-buffer))
+ :version "30.1")
+
+(declare-function diff-setup-whitespace "diff-mode" ())
+(declare-function diff-setup-buffer-type "diff-mode" ())
+
+(defun multi-file-replace-as-diff (files from-string replacements regexp-flag
delimited-flag)
+ "Show as diffs replacements of FROM-STRING with REPLACEMENTS.
+FILES is a list of file names. REGEXP-FLAG and DELIMITED-FLAG have
+the same meaning as in `perform-replace'."
+ (require 'diff)
+ (let ((inhibit-message t)
+ (diff-buffer (get-buffer-create "*replace-diff*")))
+ (when (eq multi-file-diff-unsaved 'save-buffers)
+ (save-some-buffers t (lambda ()
+ (seq-some (lambda (f-or-b)
+ (equal f-or-b buffer-file-name))
+ files))))
+ (with-current-buffer diff-buffer
+ (buffer-disable-undo (current-buffer))
+ (let ((inhibit-read-only t))
+ (erase-buffer))
+ ;; Make the *vc-diff* buffer read only, the diff-mode key
+ ;; bindings are nicer for read only buffers.
+ (setq buffer-read-only t)
+ (diff-mode))
+ (dolist (file-name files)
+ (let* ((file-exists (file-exists-p file-name))
+ (file-buffer
+ (when (or (not file-exists)
+ (eq multi-file-diff-unsaved 'use-modified-buffer))
+ (find-buffer-visiting file-name))))
+ (when file-name
+ (with-temp-buffer
+ (if (and file-buffer
+ (or (not file-exists)
+ (buffer-modified-p file-buffer)))
+ (insert-buffer-substring file-buffer)
+ (insert-file-contents file-name))
+ (goto-char (point-min))
+ (perform-replace from-string replacements nil regexp-flag
delimited-flag)
+ (multi-file-diff-no-select
+ (if file-exists file-name file-buffer)
+ (current-buffer) nil diff-buffer
+ (concat file-name "~") file-name)))))
+ (with-current-buffer diff-buffer
+ (diff-setup-whitespace)
+ (diff-setup-buffer-type)
+ (buffer-enable-undo (current-buffer))
+ (setq-local revert-buffer-function
+ (lambda (_ignore-auto _noconfirm)
+ (multi-file-replace-as-diff
+ files from-string replacements regexp-flag
delimited-flag)))
+ (goto-char (point-min)))
+ (pop-to-buffer diff-buffer)))
+
+;;;###autoload
+(defun multi-file-replace-regexp-as-diff (files regexp to-string &optional
delimited)
+ "Show as diffs replacements of REGEXP with TO-STRING in FILES.
+DELIMITED has the same meaning as in `replace-regexp'.
+The replacements are displayed in the buffer *replace-diff* that
+you can later apply as a patch after reviewing the changes."
+ (interactive
+ (let ((files (multi-isearch-read-files))
+ (common
+ (query-replace-read-args
+ (concat "Replace"
+ (if current-prefix-arg " word" "")
+ " regexp as diff in files")
+ t t)))
+ (list files (nth 0 common) (nth 1 common) (nth 2 common))))
+ (multi-file-replace-as-diff files regexp to-string t delimited))
+
+;;;###autoload
+(defun replace-regexp-as-diff (regexp to-string &optional delimited)
+ "Show as diffs replacements of REGEXP with TO-STRING in the current buffer.
+DELIMITED has the same meaning as in `replace-regexp'.
+The replacements are displayed in the buffer *replace-diff* that
+you can later apply as a patch after reviewing the changes."
+ (interactive
+ (let ((common
+ (query-replace-read-args
+ (concat "Replace"
+ (if current-prefix-arg " word" "")
+ " regexp as diff")
+ t t)))
+ (list (nth 0 common) (nth 1 common) (nth 2 common))))
+ (multi-file-replace-as-diff
+ (list buffer-file-name) regexp to-string t delimited))
+
+(defvar diff-use-labels)
+(declare-function diff-check-labels "diff" (&optional force))
+(declare-function diff-file-local-copy "diff" (file-or-buf))
+
+(defun multi-file-diff-no-select (old new &optional switches buf label-old
label-new)
+ ;; Based on `diff-no-select' tailored to multi-file diffs.
+ "Compare the OLD and NEW file/buffer.
+If the optional SWITCHES is nil, the switches specified in the
+variable `diff-switches' are passed to the diff command,
+otherwise SWITCHES is used. SWITCHES can be a string or a list
+of strings. BUF should be non-nil. LABEL-OLD and LABEL-NEW
+specify labels to use for file names."
+ (unless (bufferp new) (setq new (expand-file-name new)))
+ (unless (bufferp old) (setq old (expand-file-name old)))
+ (or switches (setq switches diff-switches)) ; If not specified, use default.
+ (setq switches (ensure-list switches))
+ (diff-check-labels)
+ (let* ((old-alt (diff-file-local-copy old))
+ (new-alt (diff-file-local-copy new))
+ (command
+ (mapconcat #'identity
+ `(,diff-command
+ ;; Use explicitly specified switches
+ ,@switches
+ ,@(mapcar #'shell-quote-argument
+ (nconc
+ (and (or old-alt new-alt)
+ (eq diff-use-labels t)
+ (list "--label"
+ (cond ((stringp label-old)
label-old)
+ ((stringp old) old)
+ ((prin1-to-string old)))
+ "--label"
+ (cond ((stringp label-new)
label-new)
+ ((stringp new) new)
+ ((prin1-to-string new)))))
+ (list (or old-alt old)
+ (or new-alt new)))))
+ " ")))
+ (with-current-buffer buf
+ (let ((inhibit-read-only t))
+ (insert command "\n")
+ (call-process shell-file-name nil buf nil
+ shell-command-switch command))
+ (if old-alt (delete-file old-alt))
+ (if new-alt (delete-file new-alt)))))
+
+
(defvar unload-function-defs-list)
(defun multi-isearch-unload-function ()
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 4ddda216afc..e43ef2bfe8b 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -2062,7 +2062,8 @@ If CHARSET is nil then use UTF-8."
(let ((completion-extra-properties
'(:annotation-function (lambda (buf)
(with-current-buffer buf
- (format " %s" (eww-current-url)))))))
+ (format " %s" (eww-current-url))))))
+ (curbuf (current-buffer)))
(pop-to-buffer-same-window
(read-buffer "Switch to EWW buffer: "
(cl-loop for buf in (nreverse (buffer-list))
@@ -2070,9 +2071,10 @@ If CHARSET is nil then use UTF-8."
return buf)
t
(lambda (bufn)
- (with-current-buffer
- (if (consp bufn) (cdr bufn) (get-buffer bufn))
- (derived-mode-p 'eww-mode)))))))
+ (setq bufn (if (consp bufn) (cdr bufn) (get-buffer bufn)))
+ (and (with-current-buffer bufn
+ (derived-mode-p 'eww-mode))
+ (not (eq bufn curbuf))))))))
(defun eww-toggle-fonts ()
"Toggle whether to use monospaced or font-enabled layouts."
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 36b1654222a..955172d8bb6 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -96,7 +96,7 @@ Security'."
(repeat :tag "List of hostname regexps with flags for each"
(list
(choice :tag "Hostname"
- (const ".*" :tag "Any hostname")
+ (const :tag "Any hostname" ".*")
regexp)
(set (const :trustfiles)
(const :hostname))))))
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index c92c90bf694..3d994ed9e76 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -1,6 +1,6 @@
;;; ntlm.el --- NTLM (NT LanManager) authentication support -*-
lexical-binding:t -*-
-;; Copyright (C) 2001, 2007-2023 Free Software Foundation, Inc.
+;; Copyright (C) 2001-2023 Free Software Foundation, Inc.
;; Author: Taro Kawagishi <tarok@transpulse.org>
;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
@@ -8,6 +8,9 @@
;; Version: 2.1.0
;; Created: February 2001
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index 010e86354b6..b2bb59a25a0 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -11,6 +11,9 @@
;; URL: https://github.com/alex-hhh/emacs-soap-client
;; Package-Requires: ((emacs "24.1") (cl-lib "0.6.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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index e4edb6cfcca..07f1cf24542 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1291,6 +1291,9 @@ Operations not mentioned here will be handled by the
normal Emacs functions.")
(defconst tramp-sunos-unames (rx (| "SunOS 5.10" "SunOS 5.11"))
"Regexp to determine remote SunOS.")
+(defconst tramp-bsd-unames (rx (| "BSD" "DragonFly" "Darwin"))
+ "Regexp to determine remote *BSD and macOS.")
+
(defun tramp-sh--quoting-style-options (vec)
"Quoting style options to be used for VEC."
(or
@@ -1789,7 +1792,7 @@ ID-FORMAT valid values are `string' and `integer'."
;; On BSD-derived systems files always inherit the
;; parent directory's group, so skip the group-gid
;; test.
- (tramp-check-remote-uname v (rx (| "BSD" "DragonFly"
"Darwin")))
+ (tramp-check-remote-uname v tramp-bsd-unames)
(= (file-attribute-group-id attributes)
(tramp-get-remote-gid v 'integer)))))))))
@@ -2643,12 +2646,14 @@ The method used must be an out-of-band method."
(not ls-lisp-use-insert-directory-program))
(tramp-handle-insert-directory
filename switches wildcard full-directory-p)
- (when (stringp switches)
- (setq switches (split-string switches)))
- (setq switches
- (append switches (split-string (tramp-sh--quoting-style-options
v))))
- (unless (tramp-get-ls-command-with v "--dired")
- (setq switches (delete "-N" (delete "--dired" switches))))
+ (let ((dired (tramp-get-ls-command-with v "--dired")))
+ (when (stringp switches)
+ (setq switches (split-string switches)))
+ (setq switches
+ (append switches (split-string (tramp-sh--quoting-style-options
v))
+ (when dired `(,dired))))
+ (unless dired
+ (setq switches (delete "-N" (delete "--dired" switches)))))
(when wildcard
(setq wildcard (tramp-run-real-handler
#'file-name-nondirectory (list localname)))
@@ -2656,7 +2661,8 @@ The method used must be an out-of-band method."
#'file-name-directory (list localname))))
(unless (or full-directory-p (member "-d" switches))
(setq switches (append switches '("-d"))))
- (setq switches (mapconcat #'tramp-shell-quote-argument switches " "))
+ (setq switches (delete-dups switches)
+ switches (mapconcat #'tramp-shell-quote-argument switches " "))
(when wildcard
(setq switches (concat switches " " wildcard)))
(tramp-message
@@ -4586,7 +4592,7 @@ process to set up. VEC specifies the connection."
(tramp-send-command vec "set +H" t))
;; Disable tab expansion.
- (if (string-match-p (rx (| "BSD" "DragonFly" "Darwin")) uname)
+ (if (string-match-p tramp-bsd-unames uname)
(tramp-send-command vec "stty tabs" t)
(tramp-send-command vec "stty tab0" t))
@@ -5694,7 +5700,10 @@ Nonexistent directories are removed from spec."
(tramp-message vec 5 "Finding a suitable `ls' command")
(or
(catch 'ls-found
- (dolist (cmd '("ls" "gnuls" "gls"))
+ (dolist (cmd
+ ;; Prefer GNU ls on *BSD and macOS.
+ (if (tramp-check-remote-uname vec tramp-bsd-unames)
+ '( "gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
(let ((dl (tramp-get-remote-path vec))
result)
(while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 131f632a0fe..102ba637f55 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -60,7 +60,7 @@
;; These are for remote processes.
(tramp-login-program "ssh")
(tramp-login-args (("-q") ("-l" "%u") ("-p" "%p")
- ("-e" "none") ("-t" "-t")
+ ("-e" "none") ("%a" "%a")
("%h") ("%l")))
(tramp-direct-async t)
(tramp-remote-shell ,tramp-default-remote-shell)
@@ -326,7 +326,7 @@ arguments to pass to the OPERATION."
?h (or (tramp-file-name-host v) "")
?u (or (tramp-file-name-user v) "")
?p (or (tramp-file-name-port v) "")
- ?l command))
+ ?a "-t" ?l command))
;; Synchronize stderr.
(when tmpstderr
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 782582e1daf..aca2ebb8e8a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -8,6 +8,9 @@
;; Keywords: comm, processes
;; Package: tramp
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded in trampver.el.
+
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
@@ -240,9 +243,9 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
\"%\" followed by a letter are expanded in the arguments as
follows:
- - \"%h\" is replaced by the host name
- - \"%u\" is replaced by the user name
- - \"%p\" is replaced by the port number
+ - \"%h\" is replaced by the host name.
+ - \"%u\" is replaced by the user name.
+ - \"%p\" is replaced by the port number.
- \"%%\" can be used to obtain a literal percent character.
If a sub-list containing \"%h\", \"%u\" or \"%p\" is
@@ -271,6 +274,8 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
- \"%z\" is replaced by the `tramp-scp-direct-remote-copying'
argument if it is supported.
- \"%d\" is replaced by the device detected by `tramp-adb-get-device'.
+ - \"%a\" adds the pseudo-terminal allocation argument \"-t\" in
+ asynchronous processes, if the connection type is not `pipe'.
The existence of `tramp-login-args', combined with the
absence of `tramp-copy-args', is an indication that the
@@ -4870,6 +4875,7 @@ a connection-local variable."
(when adb-file-name-handler-p
(tramp-compat-funcall
'tramp-adb-get-device v)))
+ (pta (unless (eq connection-type 'pipe) "-t"))
login-args p)
;; Replace `login-args' place holders. Split
@@ -4885,7 +4891,7 @@ a connection-local variable."
v 'tramp-login-args
?h (or host "") ?u (or user "") ?p (or port "")
?c (format-spec (or options "") (format-spec-make ?t tmpfile))
- ?d (or device "") ?l ""))))
+ ?d (or device "") ?a (or pta "") ?l ""))))
p (make-process
:name name :buffer buffer
:command (append `(,login-program) login-args command)
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 5a600a84f22..9ca7f155614 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -14035,6 +14035,7 @@ user."
(unless deltadef
(let ((now (decode-time)))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
+ ;; FIXME: Duplicated value in ‘cond’: ""
(cond ((member deltaw '("h" ""))
(when (boundp 'org-time-was-given)
(setq org-time-was-given t))
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index b27254b8ac5..cfad311207a 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -3094,6 +3094,7 @@ CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((latex-frag (org-element-property :value latex-fragment))
(processing-type (plist-get info :with-latex)))
(cond
+ ;; FIXME: Duplicated value in ‘cond’: t
((memq processing-type '(t mathjax))
(org-html-format-latex latex-frag 'mathjax info))
((memq processing-type '(t html))
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index c367341345d..22f63bb5be7 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -754,14 +754,14 @@
(if (eq (char-after beg) ?_) (setq beg (1+ beg)))
;; First put the properties on the delimiters.
- (cond ((eq end (point-max)) ; string/regexp terminated by EOB
- (c-put-char-property beg 'syntax-table '(15))) ; (15) = "string fence"
- ((/= (char-after beg) (char-after end)) ; missing end delimiter
- (c-put-char-property beg 'syntax-table '(15))
- (c-put-char-property end 'syntax-table '(15)))
- ((eq (char-after beg) ?/) ; Properly bracketed regexp
- (c-put-char-property beg 'syntax-table '(7)) ; (7) = "string"
- (c-put-char-property end 'syntax-table '(7)))
+ (cond ((eq end (point-max)) ; string/regexp terminated by EOB
+ (c-put-string-fence beg))
+ ((/= (char-after beg) (char-after end)) ; missing end delimiter
+ (c-put-string-fence beg)
+ (c-put-string-fence end))
+ ((eq (char-after beg) ?/) ; Properly bracketed regexp
+ (c-put-char-property beg 'syntax-table '(7)) ; (7) = "string"
+ (c-put-char-property end 'syntax-table '(7)))
(t)) ; Properly bracketed string: Nothing to do.
;; Now change the properties of any escaped "s in the string to punctuation.
(save-excursion
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 6e4b570c2e8..8662e0cade6 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -733,9 +733,10 @@ various buffer change hooks."
(defmacro c-forward-syntactic-ws (&optional limit)
"Forward skip over syntactic whitespace.
-Syntactic whitespace is defined as whitespace characters, comments,
-and preprocessor directives. However if point starts inside a comment
-or preprocessor directive, the content of it is not treated as
+Syntactic whitespace is defined as whitespace characters with
+whitespace (or comment-end) syntax, comments, and preprocessor
+directives. However if point starts inside a comment or
+preprocessor directive, the content of it is not treated as
whitespace.
LIMIT sets an upper limit of the forward movement, if specified. If
@@ -755,9 +756,10 @@ comment at the start of cc-engine.el for more info."
(defmacro c-backward-syntactic-ws (&optional limit)
"Backward skip over syntactic whitespace.
-Syntactic whitespace is defined as whitespace characters, comments,
-and preprocessor directives. However if point starts inside a comment
-or preprocessor directive, the content of it is not treated as
+Syntactic whitespace is defined as whitespace characters with
+whitespace (or comment-end) syntax, comments, and preprocessor
+directives. However if point starts inside a comment or
+preprocessor directive, the content of it is not treated as
whitespace.
LIMIT sets a lower limit of the backward movement, if specified. If
@@ -1102,6 +1104,38 @@ continuations."
(eq (char-before) ?\\)))
(backward-char))))
+(defmacro c-skip-ws-chars-forward (string &optional lim)
+ ;; Move point forward, stopping before a char which isn't in STRING, or a
+ ;; char whose syntax isn't whitespace or comment-end, or at pos LIM.
+ ;; Note that \n usually has comment-end syntax.
+ ;;
+ ;; Returns the distance traveled, either zero or positive.
+ (declare (debug t))
+ `(let ((-lim- ,lim)
+ (here (point))
+ count)
+ (setq count (skip-chars-forward ,string -lim-))
+ (when (> count 0)
+ (goto-char here)
+ (setq count (skip-syntax-forward " >" (+ here count))))
+ count))
+
+(defmacro c-skip-ws-chars-backward (string &optional lim)
+ ;; Move point backward, stopping after a char which isn't in STRING, or a
+ ;; char whose syntax isn't whitespace or comment-end, or at pos LIM. Note
+ ;; that \n usually has comment-end syntax.
+ ;;
+ ;; Returns the distance traveled, either zero or negative.
+ (declare (debug t))
+ `(let ((-lim- ,lim)
+ (here (point))
+ count)
+ (setq count (skip-chars-backward ,string -lim-))
+ (when (< count 0)
+ (goto-char here)
+ (setq count (skip-syntax-backward " >" (+ here count))))
+ count))
+
(eval-and-compile
(defvar c-langs-are-parametric nil))
@@ -1208,6 +1242,17 @@ MODE is either a mode symbol or a list of mode symbols."
`((setq c-syntax-table-hwm (min c-syntax-table-hwm -pos-))))
(put-text-property -pos- (1+ -pos-) ',property ,value))))
+(defmacro c-put-string-fence (pos)
+ ;; Put the string-fence syntax-table text property at POS.
+ ;; Since the character there cannot then count as syntactic whitespace,
+ ;; clear the properties `c-is-sws' and `c-in-sws' (see functions
+ ;; `c-forward-sws' and `c-backward-sws' in cc-engine.el for details).
+ (declare (debug t))
+ `(let ((-pos- ,pos))
+ (c-put-char-property -pos- 'syntax-table '(15))
+ (c-clear-char-property -pos- 'c-is-sws)
+ (c-clear-char-property -pos- 'c-in-sws)))
+
(eval-and-compile
;; Constant to decide at compilation time whether to use category
;; properties. Currently (2010-03) they're available only on GNU
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index abcc20fcb82..e687f44d657 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -976,10 +976,10 @@ comment at the start of cc-engine.el for more info."
(point-min)))
(widen)
- (if (save-excursion
- (and (c-beginning-of-macro)
- (/= (point) start)))
- (setq macro-start (point)))
+ (save-excursion
+ (if (and (c-beginning-of-macro)
+ (/= (point) start))
+ (setq macro-start (point))))
;; Try to skip back over unary operator characters, to register
;; that we've moved.
@@ -2130,7 +2130,7 @@ comment at the start of cc-engine.el for more info."
;; Skip simple ws and do a quick check on the following character to see
;; if it's anything that can't start syntactic ws, so we can bail out
;; early in the majority of cases when there just are a few ws chars.
- (skip-chars-forward " \t\n\r\f\v")
+ (c-skip-ws-chars-forward " \t\n\r\f\v")
(when (or (looking-at c-syntactic-ws-start)
(and c-opt-cpp-prefix
(looking-at c-noise-macro-name-re))
@@ -2180,7 +2180,7 @@ comment at the start of cc-engine.el for more info."
rung-pos (point) (point-max))
(setq rung-pos (point))
- (and (> (skip-chars-forward " \t\n\r\f\v") 0)
+ (and (> (c-skip-ws-chars-forward " \t\n\r\f\v") 0)
(not (eobp))))
;; We'll loop here if there is simple ws after the last rung.
@@ -2246,7 +2246,7 @@ comment at the start of cc-engine.el for more info."
(and c-opt-cpp-prefix
(looking-at c-opt-cpp-start)
(setq macro-start (point))
- (progn (skip-chars-backward " \t")
+ (progn (c-skip-ws-chars-backward " \t")
(bolp))
(or (bobp)
(progn (backward-char)
@@ -2286,7 +2286,7 @@ comment at the start of cc-engine.el for more info."
;; We've searched over a piece of non-white syntactic ws. See if this
;; can be cached.
(setq next-rung-pos (point))
- (skip-chars-forward " \t\n\r\f\v")
+ (c-skip-ws-chars-forward " \t\n\r\f\v")
(setq rung-end-pos (min (1+ (point)) (point-max)))
(if (or
@@ -2383,7 +2383,7 @@ comment at the start of cc-engine.el for more info."
;; bail out early in the majority of cases when there just are a few ws
;; chars. Newlines are complicated in the backward direction, so we can't
;; skip over them.
- (skip-chars-backward " \t\f")
+ (c-skip-ws-chars-backward " \t\f")
(when (and (not (bobp))
(save-excursion
(or (and
@@ -2411,7 +2411,7 @@ comment at the start of cc-engine.el for more info."
(setq simple-ws-beg (or attr-end ; After attribute.
(match-end 1) ; Noise macro, etc.
(match-end 0))) ; c-syntactic-ws-end
- (skip-chars-backward " \t\n\r\f\v")
+ (c-skip-ws-chars-backward " \t\n\r\f\v")
(if (setq rung-is-marked (text-property-any
(point) (min (1+ rung-pos) (point-max))
'c-is-sws t))
@@ -2448,10 +2448,10 @@ comment at the start of cc-engine.el for more info."
(point) rung-pos (point-min))
(setq rung-pos (point))
- (if (and (< (min (skip-chars-backward " \t\f\v")
+ (if (and (< (min (c-skip-ws-chars-backward " \t\f\v")
(progn
(setq simple-ws-beg (point))
- (skip-chars-backward " \t\n\r\f\v")))
+ (c-skip-ws-chars-backward " \t\n\r\f\v")))
0)
(setq rung-is-marked
(text-property-any (point) rung-pos
@@ -2531,7 +2531,7 @@ comment at the start of cc-engine.el for more info."
;; the macro, and then `simple-ws-beg' must be kept on the
;; same side of those comments.
(goto-char simple-ws-beg)
- (skip-chars-backward " \t\n\r\f\v")
+ (c-skip-ws-chars-backward " \t\n\r\f\v")
(if (eq (char-before) ?\\)
(forward-char))
(forward-line 1)
@@ -2544,7 +2544,7 @@ comment at the start of cc-engine.el for more info."
t)))
((/= (save-excursion
- (skip-chars-forward " \t\n\r\f\v" simple-ws-beg)
+ (c-skip-ws-chars-forward " \t\n\r\f\v" simple-ws-beg)
(setq next-rung-pos (point)))
simple-ws-beg)
;; Skipped over comments. Must put point at the end of
@@ -2581,7 +2581,7 @@ comment at the start of cc-engine.el for more info."
;; We've searched over a piece of non-white syntactic ws. See if this
;; can be cached.
(setq next-rung-pos (point))
- (skip-chars-backward " \t\f\v")
+ (c-skip-ws-chars-backward " \t\f\v")
(if (or
;; Cache if we started either from a marked rung or from a
@@ -2591,7 +2591,7 @@ comment at the start of cc-engine.el for more info."
;; Cache if there's a marked rung in the encountered simple ws.
(save-excursion
- (skip-chars-backward " \t\n\r\f\v")
+ (c-skip-ws-chars-backward " \t\n\r\f\v")
(text-property-any (point) (min (1+ next-rung-pos) (point-max))
'c-is-sws t)))
@@ -7202,10 +7202,8 @@ comment at the start of cc-engine.el for more info."
(progn
(c-clear-char-property (1- beg-literal-end)
'syntax-table)
- (c-put-char-property (1- end-literal-end)
- 'syntax-table '(15)))
- (c-put-char-property (1- beg-literal-end)
- 'syntax-table '(15))
+ (c-put-string-fence (1- end-literal-end)))
+ (c-put-string-fence (1- beg-literal-end))
(c-clear-char-property (1- end-literal-end)
'syntax-table)))
@@ -7284,10 +7282,8 @@ comment at the start of cc-engine.el for more info."
(progn
(c-clear-char-property (1- beg-literal-end)
'syntax-table)
- (c-put-char-property (1- end-literal-end)
- 'syntax-table '(15)))
- (c-put-char-property (1- beg-literal-end)
- 'syntax-table '(15))
+ (c-put-string-fence (1- end-literal-end)))
+ (c-put-string-fence (1- beg-literal-end))
(c-clear-char-property (1- end-literal-end)
'syntax-table)))))
;; Extend the fontification region, if needed.
@@ -7946,7 +7942,7 @@ multi-line strings (but not C++, for example)."
(insert (nth 3 (car state))))
((eq (nth 3 (car state)) t)
(insert ?\")
- (c-put-char-property end 'syntax-table '(15))))
+ (c-put-string-fence end)))
(c-truncate-lit-pos-cache end)
;; ....ensure c-new-END extends right to the end of the about
;; to be un-stringed raw string....
@@ -8191,7 +8187,7 @@ multi-line strings (but not C++, for example)."
(goto-char (cadr end-delim))
t)
(c-put-char-property (cddr delim) 'syntax-table '(1))
- (c-put-char-property (1- (cadr delim)) 'syntax-table '(15))
+ (c-put-string-fence (1- (cadr delim)))
(c-truncate-lit-pos-cache (1- (cddr delim)))
(when bound
;; In a CPP construct, we try to apply a generic-string
@@ -8221,10 +8217,10 @@ multi-line strings (but not C++, for example)."
(cadr delim) t))
(if (match-beginning 10)
(progn
- (c-put-char-property (match-beginning 10) 'syntax-table '(15))
+ (c-put-string-fence (match-beginning 10))
(c-truncate-lit-pos-cache (match-beginning 10)))
(c-put-char-property (match-beginning 5) 'syntax-table '(1))
- (c-put-char-property (1+ (match-beginning 5)) 'syntax-table '(15))
+ (c-put-string-fence (1+ (match-beginning 5)))
(c-truncate-lit-pos-cache (match-beginning 5))))
(goto-char bound))
nil))
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 1dbe91b5633..8dea599ed98 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -1279,7 +1279,9 @@ Note that the style variables are always made local to
the buffer."
;; VALUE (which should not be nil).
;; `(let ((-pos- ,pos)
;; (-value- ,value))
- (c-put-char-property pos 'syntax-table value)
+ (if (equal value '(15))
+ (c-put-string-fence pos)
+ (c-put-char-property pos 'syntax-table value))
(c-put-char-property pos 'c-fl-syn-tab value)
(cond
((null c-min-syn-tab-mkr)
diff --git a/lisp/progmodes/elixir-ts-mode.el b/lisp/progmodes/elixir-ts-mode.el
index 7175fe4bff8..2ddce3de105 100644
--- a/lisp/progmodes/elixir-ts-mode.el
+++ b/lisp/progmodes/elixir-ts-mode.el
@@ -53,6 +53,7 @@
(declare-function treesit-parser-language "treesit.c")
(declare-function treesit-parser-included-ranges "treesit.c")
(declare-function treesit-parser-list "treesit.c")
+(declare-function treesit-node-p "treesit.c")
(declare-function treesit-node-parent "treesit.c")
(declare-function treesit-node-start "treesit.c")
(declare-function treesit-node-end "treesit.c")
@@ -312,7 +313,16 @@
((parent-is "^catch_block$") parent ,offset)
((parent-is "^keywords$") parent-bol 0)
((node-is "^call$") parent-bol ,offset)
- ((node-is "^comment$") parent-bol ,offset)))))
+ ((node-is "^comment$") parent-bol ,offset)
+ ((node-is "\"\"\"") parent-bol 0)
+ ;; Handle quoted_content indentation on the last
+ ;; line before the closing \"\"\", where it might
+ ;; see it as no-node outside a HEEx tag.
+ (no-node (lambda (_n _p _bol)
+ (treesit-node-start
+ (treesit-node-parent
+ (treesit-node-at (point) 'elixir))))
+ 0)))))
(defvar elixir-ts--font-lock-settings
(treesit-font-lock-rules
@@ -510,21 +520,15 @@ With ARG, do it many times. Negative ARG means move
backward."
(defun elixir-ts--treesit-language-at-point (point)
"Return the language at POINT."
- (let* ((range nil)
- (language-in-range
- (cl-loop
- for parser in (treesit-parser-list)
- do (setq range
- (cl-loop
- for range in (treesit-parser-included-ranges parser)
- if (and (>= point (car range)) (<= point (cdr range)))
- return parser))
- if range
- return (treesit-parser-language parser))))
- (if (null language-in-range)
- (when-let ((parser (car (treesit-parser-list))))
- (treesit-parser-language parser))
- language-in-range)))
+ (let ((node (treesit-node-at point 'elixir)))
+ (if (and (equal (treesit-node-type node) "quoted_content")
+ (let ((prev-sibling (treesit-node-prev-sibling node t)))
+ (and (treesit-node-p prev-sibling)
+ (string-match-p
+ (rx bos (or "H" "F") eos)
+ (treesit-node-text prev-sibling)))))
+ 'heex
+ 'elixir)))
(defun elixir-ts--defun-p (node)
"Return non-nil when NODE is a defun."
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index 54c758c6a8a..d9eccacc48b 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -309,7 +309,7 @@ beginning with a \";\". Expressions for comments at the
beginning of
the line should begin with \"^\"."
:group 'idlwave-code-formatting
:type '(choice (const :tag "Any line beginning with `;'" nil)
- 'regexp))
+ regexp))
(defcustom idlwave-code-comment ";;[^;]"
"A comment that starts with this regular expression on a line by
diff --git a/lisp/progmodes/java-ts-mode.el b/lisp/progmodes/java-ts-mode.el
index f2faa1a7e77..6ca7a473411 100644
--- a/lisp/progmodes/java-ts-mode.el
+++ b/lisp/progmodes/java-ts-mode.el
@@ -305,6 +305,13 @@ Return nil if there is no name or if NODE is not a defun
node."
(treesit-node-child-by-field-name node "name")
t))))
+
+(defvar java-ts-mode--feature-list
+ '(( comment definition )
+ ( constant keyword string type)
+ ( annotation expression literal)
+ ( bracket delimiter operator)))
+
;;;###autoload
(define-derived-mode java-ts-mode prog-mode "Java"
"Major mode for editing Java, powered by tree-sitter."
@@ -384,11 +391,7 @@ Return nil if there is no name or if NODE is not a defun
node."
;; Font-lock.
(setq-local treesit-font-lock-settings java-ts-mode--font-lock-settings)
- (setq-local treesit-font-lock-feature-list
- '(( comment definition )
- ( constant keyword string type)
- ( annotation expression literal)
- ( bracket delimiter operator)))
+ (setq-local treesit-font-lock-feature-list java-ts-mode--feature-list)
;; Imenu.
(setq-local treesit-simple-imenu-settings
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 071953d3d2f..030a3585158 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -121,7 +121,9 @@
:feature 'constant
'((variable_list
attribute: (attribute (["<" ">"] (identifier))))
- @font-lock-constant-face)
+ @font-lock-constant-face
+ (goto_statement (identifier) @font-lock-constant-face)
+ (label_statement) @font-lock-constant-face)
:language 'lua
:feature 'operator
@@ -131,12 +133,6 @@
@font-lock-operator-face
(vararg_expression) @font-lock-operator-face)
- :language 'lua
- :feature 'property
- '((field name: (identifier) @font-lock-property-name-face)
- (dot_index_expression
- field: (identifier) @font-lock-property-use-face))
-
:language 'lua
:feature 'builtin
`(((identifier) @font-lock-builtin-face
@@ -150,8 +146,7 @@
name: (method_index_expression
method: (identifier) @font-lock-function-call-face))
(function_call
- name: (dot_index_expression
- table: (identifier) @font-lock-function-call-face)))
+ name: (dot_index_expression (identifier) @font-lock-function-call-face)))
:language 'lua
:feature 'punctuation
@@ -164,12 +159,7 @@
@font-lock-variable-use-face)
(function_call
name: (method_index_expression
- table: (identifier) @font-lock-variable-use-face))
- (goto_statement (identifier) @font-lock-variable-use-face))
-
- :language 'lua
- :feature 'assignment
- '((variable_list (identifier) @font-lock-variable-name-face))
+ table: (identifier) @font-lock-variable-use-face)))
:language 'lua
:feature 'number
@@ -199,9 +189,43 @@
:feature 'definition
'((function_declaration
name: (identifier) @font-lock-function-name-face)
+ (assignment_statement
+ (variable_list name: [(identifier)]) @font-lock-function-name-face
+ (expression_list value: (function_definition)))
+ (table_constructor
+ (field
+ name: (identifier) @font-lock-function-name-face
+ value: (function_definition)))
+ (function_declaration
+ name: (dot_index_expression (identifier) @font-lock-function-name-face))
+ (function_declaration
+ name: (method_index_expression (identifier)
@font-lock-function-name-face))
+ (function_declaration
+ (method_index_expression
+ (dot_index_expression
+ table: (identifier) @font-lock-function-name-face
+ field: (identifier) @font-lock-property-name-face
+ )))
(parameters
name: (identifier) @font-lock-variable-name-face)
- (label_statement) @font-lock-variable-name-face)
+ (for_numeric_clause name: (identifier) @font-lock-variable-name-face))
+
+ :language 'lua
+ :feature 'property
+ '((field name: (identifier) @font-lock-property-name-face)
+ (dot_index_expression
+ field: (identifier) @font-lock-property-use-face))
+
+ :language 'lua
+ :feature 'assignment
+ '((variable_list
+ [(identifier)
+ (bracket_index_expression)]
+ @font-lock-variable-name-face)
+ (variable_list
+ (dot_index_expression
+ table: (identifier))
+ @font-lock-variable-name-face))
:language 'lua
:feature 'error
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 040ef187e97..b8d811baf0d 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -223,7 +223,10 @@
"\\|=>"
"\\|[?:.,;|&*=!~({[]"
"\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
- "\\|\\(^\\)\\)[ \t\n]*")))
+ "\\|\\(^\\)\\)[ \t\n]*"))
+
+ (defconst perl--format-regexp "^[ \t]*format.*=[ \t]*\\(\n\\)"
+ "Regexp to match the start of a format declaration."))
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
@@ -252,7 +255,7 @@
;; Handle funny names like $DB'stop.
("\\$ ?{?\\^?[_[:alpha:]][_[:alnum:]]*\\('\\)[_[:alpha:]]" (1 "_"))
;; format statements
- ("^[ \t]*format.*=[ \t]*\\(\n\\)"
+ (perl--format-regexp
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
;; Propertize perl prototype chars `$%&*;+@\[]' as punctuation
;; in `sub' arg-specs like `sub myfun ($)' and `sub ($)'. But
@@ -946,6 +949,17 @@ changed by, or (parse-state) if line starts in a quoted
string."
(goto-char (- (point-max) pos)))
shift-amt))
+(defun perl--end-of-format-p ()
+ "Non-nil if point is at the end of a format declaration, skipping
whitespace."
+ (save-excursion
+ (skip-chars-backward " \t\n")
+ (beginning-of-line)
+ (when-let ((comm (and (looking-at "^\\.$")
+ (nth 8 (syntax-ppss)))))
+ (goto-char comm)
+ (beginning-of-line)
+ (looking-at perl--format-regexp))))
+
(defun perl-continuation-line-p ()
"Move to end of previous line and return non-nil if continued."
;; Statement level. Is it a continuation or a new statement?
@@ -959,7 +973,8 @@ changed by, or (parse-state) if line starts in a quoted
string."
(beginning-of-line)
(perl-backward-to-noncomment))
;; Now we get the answer.
- (unless (memq (preceding-char) '(?\; ?\} ?\{))
+ (unless (or (memq (preceding-char) '(?\; ?\} ?\{))
+ (perl--end-of-format-p))
(preceding-char)))
(defun perl-hanging-paren-p ()
@@ -999,7 +1014,9 @@ Returns (parse-state) if line starts inside a string."
(state (syntax-ppss))
(containing-sexp (nth 1 state))
;; Don't auto-indent in a quoted string or a here-document.
- (unindentable (or (nth 3 state) (eq 2 (nth 7 state)))))
+ (unindentable (or (nth 3 state) (eq 2 (nth 7 state))))
+ (format (and (nth 3 state)
+ (char-equal (nth 3 state) ?\n))))
(when (and (eq t (nth 3 state))
(save-excursion
(goto-char (nth 8 state))
@@ -1009,7 +1026,7 @@ Returns (parse-state) if line starts inside a string."
(setq unindentable nil)
(setq containing-sexp (nth 8 state)))
(cond
- (unindentable 'noindent)
+ (unindentable (if format 0 'noindent))
((null containing-sexp) ; Line is at top level.
(skip-chars-forward " \t\f")
(if (memq (following-char)
@@ -1018,7 +1035,8 @@ Returns (parse-state) if line starts inside a string."
;; indent a little if this is a continuation line
(perl-backward-to-noncomment)
(if (or (bobp)
- (memq (preceding-char) '(?\; ?\})))
+ (memq (preceding-char) '(?\; ?\}))
+ (perl--end-of-format-p))
0 perl-continued-statement-offset)))
((/= (char-after containing-sexp) ?{)
;; line is expression, not statement:
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 1147db816bb..01a075d6512 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -97,11 +97,9 @@ When the figure is finished these values should be replaced."
(const :tag "archC" (1296 1728))
(const :tag "archB" (864 1296))
(const :tag "archA" (648 864))
- (const :tag "flsa" (612 936))
- (const :tag "flse" (612 936))
+ (const :tag "flsa, flse" (612 936))
(const :tag "halfletter" (396 612))
- (const :tag "11x17" (792 1224))
- (const :tag "tabloid" (792 1224))
+ (const :tag "11x17, tabloid" (792 1224))
(const :tag "ledger" (1224 792))
(const :tag "csheet" (1224 1584))
(const :tag "dsheet" (1584 2448))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 4b940b3f13b..d3cb5a77e22 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -10,6 +10,9 @@
;; Created: Jul 2010
;; Keywords: languages
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/svg.el b/lisp/svg.el
index 15004357811..dc8b4feb51f 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -8,6 +8,9 @@
;; Version: 1.1
;; Package-Requires: ((emacs "25"))
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index d3b9720d729..4637dafcd90 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -362,48 +362,6 @@ or by `tab-line-tabs-buffer-groups'."
"Function to return a global list of buffers.
Used only for `tab-line-tabs-mode-buffers' and `tab-line-tabs-buffer-groups'.")
-
-
-;;; Touch screen support.
-
-(defun tab-line-track-tap (event &optional function)
- "Track a tap starting from EVENT.
-If EVENT is not a `touchscreen-begin' event, return t.
-Otherwise, return t if the tap completes successfully, and nil if
-the tap should be ignored.
-
-If FUNCTION is specified and the tap does not complete within
-`touch-screen-delay' seconds, display the appropriate context
-menu by calling FUNCTION with EVENT, and return nil."
- (if (not (eq (car-safe event) 'touchscreen-begin))
- t
- (let ((result (catch 'context-menu
- (let (timer)
- (unwind-protect
- (progn
- (when function
- (setq timer
- (run-at-time touch-screen-delay t
- #'throw 'context-menu
- 'context-menu)))
- (touch-screen-track-tap event))
- (when timer
- (cancel-timer timer)))))))
- (cond ((eq result 'context-menu)
- (prog1 nil
- (funcall function event)))
- (result t)))))
-
-(defun tab-line-event-start (event)
- "Like `event-start'.
-However, return the correct mouse position list if EVENT is a
-`touchscreen-begin' event."
- (or (and (eq (car-safe event) 'touchscreen-begin)
- (cdadr event))
- (event-start event)))
-
-
-
(defun tab-line-tabs-buffer-list ()
(seq-filter (lambda (b) (and (buffer-live-p b)
(/= (aref (buffer-name b) 0) ?\s)))
@@ -998,6 +956,45 @@ sight of the tab line."
(popup-menu menu event)))
+;;; Touch screen support.
+
+(defun tab-line-track-tap (event &optional function)
+ "Track a tap starting from EVENT.
+If EVENT is not a `touchscreen-begin' event, return t.
+Otherwise, return t if the tap completes successfully, and nil if
+the tap should be ignored.
+
+If FUNCTION is specified and the tap does not complete within
+`touch-screen-delay' seconds, display the appropriate context
+menu by calling FUNCTION with EVENT, and return nil."
+ (if (not (eq (car-safe event) 'touchscreen-begin))
+ t
+ (let ((result (catch 'context-menu
+ (let (timer)
+ (unwind-protect
+ (progn
+ (when function
+ (setq timer
+ (run-at-time touch-screen-delay t
+ #'throw 'context-menu
+ 'context-menu)))
+ (touch-screen-track-tap event))
+ (when timer
+ (cancel-timer timer)))))))
+ (cond ((eq result 'context-menu)
+ (prog1 nil
+ (funcall function event)))
+ (result t)))))
+
+(defun tab-line-event-start (event)
+ "Like `event-start'.
+However, return the correct mouse position list if EVENT is a
+`touchscreen-begin' event."
+ (or (and (eq (car-safe event) 'touchscreen-begin)
+ (cdadr event))
+ (event-start event)))
+
+
;;;###autoload
(define-minor-mode tab-line-mode
"Toggle display of tab line in the windows displaying the current buffer."
diff --git a/lisp/textmodes/glyphless-mode.el b/lisp/textmodes/glyphless-mode.el
index 99bbb2769e4..eb4447f3048 100644
--- a/lisp/textmodes/glyphless-mode.el
+++ b/lisp/textmodes/glyphless-mode.el
@@ -30,7 +30,6 @@ The value can be any of the groups supported by
`all', for all glyphless characters."
:version "29.1"
:type '(repeat (choice (const :tag "All" all)
- (const :tag "No font" no-font)
(const :tag "C0 Control" c0-control)
(const :tag "C1 Control" c1-control)
(const :tag "Format Control" format-control)
diff --git a/lisp/tmm.el b/lisp/tmm.el
index a4058594622..b587b416a35 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -79,7 +79,8 @@ See the documentation for `tmm-prompt'."
"String to insert between shortcut and menu item.
If nil, there will be no shortcuts. It should not consist only of spaces,
or else the correct item might not be found in the `*Completions*' buffer."
- :type 'string)
+ :type '(choice (const :tag "No shortcuts" nil)
+ string))
(defvar tmm-mb-map nil
"A place to store minibuffer map.")
diff --git a/lisp/treesit.el b/lisp/treesit.el
index df9134ab48e..402417c6ca9 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -140,7 +140,10 @@ The function is called with one argument, the position of
point.
In general, this function should call `treesit-node-at' with an
explicit language (usually the host language), and determine the
-language at point using the type of the returned node.")
+language at point using the type of the returned node.
+
+DO NOT derive the language at point from parser ranges. It's
+cumbersome and can't deal with some edge cases.")
(defun treesit-language-at (position)
"Return the language at POSITION.
@@ -1689,8 +1692,8 @@ Return (ANCHOR . OFFSET). This function is used by
bol (car local-parsers)))
((eq 1 (length (treesit-parser-list nil nil t)))
(treesit-node-at bol))
- ((treesit-language-at (point))
- (treesit-node-at bol (treesit-language-at (point))))
+ ((treesit-language-at bol)
+ (treesit-node-at bol (treesit-language-at bol)))
(t (treesit-node-at bol))))
(root (treesit-parser-root-node
(treesit-node-parser smallest-node)))
@@ -1877,10 +1880,10 @@ Helper function to use in the `interactive' spec of
`treesit-check-indent'."
(format-prompt "Target major mode" default)
obarray
(lambda (sym)
- (and (string-match-p "-mode\\'" (symbol-name sym))
+ (and (string-suffix-p "-mode" (symbol-name sym))
(not (or (memq sym minor-mode-list)
- (string-match-p "-minor-mode\\'"
- (symbol-name sym))))))
+ (string-suffix-p "-minor-mode"
+ (symbol-name sym))))))
nil nil nil default nil)))
(cond
((equal mode "nil") nil)
@@ -2730,7 +2733,6 @@ before calling this function."
'( nil nil nil nil
(font-lock-fontify-syntactically-function
. treesit-font-lock-fontify-region)))
- (font-lock-mode 1)
(treesit-font-lock-recompute-features)
(dolist (parser (treesit-parser-list))
(treesit-parser-add-notifier
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 2ad2fb0eeac..7119ae7eac3 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -187,9 +187,9 @@ name will then be used to uniquify the buffer's name.
To include components from the `project-name' of the buffer, set
this variable to `project-uniquify-dirname-transform'."
- :type '(choice (function-item :tag "Use directory name as-is" identity)
+ :type `(choice (function-item :tag "Use directory name as-is" identity)
(function-item :tag "Include project name in directory name"
- #'project-uniquify-dirname-transform)
+ ,#'project-uniquify-dirname-transform)
function)
:version "30.1"
:group 'uniquify)
diff --git a/lisp/use-package/use-package.el b/lisp/use-package/use-package.el
index 1b63a6d651a..f5e6a551bb3 100644
--- a/lisp/use-package/use-package.el
+++ b/lisp/use-package/use-package.el
@@ -10,6 +10,9 @@
;; Keywords: dotemacs startup speed config package extensions
;; URL: https://github.com/jwiegley/use-package
+;; 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.
;; GNU Emacs is free software: you can redistribute it and/or modify
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index d776375d681..24a925eda73 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -216,6 +216,7 @@ The default \"-b\" means to ignore whitespace-only changes,
"C-x 4 A" #'diff-add-change-log-entries-other-window
;; Misc operations.
"C-c C-a" #'diff-apply-hunk
+ "C-c C-m a" #'diff-apply-buffer
"C-c C-e" #'diff-ediff-patch
"C-c C-n" #'diff-restrict-view
"C-c C-s" #'diff-split-hunk
@@ -2054,6 +2055,40 @@ With a prefix argument, try to REVERSE the hunk."
(diff-hunk-kill)
(diff-hunk-next)))))
+(defun diff-apply-buffer ()
+ "Apply the diff in the entire diff buffer.
+When applying all hunks was successful, then save the changed buffers."
+ (interactive)
+ (let ((buffer-edits nil)
+ (failures 0)
+ (diff-refine nil))
+ (save-excursion
+ (goto-char (point-min))
+ (diff-beginning-of-hunk t)
+ (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched)
+ (diff-find-source-location nil nil)))
+ (cond ((and line-offset (not switched))
+ (push (cons pos dst)
+ (alist-get buf buffer-edits)))
+ (t (setq failures (1+ failures))))
+ (and (not (eq (prog1 (point) (ignore-errors (diff-hunk-next)))
+ (point)))
+ (looking-at-p diff-hunk-header-re)))))
+ (cond ((zerop failures)
+ (dolist (buf-edits (reverse buffer-edits))
+ (with-current-buffer (car buf-edits)
+ (dolist (edit (cdr buf-edits))
+ (let ((pos (car edit))
+ (dst (cdr edit))
+ (inhibit-read-only t))
+ (goto-char (car pos))
+ (delete-region (car pos) (cdr pos))
+ (insert (car dst))))
+ (save-buffer)))
+ (message "Saved %d buffers" (length buffer-edits)))
+ (t
+ (message "%d hunks failed; no buffers changed" failures)))))
+
(defalias 'diff-mouse-goto-source #'diff-goto-source)
(defun diff-goto-source (&optional other-file event)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 00200f1d1da..be698370b97 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1269,36 +1269,28 @@ which see."
(or (display-graphic-p)
(user-error "Emacs is not running as a window application"))
- (cond ((eq ediff-window-setup-function #'ediff-setup-windows-multiframe)
- (setq ediff-multiframe nil)
- (setq window-setup-func #'ediff-setup-windows-plain)
- (message "ediff is now in `plain' mode"))
- ((eq ediff-window-setup-function #'ediff-setup-windows-plain)
- (if (and (ediff-buffer-live-p ediff-control-buffer)
- (window-live-p ediff-control-window))
- (set-window-dedicated-p ediff-control-window nil))
- (setq ediff-multiframe t)
- (setq window-setup-func #'ediff-setup-windows-multiframe)
- (message "ediff is now in `multiframe' mode"))
- (t
- (if (and (ediff-buffer-live-p ediff-control-buffer)
- (window-live-p ediff-control-window))
- (set-window-dedicated-p ediff-control-window nil))
- (setq ediff-multiframe t)
- (setq window-setup-func #'ediff-setup-windows-multiframe))
- (message "ediff is now in `multiframe' mode"))
-
- ;; change default
- (setq-default ediff-window-setup-function window-setup-func)
- ;; change in all active ediff sessions
- (mapc (lambda(buf) (ediff-with-current-buffer buf
- (setq ediff-window-setup-function window-setup-func
- ediff-window-B nil)))
- ediff-session-registry)
- (if (ediff-in-control-buffer-p)
- (progn
- (set-window-dedicated-p (selected-window) nil)
- (ediff-recenter 'no-rehighlight)))))
+ (cond ((eq ediff-window-setup-function #'ediff-setup-windows-multiframe)
+ (setq ediff-multiframe nil)
+ (setq window-setup-func #'ediff-setup-windows-plain)
+ (message "ediff is now in `plain' mode"))
+ (t ; (eq ediff-window-setup-function #'ediff-setup-windows-plain)
+ (if (and (ediff-buffer-live-p ediff-control-buffer)
+ (window-live-p ediff-control-window))
+ (set-window-dedicated-p ediff-control-window nil))
+ (setq ediff-multiframe t)
+ (setq window-setup-func #'ediff-setup-windows-multiframe)
+ (message "ediff is now in `multiframe' mode")))
+
+ ;; change default
+ (setq-default ediff-window-setup-function window-setup-func)
+ ;; change in all active ediff sessions
+ (mapc (lambda (buf) (ediff-with-current-buffer buf
+ (setq ediff-window-setup-function window-setup-func
+ ediff-window-B nil)))
+ ediff-session-registry)
+ (when (ediff-in-control-buffer-p)
+ (set-window-dedicated-p (selected-window) nil)
+ (ediff-recenter 'no-rehighlight))))
;;;###autoload
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index d83660f9d79..de6c3adbbdb 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -718,23 +718,24 @@ The annotations are relative to the current time, unless
overridden by OFFSET."
(let* ((color (or (vc-annotate-compcar difference
vc-annotate-color-map)
(cons nil vc-annotate-very-old-color)))
;; substring from index 1 to remove any leading `#' in the name
- (face-name (concat "vc-annotate-face-"
- (if (string-equal
- (substring (cdr color) 0 1) "#")
- (substring (cdr color) 1)
- (cdr color))))
+ (face (intern (concat "vc-annotate-face-"
+ (if (string-equal
+ (substring (cdr color) 0 1) "#")
+ (substring (cdr color) 1)
+ (cdr color)))))
;; Make the face if not done.
- (face (or (intern-soft face-name)
- (let ((tmp-face (make-face (intern face-name))))
- (set-face-extend tmp-face t)
- (cond
- (vc-annotate-background-mode
- (set-face-background tmp-face (cdr color)))
- (t
- (set-face-foreground tmp-face (cdr color))
- (when vc-annotate-background
- (set-face-background tmp-face
vc-annotate-background))))
- tmp-face)))) ; Return the face
+ (face (if (facep face)
+ face
+ (make-face face)
+ (set-face-extend face t)
+ (cond
+ (vc-annotate-background-mode
+ (set-face-background face (cdr color)))
+ (t
+ (set-face-foreground face (cdr color))
+ (when vc-annotate-background
+ (set-face-background face vc-annotate-background))))
+ face)))
(put-text-property start end 'face face)))))
;; Pretend to font-lock there were no matches.
nil)
diff --git a/make-dist b/make-dist
index a3b7219af3a..2c4b6a79500 100755
--- a/make-dist
+++ b/make-dist
@@ -356,8 +356,9 @@ possibly_non_vc_files="
$top_level_ChangeLog
MANIFEST aclocal.m4 configure
admin/charsets/jisx2131-filter
- src/config.in exec/configure
- exec/config.h.in
+ src/config.in
+ exec/configure exec/config.h.in
+ leim/small-ja-dic-option
"$(
find admin doc etc lisp \
\( -name '*.el' -o -name '*.elc' -o -name '*.map' -o -name '*.stamp' \
diff --git a/src/android.c b/src/android.c
index 4df9d71b1b1..aa4033c676f 100644
--- a/src/android.c
+++ b/src/android.c
@@ -1552,7 +1552,7 @@ android_init_emacs_service (void)
"(Lorg/gnu/emacs/EmacsWindow;)V");
FIND_METHOD (clear_area, "clearArea",
"(Lorg/gnu/emacs/EmacsWindow;IIII)V");
- FIND_METHOD (ring_bell, "ringBell", "()V");
+ FIND_METHOD (ring_bell, "ringBell", "(I)V");
FIND_METHOD (query_tree, "queryTree",
"(Lorg/gnu/emacs/EmacsWindow;)[S");
FIND_METHOD (get_screen_width, "getScreenWidth", "(Z)I");
@@ -4900,10 +4900,17 @@ android_put_image (android_pixmap handle, struct
android_image *image)
void
android_bell (void)
{
+ jint duration;
+
+ /* Restrict android_keyboard_bell_duration to values between 10 and
+ 1000. */
+ duration = MIN (1000, MAX (0, android_keyboard_bell_duration));
+
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
emacs_service,
service_class.class,
- service_class.ring_bell);
+ service_class.ring_bell,
+ duration);
android_exception_check ();
}
diff --git a/src/androidfns.c b/src/androidfns.c
index f151be5b9a6..3ee9f7634aa 100644
--- a/src/androidfns.c
+++ b/src/androidfns.c
@@ -3232,6 +3232,14 @@ restrictions.
This option has no effect on Android 9 and earlier. */);
android_use_exec_loader = true;
+ DEFVAR_INT ("android-keyboard-bell-duration",
+ android_keyboard_bell_duration,
+ doc: /* Number of milliseconds to vibrate after ringing the keyboard bell.
+The keyboard bell under Android systems takes the form of a vibrating
+element that is activated for a given number of milliseconds upon the
+bell being rung. */);
+ android_keyboard_bell_duration = 50;
+
/* Functions defined. */
defsubr (&Sx_create_frame);
defsubr (&Sxw_color_defined_p);
diff --git a/src/androidmenu.c b/src/androidmenu.c
index 3b34f032c35..ed26bdafa85 100644
--- a/src/androidmenu.c
+++ b/src/androidmenu.c
@@ -248,7 +248,6 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
jobject title_string, help_string, temp;
size_t i;
Lisp_Object pane_name, prefix;
- const char *pane_string;
specpdl_ref count, count1;
Lisp_Object item_name, enable, def, tem, entry, type, selected;
Lisp_Object help;
@@ -357,13 +356,21 @@ android_menu_show (struct frame *f, int x, int y, int
menuflags,
/* Now figure out the title of this pane. */
pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME);
prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX);
- pane_string = (NILP (pane_name)
- ? "" : SSDATA (pane_name));
- if ((menuflags & MENU_KEYMAPS) && !NILP (prefix))
- pane_string++;
+
+ /* PANE_NAME may be nil, in which case it must be set to an
+ empty string. */
+
+ if (NILP (pane_name))
+ pane_name = empty_unibyte_string;
+
+ /* Remove the leading prefix character if need be. */
+
+ if ((menuflags & MENU_KEYMAPS) && !NILP (prefix)
+ && SCHARS (prefix))
+ pane_name = Fsubstring (pane_name, make_fixnum (1), Qnil);
/* Add the pane. */
- temp = (*env)->NewStringUTF (env, pane_string);
+ temp = android_build_string (pane_name);
android_exception_check ();
(*env)->CallNonvirtualVoidMethod (env, current_context_menu,
diff --git a/src/itree.c b/src/itree.c
index ecf7d67422a..259cc99d3af 100644
--- a/src/itree.c
+++ b/src/itree.c
@@ -278,7 +278,7 @@ check_subtree (struct itree_node *node,
This runs in constant time when ENABLE_OVERLAY_CHECKING is 0
(i.e. Emacs is not configured with
- "--enable_checking=yes,overlays"). In this mode it can't check all
+ "--enable-checking=yes,overlays"). In this mode it can't check all
the invariants. When ENABLE_OVERLAY_CHECKING is 1 it checks the
entire tree and validates all invariants.
*/
diff --git a/src/keyboard.c b/src/keyboard.c
index 6ab1cdebc12..f756f163e87 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -4989,6 +4989,10 @@ static const char *const lispy_accent_keys[] =
#ifdef HAVE_ANDROID
#define FUNCTION_KEY_OFFSET 0
+/* Mind that Android designates 23 KEYCODE_DPAD_CENTER, but it is
+ merely abstruse terminology for the ``select'' key frequently
+ located in certain physical keyboards. */
+
const char *const lispy_function_keys[] =
{
/* All elements in this array default to 0, except for the few
@@ -5025,6 +5029,7 @@ const char *const lispy_function_keys[] =
[218] = "kana",
[21] = "left",
[22] = "right",
+ [23] = "select",
[24] = "volume-up",
[259] = "help",
[25] = "volume-down",
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index cf7b704ee95..ffb8891d3a6 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -268,7 +268,9 @@ typedef enum
on_failure_jump,
/* Like on_failure_jump, but pushes a placeholder instead of the
- current string position when executed. */
+ current string position when executed. Upon failure,
+ the current string position is thus not restored.
+ Used only for single-char loops that don't require backtracking. */
on_failure_keep_string_jump,
/* Just like 'on_failure_jump', except that it checks that we
@@ -338,11 +340,12 @@ typedef enum
/* Store NUMBER in two contiguous bytes starting at DESTINATION. */
-#define STORE_NUMBER(destination, number) \
- do { \
- (destination)[0] = (number) & 0377;
\
- (destination)[1] = (number) >> 8; \
- } while (false)
+static void
+STORE_NUMBER (unsigned char *destination, int16_t number)
+{
+ (destination)[0] = (number) & 0377;
+ (destination)[1] = (number) >> 8;
+}
/* Same as STORE_NUMBER, except increment DESTINATION to
the byte after where the number is stored. Therefore, DESTINATION
@@ -367,6 +370,12 @@ extract_number (re_char *source)
return leading_byte * 256 + source[0];
}
+static re_char *
+extract_address (re_char *source)
+{
+ return source + 2 + extract_number (source);
+}
+
/* Same as EXTRACT_NUMBER, except increment SOURCE to after the number.
SOURCE must be an lvalue. */
@@ -434,38 +443,27 @@ extract_number_and_incr (re_char **source)
/* If REGEX_EMACS_DEBUG is defined, print many voluminous messages
(if the variable regex_emacs_debug is positive). */
-#ifdef REGEX_EMACS_DEBUG
+#if defined REGEX_EMACS_DEBUG || ENABLE_CHECKING
/* Use standard I/O for debugging. */
# include "sysstdio.h"
-static int regex_emacs_debug = -100000;
-
-# define DEBUG_STATEMENT(e) e
-# define DEBUG_PRINT(...) \
- if (regex_emacs_debug > 0) fprintf (stderr, __VA_ARGS__)
-# define DEBUG_COMPILES_ARGUMENTS
-# define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \
- if (regex_emacs_debug > 0) print_partial_compiled_pattern (s, e)
-# define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2)
\
- if (regex_emacs_debug > 0) print_double_string (w, s1, sz1, s2, sz2)
-
static void
-debug_putchar (int c)
+debug_putchar (FILE *dest, int c)
{
if (c >= 32 && c <= 126)
- putc (c, stderr);
+ putc (c, dest);
else
{
unsigned int uc = c;
- fprintf (stderr, "{%02x}", uc);
+ fprintf (dest, "{%02x}", uc);
}
}
/* Print the fastmap in human-readable form. */
static void
-print_fastmap (char *fastmap)
+print_fastmap (FILE *dest, char *fastmap)
{
bool was_a_range = false;
int i = 0;
@@ -475,7 +473,7 @@ print_fastmap (char *fastmap)
if (fastmap[i++])
{
was_a_range = false;
- debug_putchar (i - 1);
+ debug_putchar (dest, i - 1);
while (i < (1 << BYTEWIDTH) && fastmap[i])
{
was_a_range = true;
@@ -483,12 +481,12 @@ print_fastmap (char *fastmap)
}
if (was_a_range)
{
- debug_putchar ('-');
- debug_putchar (i - 1);
+ debug_putchar (dest, '-');
+ debug_putchar (dest, i - 1);
}
}
}
- putc ('\n', stderr);
+ putc ('\n', dest);
}
@@ -496,7 +494,7 @@ print_fastmap (char *fastmap)
the START pointer into it and ending just before the pointer END. */
static void
-print_partial_compiled_pattern (re_char *start, re_char *end)
+print_partial_compiled_pattern (FILE *dest, re_char *start, re_char *end)
{
int mcnt, mcnt2;
re_char *p = start;
@@ -504,50 +502,50 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
if (start == NULL)
{
- fputs ("(null)\n", stderr);
+ fputs ("(null)\n", dest);
return;
}
/* Loop over pattern commands. */
while (p < pend)
{
- fprintf (stderr, "%td:\t", p - start);
+ fprintf (dest, "%td:\t", p - start);
switch ((re_opcode_t) *p++)
{
case no_op:
- fputs ("/no_op", stderr);
+ fputs ("/no_op", dest);
break;
case succeed:
- fputs ("/succeed", stderr);
+ fputs ("/succeed", dest);
break;
case exactn:
mcnt = *p++;
- fprintf (stderr, "/exactn/%d", mcnt);
+ fprintf (dest, "/exactn/%d", mcnt);
do
{
- debug_putchar ('/');
- debug_putchar (*p++);
+ debug_putchar (dest, '/');
+ debug_putchar (dest, *p++);
}
while (--mcnt);
break;
case start_memory:
- fprintf (stderr, "/start_memory/%d", *p++);
+ fprintf (dest, "/start_memory/%d", *p++);
break;
case stop_memory:
- fprintf (stderr, "/stop_memory/%d", *p++);
+ fprintf (dest, "/stop_memory/%d", *p++);
break;
case duplicate:
- fprintf (stderr, "/duplicate/%d", *p++);
+ fprintf (dest, "/duplicate/%d", *p++);
break;
case anychar:
- fputs ("/anychar", stderr);
+ fputs ("/anychar", dest);
break;
case charset:
@@ -558,11 +556,11 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
int length = CHARSET_BITMAP_SIZE (p - 1);
bool has_range_table = CHARSET_RANGE_TABLE_EXISTS_P (p - 1);
- fprintf (stderr, "/charset [%s",
+ fprintf (dest, "/charset [%s",
(re_opcode_t) *(p - 1) == charset_not ? "^" : "");
if (p + (*p & 0x7f) >= pend)
- fputs (" !extends past end of pattern! ", stderr);
+ fputs (" !extends past end of pattern! ", dest);
for (c = 0; c < 256; c++)
if (c / 8 < length
@@ -571,33 +569,33 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
/* Are we starting a range? */
if (last + 1 == c && ! in_range)
{
- debug_putchar ('-');
+ debug_putchar (dest, '-');
in_range = true;
}
/* Have we broken a range? */
else if (last + 1 != c && in_range)
{
- debug_putchar (last);
+ debug_putchar (dest, last);
in_range = false;
}
if (! in_range)
- debug_putchar (c);
+ debug_putchar (dest, c);
last = c;
}
if (in_range)
- debug_putchar (last);
+ debug_putchar (dest, last);
- debug_putchar (']');
+ debug_putchar (dest, ']');
p += 1 + length;
if (has_range_table)
{
int count;
- fputs ("has-range-table", stderr);
+ fputs ("has-range-table", dest);
/* ??? Should print the range table; for now, just skip it. */
p += 2; /* skip range table bits */
@@ -608,160 +606,175 @@ print_partial_compiled_pattern (re_char *start, re_char
*end)
break;
case begline:
- fputs ("/begline", stderr);
+ fputs ("/begline", dest);
break;
case endline:
- fputs ("/endline", stderr);
+ fputs ("/endline", dest);
break;
case on_failure_jump:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/on_failure_jump to %td", p + mcnt - start);
+ fprintf (dest, "/on_failure_jump to %td", p + mcnt - start);
break;
case on_failure_keep_string_jump:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/on_failure_keep_string_jump to %td",
+ fprintf (dest, "/on_failure_keep_string_jump to %td",
p + mcnt - start);
break;
case on_failure_jump_nastyloop:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/on_failure_jump_nastyloop to %td",
+ fprintf (dest, "/on_failure_jump_nastyloop to %td",
p + mcnt - start);
break;
case on_failure_jump_loop:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/on_failure_jump_loop to %td",
+ fprintf (dest, "/on_failure_jump_loop to %td",
p + mcnt - start);
break;
case on_failure_jump_smart:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/on_failure_jump_smart to %td",
+ fprintf (dest, "/on_failure_jump_smart to %td",
p + mcnt - start);
break;
case jump:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
- fprintf (stderr, "/jump to %td", p + mcnt - start);
+ fprintf (dest, "/jump to %td", p + mcnt - start);
break;
case succeed_n:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
EXTRACT_NUMBER_AND_INCR (mcnt2, p);
- fprintf (stderr, "/succeed_n to %td, %d times",
+ fprintf (dest, "/succeed_n to %td, %d times",
p - 2 + mcnt - start, mcnt2);
break;
case jump_n:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
EXTRACT_NUMBER_AND_INCR (mcnt2, p);
- fprintf (stderr, "/jump_n to %td, %d times",
+ fprintf (dest, "/jump_n to %td, %d times",
p - 2 + mcnt - start, mcnt2);
break;
case set_number_at:
EXTRACT_NUMBER_AND_INCR (mcnt, p);
EXTRACT_NUMBER_AND_INCR (mcnt2, p);
- fprintf (stderr, "/set_number_at location %td to %d",
+ fprintf (dest, "/set_number_at location %td to %d",
p - 2 + mcnt - start, mcnt2);
break;
case wordbound:
- fputs ("/wordbound", stderr);
+ fputs ("/wordbound", dest);
break;
case notwordbound:
- fputs ("/notwordbound", stderr);
+ fputs ("/notwordbound", dest);
break;
case wordbeg:
- fputs ("/wordbeg", stderr);
+ fputs ("/wordbeg", dest);
break;
case wordend:
- fputs ("/wordend", stderr);
+ fputs ("/wordend", dest);
break;
case symbeg:
- fputs ("/symbeg", stderr);
+ fputs ("/symbeg", dest);
break;
case symend:
- fputs ("/symend", stderr);
+ fputs ("/symend", dest);
break;
case syntaxspec:
- fputs ("/syntaxspec", stderr);
+ fputs ("/syntaxspec", dest);
mcnt = *p++;
- fprintf (stderr, "/%d", mcnt);
+ fprintf (dest, "/%d", mcnt);
break;
case notsyntaxspec:
- fputs ("/notsyntaxspec", stderr);
+ fputs ("/notsyntaxspec", dest);
mcnt = *p++;
- fprintf (stderr, "/%d", mcnt);
+ fprintf (dest, "/%d", mcnt);
break;
case at_dot:
- fputs ("/at_dot", stderr);
+ fputs ("/at_dot", dest);
break;
case categoryspec:
- fputs ("/categoryspec", stderr);
+ fputs ("/categoryspec", dest);
mcnt = *p++;
- fprintf (stderr, "/%d", mcnt);
+ fprintf (dest, "/%d", mcnt);
break;
case notcategoryspec:
- fputs ("/notcategoryspec", stderr);
+ fputs ("/notcategoryspec", dest);
mcnt = *p++;
- fprintf (stderr, "/%d", mcnt);
+ fprintf (dest, "/%d", mcnt);
break;
case begbuf:
- fputs ("/begbuf", stderr);
+ fputs ("/begbuf", dest);
break;
case endbuf:
- fputs ("/endbuf", stderr);
+ fputs ("/endbuf", dest);
break;
default:
- fprintf (stderr, "?%d", *(p-1));
+ fprintf (dest, "?%d", *(p-1));
}
- putc ('\n', stderr);
+ putc ('\n', dest);
}
- fprintf (stderr, "%td:\tend of pattern.\n", p - start);
+ fprintf (dest, "%td:\tend of pattern.\n", p - start);
}
-
-static void
-print_compiled_pattern (struct re_pattern_buffer *bufp)
+void
+print_compiled_pattern (FILE *dest, struct re_pattern_buffer *bufp)
{
+ if (!dest)
+ dest = stderr;
re_char *buffer = bufp->buffer;
- print_partial_compiled_pattern (buffer, buffer + bufp->used);
- fprintf (stderr, "%td bytes used/%td bytes allocated.\n",
+ print_partial_compiled_pattern (dest, buffer, buffer + bufp->used);
+ fprintf (dest, "%td bytes used/%td bytes allocated.\n",
bufp->used, bufp->allocated);
if (bufp->fastmap_accurate && bufp->fastmap)
{
- fputs ("fastmap: ", stderr);
- print_fastmap (bufp->fastmap);
+ fputs ("fastmap: ", dest);
+ print_fastmap (dest, bufp->fastmap);
}
- fprintf (stderr, "re_nsub: %td\t", bufp->re_nsub);
- fprintf (stderr, "regs_alloc: %d\t", bufp->regs_allocated);
- fprintf (stderr, "can_be_null: %d\n", bufp->can_be_null);
+ fprintf (dest, "re_nsub: %td\t", bufp->re_nsub);
+ fprintf (dest, "regs_alloc: %d\t", bufp->regs_allocated);
+ fprintf (dest, "can_be_null: %d\n", bufp->can_be_null);
/* Perhaps we should print the translate table? */
}
+#endif
+
+#ifdef REGEX_EMACS_DEBUG
+
+static int regex_emacs_debug = -100000;
+
+# define DEBUG_STATEMENT(e) e
+# define DEBUG_PRINT(...) \
+ if (regex_emacs_debug > 0) fprintf (stderr, __VA_ARGS__)
+# define DEBUG_COMPILES_ARGUMENTS
+# define DEBUG_PRINT_COMPILED_PATTERN(p, s, e) \
+ if (regex_emacs_debug > 0) print_partial_compiled_pattern (stderr, s, e)
+# define DEBUG_PRINT_DOUBLE_STRING(w, s1, sz1, s2, sz2)
\
+ if (regex_emacs_debug > 0) print_double_string (w, s1, sz1, s2, sz2)
static void
print_double_string (re_char *where, re_char *string1, ptrdiff_t size1,
@@ -775,12 +788,12 @@ print_double_string (re_char *where, re_char *string1,
ptrdiff_t size1,
if (FIRST_STRING_P (where))
{
for (i = 0; i < string1 + size1 - where; i++)
- debug_putchar (where[i]);
+ debug_putchar (stderr, where[i]);
where = string2;
}
for (i = 0; i < string2 + size2 - where; i++)
- debug_putchar (where[i]);
+ debug_putchar (stderr, where[i]);
}
}
@@ -1166,8 +1179,8 @@ static void insert_op2 (re_opcode_t op, unsigned char
*loc,
static bool at_begline_loc_p (re_char *pattern, re_char *p);
static bool at_endline_loc_p (re_char *p, re_char *pend);
static re_char *skip_one_char (re_char *p);
-static int analyze_first (re_char *p, re_char *pend,
- char *fastmap, bool multibyte);
+static bool analyze_first (struct re_pattern_buffer *bufp,
+ re_char *p, re_char *pend, char *fastmap);
/* Fetch the next character in the uncompiled pattern, with no
translation. */
@@ -1760,7 +1773,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
if (regex_emacs_debug > 0)
{
for (ptrdiff_t debug_count = 0; debug_count < size; debug_count++)
- debug_putchar (pattern[debug_count]);
+ debug_putchar (stderr, pattern[debug_count]);
putc ('\n', stderr);
}
#endif
@@ -1917,7 +1930,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
ptrdiff_t startoffset = 0;
re_opcode_t ofj =
/* Check if the loop can match the empty string. */
- (simple || !analyze_first (laststart, b, NULL, false))
+ (simple || !analyze_first (bufp, laststart, b, NULL))
? on_failure_jump : on_failure_jump_loop;
eassert (skip_one_char (laststart) <= b);
@@ -1974,7 +1987,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
GET_BUFFER_SPACE (7); /* We might use less. */
if (many_times_ok)
{
- bool emptyp = !!analyze_first (laststart, b, NULL, false);
+ bool emptyp = analyze_first (bufp, laststart, b, NULL);
/* The non-greedy multiple match looks like
a repeat..until: we only need a conditional jump
@@ -2680,7 +2693,7 @@ regex_compile (re_char *pattern, ptrdiff_t size,
{
re_compile_fastmap (bufp);
DEBUG_PRINT ("\nCompiled pattern:\n");
- print_compiled_pattern (bufp);
+ print_compiled_pattern (stderr, bufp);
}
regex_emacs_debug--;
#endif
@@ -2809,311 +2822,469 @@ group_in_compile_stack (compile_stack_type
compile_stack, regnum_t regnum)
return false;
}
-/* analyze_first.
- If fastmap is non-NULL, go through the pattern and fill fastmap
- with all the possible leading chars. If fastmap is NULL, don't
- bother filling it up (obviously) and only return whether the
- pattern could potentially match the empty string.
-
- Return 1 if p..pend might match the empty string.
- Return 0 if p..pend matches at least one char.
- Return -1 if fastmap was not updated accurately. */
-
-static int
-analyze_first (re_char *p, re_char *pend, char *fastmap, bool multibyte)
+/* Iterate through all the char-matching operations directly reachable from P.
+ This is the inner loop of `forall_firstchar`, which see.
+ LOOP_BEG..LOOP_END delimit the currentl "block" of code (we assume
+ the code is made of syntactically nested loops).
+ LOOP_END is blindly assumed to be "safe".
+ To guarantee termination, at each iteration, either LOOP_BEG should
+ get bigger, or it should stay the same and P should get bigger. */
+static bool
+forall_firstchar_1 (re_char *p, re_char *pend,
+ re_char *loop_beg, re_char *loop_end,
+ bool f (const re_char *p, void *arg), void *arg)
{
- int j, k;
- int nbits;
- bool not;
+ eassert (p >= loop_beg);
+ eassert (p <= loop_end);
- /* If all elements for base leading-codes in fastmap is set, this
- flag is set true. */
- bool match_any_multibyte_characters = false;
-
- eassert (p);
-
- /* The loop below works as follows:
- - It has a working-list kept in the PATTERN_STACK and which basically
- starts by only containing a pointer to the first operation.
- - If the opcode we're looking at is a match against some set of
- chars, then we add those chars to the fastmap and go on to the
- next work element from the worklist (done via 'break').
- - If the opcode is a control operator on the other hand, we either
- ignore it (if it's meaningless at this point, such as 'start_memory')
- or execute it (if it's a jump). If the jump has several destinations
- (i.e. 'on_failure_jump'), then we push the other destination onto the
- worklist.
- We guarantee termination by ignoring backward jumps (more or less),
- so that P is monotonically increasing. More to the point, we
- never set P (or push) anything '<= p1'. */
-
- while (p < pend)
+ while (true)
{
- /* P1 is used as a marker of how far back a 'on_failure_jump'
- can go without being ignored. It is normally equal to P
- (which prevents any backward 'on_failure_jump') except right
- after a plain 'jump', to allow patterns such as:
- 0: jump 10
- 3..9: <body>
- 10: on_failure_jump 3
- as used for the *? operator. */
- re_char *p1 = p;
+ re_char *newp1, *newp2, *tmp;
+ re_char *p_orig = p;
+ int offset;
- switch (*p++)
- {
- case succeed:
- return 1;
+ if (p == pend)
+ return false;
+ else if (p == loop_end)
+ return true;
+ else if (p > loop_end)
+ {
+#if ENABLE_CHECKING
+ fprintf (stderr, "FORALL_FIRSTCHAR: Broken assumption1!!\n");
+#endif
+ return false; /* FIXME: Broken assumption about the code shape. */
+ }
+ else
+ switch (*p)
+ {
+ /* Cases which stop the iteration. */
+ case succeed:
+ case exactn:
+ case charset:
+ case charset_not:
+ case anychar:
+ case syntaxspec:
+ case notsyntaxspec:
+ case categoryspec:
+ case notcategoryspec:
+ return f (p, arg);
+
+ /* Cases which may match the empty string. */
+ case at_dot:
+ case begbuf:
+ case no_op:
+ case wordbound:
+ case notwordbound:
+ case begline:
+ p++;
+ continue;
+
+ /* Cases which may match the empty string and may
+ tell us something about the next char. */
+ case endline:
+ case endbuf:
+ case wordbeg:
+ case wordend:
+ case symbeg:
+ case symend:
+ if (f (p, arg))
+ return true;
+ p++;
+ continue;
+
+ case jump:
+ case jump_n:
+ newp1 = extract_address (p + 1);
+ if (newp1 > p)
+ { /* Forward jump, boring. */
+ p = newp1;
+ continue;
+ }
+ switch (*newp1)
+ {
+ case on_failure_jump:
+ case on_failure_keep_string_jump:
+ case on_failure_jump_nastyloop:
+ case on_failure_jump_loop:
+ case on_failure_jump_smart:
+ case succeed_n:
+ newp2 = extract_address (newp1 + 1);
+ goto do_twoway_jump;
+ default:
+ newp2 = loop_end; /* "Safe" choice. */
+ goto do_jump;
+ }
- case duplicate:
- /* If the first character has to match a backreference, that means
- that the group was empty (since it already matched). Since this
- is the only case that interests us here, we can assume that the
- backreference must match the empty string. */
- p++;
- continue;
+ case on_failure_jump:
+ case on_failure_keep_string_jump:
+ case on_failure_jump_nastyloop:
+ case on_failure_jump_loop:
+ case on_failure_jump_smart:
+ newp1 = extract_address (p + 1);
+ newp2 = p + 3;
+ /* For `+` loops, we often have an `on_failure_jump` that skips
+ forward over a subsequent `jump`. Recognize this pattern
+ since that subsequent `jump` is the one that jumps to the
+ loop-entry. */
+ newp2 = ((re_opcode_t) *newp2 == jump)
+ ? extract_address (newp2 + 1) : newp2;
+
+ do_twoway_jump:
+ /* We have to check that both destinations are safe.
+ Arrange for `newp1` to be the smaller of the two. */
+ if (newp1 > newp2)
+ (tmp = newp1, newp1 = newp2, newp2 = tmp);
+
+ if (newp2 <= p_orig) /* Both destinations go backward! */
+ {
+#if ENABLE_CHECKING
+ fprintf (stderr, "FORALL_FIRSTCHAR: Broken assumption2!!\n");
+#endif
+ return false;
+ }
+ if (!forall_firstchar_1 (newp2, pend, loop_beg, loop_end, f, arg))
+ return false;
- /* Following are the cases which match a character. These end
- with 'break'. */
+ do_jump:
+ eassert (newp2 <= loop_end);
+ if (newp1 <= p_orig)
+ {
+ if (newp1 < loop_beg)
+ {
+#if ENABLE_CHECKING
+ fprintf (stderr, "FORALL_FIRSTCHAR: Broken
assumption3!!\n");
+#endif
+ return false;
+ }
+ else if (newp1 == loop_beg)
+ /* If we jump backward to the entry point of the current loop
+ it means it's a zero-length cycle through that loop;
+ this cycle itself does not break safety. */
+ return true;
+ else
+ /* We jump backward to a new loop, nested within the current
+ one. `newp1` is the entry point and `newp2` the exit of
+ that inner loop. */
+ /* `p` gets smaller, but termination is still ensured because
+ `loop_beg` gets bigger. */
+ (loop_beg = newp1, loop_end = newp2);
+ }
+ p = newp1;
+ continue;
+
+ case succeed_n:
+ newp1 = extract_address (p + 1);
+ newp2 = p + 5; /* Skip the two bytes containing the count. */
+ goto do_twoway_jump;
+
+ case set_number_at:
+ offset = extract_number (p + 1);
+ DEBUG_STATEMENT (eassert (extract_number (p + 3)));
+ /* If we're setting the counter of an immediately following
+ `succeed_n`, then this next execution of `succeed_n` will do
+ nothing but decrement its counter and "fall through".
+ So we do the fall through here to avoid considering the
+ "on failure" part of the `succeed_n` which should only be
+ considered when coming from the `jump(_n)` at the end of
+ the loop. */
+ p += (offset == 5 && p[5] == succeed_n) ? 10 : 5;
+ continue;
+
+ case start_memory:
+ case stop_memory:
+ p += 2;
+ continue;
+
+ /* This could match the empty string, so we may need to continue,
+ but in most cases, this can match "anything", so we should
+ return `false` unless told otherwise. */
+ case duplicate:
+ if (!f (p, arg))
+ return false;
+ p += 2;
+ continue;
+
+ default:
+ abort (); /* We have listed all the cases. */
+ }
+ }
+}
- case exactn:
- if (fastmap)
- {
- /* If multibyte is nonzero, the first byte of each
- character is an ASCII or a leading code. Otherwise,
- each byte is a character. Thus, this works in both
- cases. */
- fastmap[p[1]] = 1;
- if (multibyte)
- {
- /* Cover the case of matching a raw char in a
- multibyte regexp against unibyte. */
- if (CHAR_BYTE8_HEAD_P (p[1]))
- fastmap[CHAR_TO_BYTE8 (STRING_CHAR (p + 1))] = 1;
- }
- else
- {
- /* For the case of matching this unibyte regex
- against multibyte, we must set a leading code of
- the corresponding multibyte character. */
- int c = RE_CHAR_TO_MULTIBYTE (p[1]);
+/* Iterate through all the char-matching operations directly reachable from P.
+ Return true if P is "safe", meaning that PEND cannot be reached directly
+ from P and all calls to F returned true.
+ Return false if PEND *may* be directly reachable from P or if one of
+ the calls to F returned false.
+ PEND can be NULL (and hence never reachable).
+
+ Call `F (POS, ARG)` for every POS directly reachable from P,
+ before reaching PEND, where POS is the position of a char-matching
+ operation (`exactn`, `charset`, ...).
+
+ For operations that match the empty string (`wordbeg`, ...), if F
+ returns true we stop going down that path immediately but if it returns
+ false we don't consider it as a failure and we simply look for the
+ next char-matching operations on that path.
+ For `duplicate`, it is the reverse: a false is an immediate failure
+ whereas a true just lets the analysis continue with the rest of the path.
+
+ This function can be used while building the bytecode (in which case
+ you should pass NULL for bufp), but if so, P and PEND need to delimit
+ a valid block such that there is not jump to a location outside
+ of [P...PEND]. */
+static bool
+forall_firstchar (struct re_pattern_buffer *bufp, re_char *p, re_char *pend,
+ bool f (re_char *p, void *arg), void *arg)
+{
+ eassert (!bufp || bufp->used);
+ eassert (pend || bufp->used);
+ return forall_firstchar_1 (p, pend,
+ bufp ? bufp->buffer - 1 : p,
+ bufp ? bufp->buffer + bufp->used + 1 : pend,
+ f, arg);
+}
- fastmap[CHAR_LEADING_CODE (c)] = 1;
- }
- }
- break;
+struct anafirst_data {
+ bool multibyte;
+ char *fastmap;
+ bool match_any_multibyte_characters;
+};
+static bool
+analyze_first_fastmap (const re_char *p, void *arg)
+{
+ struct anafirst_data *data = arg;
- case anychar:
- /* We could put all the chars except for \n (and maybe \0)
- but we don't bother since it is generally not worth it. */
- if (!fastmap) break;
- return -1;
+ int j, k;
+ int nbits;
+ bool not;
+ switch (*p)
+ {
+ case succeed:
+ return false;
- case charset_not:
- if (!fastmap) break;
- {
- /* Chars beyond end of bitmap are possible matches. */
- for (j = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH;
- j < (1 << BYTEWIDTH); j++)
- fastmap[j] = 1;
- }
- FALLTHROUGH;
- case charset:
- if (!fastmap) break;
- not = (re_opcode_t) *(p - 1) == charset_not;
- nbits = CHARSET_BITMAP_SIZE (&p[-1]) * BYTEWIDTH;
- p++;
- for (j = 0; j < nbits; j++)
- if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not)
- fastmap[j] = 1;
-
- /* To match raw bytes (in the 80..ff range) against multibyte
- strings, add their leading bytes to the fastmap. */
- for (j = 0x80; j < nbits; j++)
- if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not)
- fastmap[CHAR_LEADING_CODE (BYTE8_TO_CHAR (j))] = 1;
-
- if (/* Any leading code can possibly start a character
- which doesn't match the specified set of characters. */
- not
- ||
- /* If we can match a character class, we can match any
- multibyte characters. */
- (CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
- && CHARSET_RANGE_TABLE_BITS (&p[-2]) != 0))
+ case duplicate:
+ /* If the first character has to match a backreference, that means
+ that the group was empty (since it already matched). Since this
+ is the only case that interests us here, we can assume that the
+ backreference must match the empty string and we need to
+ build the fastmap from the rest of the path. */
+ return true;
- {
- if (match_any_multibyte_characters == false)
- {
- for (j = MIN_MULTIBYTE_LEADING_CODE;
- j <= MAX_MULTIBYTE_LEADING_CODE; j++)
- fastmap[j] = 1;
- match_any_multibyte_characters = true;
- }
- }
+ /* Following are the cases which match a character. These end
+ with 'break'. */
- else if (!not && CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
- && match_any_multibyte_characters == false)
- {
- /* Set fastmap[I] to 1 where I is a leading code of each
- multibyte character in the range table. */
- int c, count;
- unsigned char lc1, lc2;
-
- /* Make P points the range table. '+ 2' is to skip flag
- bits for a character class. */
- p += CHARSET_BITMAP_SIZE (&p[-2]) + 2;
-
- /* Extract the number of ranges in range table into COUNT. */
- EXTRACT_NUMBER_AND_INCR (count, p);
- for (; count > 0; count--, p += 3)
- {
- /* Extract the start and end of each range. */
- EXTRACT_CHARACTER (c, p);
- lc1 = CHAR_LEADING_CODE (c);
- p += 3;
- EXTRACT_CHARACTER (c, p);
- lc2 = CHAR_LEADING_CODE (c);
- for (j = lc1; j <= lc2; j++)
- fastmap[j] = 1;
- }
- }
- break;
+ case exactn:
+ p++;
+ /* If multibyte is nonzero, the first byte of each
+ character is an ASCII or a leading code. Otherwise,
+ each byte is a character. Thus, this works in both
+ cases. */
+ data->fastmap[p[1]] = 1;
+ if (data->multibyte)
+ {
+ /* Cover the case of matching a raw char in a
+ multibyte regexp against unibyte. */
+ if (CHAR_BYTE8_HEAD_P (p[1]))
+ data->fastmap[CHAR_TO_BYTE8 (STRING_CHAR (p + 1))] = 1;
+ }
+ else
+ {
+ /* For the case of matching this unibyte regex
+ against multibyte, we must set a leading code of
+ the corresponding multibyte character. */
+ int c = RE_CHAR_TO_MULTIBYTE (p[1]);
- case syntaxspec:
- case notsyntaxspec:
- if (!fastmap) break;
- /* This match depends on text properties. These end with
- aborting optimizations. */
- return -1;
+ data->fastmap[CHAR_LEADING_CODE (c)] = 1;
+ }
+ return true;
- case categoryspec:
- case notcategoryspec:
- if (!fastmap) break;
- not = (re_opcode_t)p[-1] == notcategoryspec;
- k = *p++;
- for (j = (1 << BYTEWIDTH); j >= 0; j--)
- if ((CHAR_HAS_CATEGORY (j, k)) ^ not)
- fastmap[j] = 1;
-
- /* Any leading code can possibly start a character which
- has or doesn't has the specified category. */
- if (match_any_multibyte_characters == false)
+ case anychar:
+ /* We could put all the chars except for \n (and maybe \0)
+ but we don't bother since it is generally not worth it. */
+ return false;
+
+ case charset_not:
+ {
+ /* Chars beyond end of bitmap are possible matches. */
+ for (j = CHARSET_BITMAP_SIZE (p) * BYTEWIDTH;
+ j < (1 << BYTEWIDTH); j++)
+ data->fastmap[j] = 1;
+ }
+ FALLTHROUGH;
+ case charset:
+ not = (re_opcode_t) *(p) == charset_not;
+ nbits = CHARSET_BITMAP_SIZE (p) * BYTEWIDTH;
+ p += 2;
+ for (j = 0; j < nbits; j++)
+ if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not)
+ data->fastmap[j] = 1;
+
+ /* To match raw bytes (in the 80..ff range) against multibyte
+ strings, add their leading bytes to the fastmap. */
+ for (j = 0x80; j < nbits; j++)
+ if (!!(p[j / BYTEWIDTH] & (1 << (j % BYTEWIDTH))) ^ not)
+ data->fastmap[CHAR_LEADING_CODE (BYTE8_TO_CHAR (j))] = 1;
+
+ if (/* Any leading code can possibly start a character
+ which doesn't match the specified set of characters. */
+ not
+ ||
+ /* If we can match a character class, we can match any
+ multibyte characters. */
+ (CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
+ && CHARSET_RANGE_TABLE_BITS (&p[-2]) != 0))
+
+ {
+ if (!data->match_any_multibyte_characters)
{
for (j = MIN_MULTIBYTE_LEADING_CODE;
- j <= MAX_MULTIBYTE_LEADING_CODE; j++)
- fastmap[j] = 1;
- match_any_multibyte_characters = true;
+ j <= MAX_MULTIBYTE_LEADING_CODE; j++)
+ data->fastmap[j] = 1;
+ data->match_any_multibyte_characters = true;
}
- break;
-
- /* All cases after this match the empty string. These end with
- 'continue'. */
-
- case at_dot:
- case no_op:
- case begline:
- case endline:
- case begbuf:
- case endbuf:
- case wordbound:
- case notwordbound:
- case wordbeg:
- case wordend:
- case symbeg:
- case symend:
- continue;
-
+ }
- case jump:
- EXTRACT_NUMBER_AND_INCR (j, p);
- if (j < 0)
- /* Backward jumps can only go back to code that we've already
- visited. 're_compile' should make sure this is true. */
- break;
- p += j;
- switch (*p)
+ else if (!not && CHARSET_RANGE_TABLE_EXISTS_P (&p[-2])
+ && data->match_any_multibyte_characters == false)
+ {
+ /* Set fastmap[I] to 1 where I is a leading code of each
+ multibyte character in the range table. */
+ int c, count;
+ unsigned char lc1, lc2;
+
+ /* Make P points the range table. '+ 2' is to skip flag
+ bits for a character class. */
+ p += CHARSET_BITMAP_SIZE (&p[-2]) + 2;
+
+ /* Extract the number of ranges in range table into COUNT. */
+ EXTRACT_NUMBER_AND_INCR (count, p);
+ for (; count > 0; count--, p += 3)
{
- case on_failure_jump:
- case on_failure_keep_string_jump:
- case on_failure_jump_loop:
- case on_failure_jump_nastyloop:
- case on_failure_jump_smart:
- p++;
- break;
- default:
- continue;
- };
- /* Keep P1 to allow the 'on_failure_jump' we are jumping to
- to jump back to "just after here". */
- FALLTHROUGH;
- case on_failure_jump:
- case on_failure_keep_string_jump:
- case on_failure_jump_nastyloop:
- case on_failure_jump_loop:
- case on_failure_jump_smart:
- EXTRACT_NUMBER_AND_INCR (j, p);
- if (p + j <= p1)
- ; /* Backward jump to be ignored. */
- else
- { /* We have to look down both arms.
- We first go down the "straight" path so as to minimize
- stack usage when going through alternatives. */
- int r = analyze_first (p, pend, fastmap, multibyte);
- if (r) return r;
- p += j;
+ /* Extract the start and end of each range. */
+ EXTRACT_CHARACTER (c, p);
+ lc1 = CHAR_LEADING_CODE (c);
+ p += 3;
+ EXTRACT_CHARACTER (c, p);
+ lc2 = CHAR_LEADING_CODE (c);
+ for (j = lc1; j <= lc2; j++)
+ data->fastmap[j] = 1;
}
- continue;
+ }
+ return true;
+ case syntaxspec:
+ case notsyntaxspec:
+ /* This match depends on text properties. These end with
+ aborting optimizations. */
+ return false;
- case jump_n:
- /* This code simply does not properly handle forward jump_n. */
- DEBUG_STATEMENT (EXTRACT_NUMBER (j, p); eassert (j < 0));
- p += 4;
- /* jump_n can either jump or fall through. The (backward) jump
- case has already been handled, so we only need to look at the
- fallthrough case. */
- continue;
+ case categoryspec:
+ case notcategoryspec:
+ not = (re_opcode_t)p[0] == notcategoryspec;
+ p++;
+ k = *p++;
+ for (j = (1 << BYTEWIDTH); j >= 0; j--)
+ if ((CHAR_HAS_CATEGORY (j, k)) ^ not)
+ data->fastmap[j] = 1;
+
+ /* Any leading code can possibly start a character which
+ has or doesn't has the_malloc_fn specified category. */
+ if (!data->match_any_multibyte_characters)
+ {
+ for (j = MIN_MULTIBYTE_LEADING_CODE;
+ j <= MAX_MULTIBYTE_LEADING_CODE; j++)
+ data->fastmap[j] = 1;
+ data->match_any_multibyte_characters = true;
+ }
+ return true;
- case succeed_n:
- /* If N == 0, it should be an on_failure_jump_loop instead.
- `j` can be negative because `EXTRACT_NUMBER` extracts a
- signed number whereas `succeed_n` treats it as unsigned. */
- DEBUG_STATEMENT (EXTRACT_NUMBER (j, p + 2); eassert (j != 0));
- p += 4;
- /* We only care about one iteration of the loop, so we don't
- need to consider the case where this behaves like an
- on_failure_jump. */
- continue;
+ case endline:
+ case endbuf:
+ case wordbeg:
+ case wordend:
+ case symbeg:
+ case symend:
+ /* This false doesn't mean failure but rather "not succeeded yet". */
+ return false;
+ default:
+#if ENABLE_CHECKING
+ abort (); /* We have listed all the cases. */
+#endif
+ return false;
+ }
+}
- case set_number_at:
- p += 4;
- continue;
+static bool
+analyze_first_null (const re_char *p, void *arg)
+{
+ switch (*p)
+ {
+ case succeed:
+ /* This is safe: we can't reach `pend` at all from here. */
+ return true;
+ case duplicate:
+ /* Either `duplicate` ends up matching a non-empty string, in which
+ case we're good, or it matches the empty string, in which case we
+ need to continue checking the rest of this path, which is exactly
+ what returning `true` does, here. */
+ return true;
- case start_memory:
- case stop_memory:
- p += 1;
- continue;
+ case exactn:
+ case anychar:
+ case charset_not:
+ case charset:
+ case syntaxspec:
+ case notsyntaxspec:
+ case categoryspec:
+ case notcategoryspec:
+ return true;
+ case endline:
+ case endbuf:
+ case wordbeg:
+ case wordend:
+ case symbeg:
+ case symend:
+ /* This false doesn't mean failure but rather "not succeeded yet". */
+ return false;
- default:
- abort (); /* We have listed all the cases. */
- } /* switch *p++ */
+ default:
+#if ENABLE_CHECKING
+ abort (); /* We have listed all the cases. */
+#endif
+ return false;
+ }
+}
- /* Getting here means we have found the possible starting
- characters for one path of the pattern -- and that the empty
- string does not match. We need not follow this path further. */
- return 0;
- } /* while p */
+/* analyze_first.
+ If fastmap is non-NULL, go through the pattern and fill fastmap
+ with all the possible leading chars. If fastmap is NULL, don't
+ bother filling it up (obviously) and only return whether the
+ pattern could potentially match the empty string.
- /* We reached the end without matching anything. */
- return 1;
+ Return false if p matches at least one char before reaching pend.
+ Return true if p..pend might match the empty string
+ or if fastmap was not updated accurately. */
+
+static bool
+analyze_first (struct re_pattern_buffer *bufp,
+ re_char *p, re_char *pend, char *fastmap)
+{
+ eassert (pend);
+ struct anafirst_data data = { bufp ? bufp->multibyte : false,
+ fastmap, false };
+ bool safe = forall_firstchar (bufp->used ? bufp : NULL, p, pend,
+ fastmap ? analyze_first_fastmap
+ : analyze_first_null,
+ &data);
+ return !safe;
+}
-} /* analyze_first */
/* Compute a fastmap for the compiled pattern in BUFP.
A fastmap records which of the (1 << BYTEWIDTH) possible
@@ -3134,7 +3305,6 @@ static void
re_compile_fastmap (struct re_pattern_buffer *bufp)
{
char *fastmap = bufp->fastmap;
- int analysis;
eassert (fastmap && bufp->buffer);
@@ -3143,9 +3313,8 @@ re_compile_fastmap (struct re_pattern_buffer *bufp)
/* FIXME: Is the following assignment correct even when ANALYSIS < 0? */
bufp->fastmap_accurate = 1; /* It will be when we're done. */
- analysis = analyze_first (bufp->buffer, bufp->buffer + bufp->used,
- fastmap, RE_MULTIBYTE_P (bufp));
- bufp->can_be_null = (analysis != 0);
+ bufp->can_be_null = analyze_first (bufp, bufp->buffer,
+ bufp->buffer + bufp->used, fastmap);
} /* re_compile_fastmap */
/* Set REGS to hold NUM_REGS registers, storing them in STARTS and
@@ -3183,7 +3352,7 @@ re_set_registers (struct re_pattern_buffer *bufp, struct
re_registers *regs,
/* Searching routines. */
/* Like re_search_2, below, but only one string is specified, and
- doesn't let you say where to stop matching. */
+ doesn't let you say where to stop matching. */
ptrdiff_t
re_search (struct re_pattern_buffer *bufp, const char *string, ptrdiff_t size,
@@ -3560,33 +3729,6 @@ skip_one_char (re_char *p)
}
-/* Jump over non-matching operations. */
-static re_char *
-skip_noops (re_char *p, re_char *pend)
-{
- int mcnt;
- while (p < pend)
- {
- switch (*p)
- {
- case start_memory:
- case stop_memory:
- p += 2; break;
- case no_op:
- p += 1; break;
- case jump:
- p += 1;
- EXTRACT_NUMBER_AND_INCR (mcnt, p);
- p += mcnt;
- break;
- default:
- return p;
- }
- }
- eassert (p == pend);
- return p;
-}
-
/* Test if C matches charset op. *PP points to the charset or charset_not
opcode. When the function finishes, *PP will be advanced past that opcode.
C is character to test (possibly after translations) and CORIG is original
@@ -3655,7 +3797,7 @@ execute_charset (re_char **pp, int c, int corig, bool
unibyte,
return not;
}
-/* Case where `p2` points to an `exactn`. */
+/* Case where `p2` points to an `exactn` or `endline`. */
static bool
mutually_exclusive_exactn (struct re_pattern_buffer *bufp, re_char *p1,
re_char *p2)
@@ -3754,194 +3896,88 @@ mutually_exclusive_charset (struct re_pattern_buffer
*bufp, re_char *p1,
return false;
}
-/* True if "p1 matches something" implies "p2 fails". */
-/* We're trying to follow all paths reachable from `p2`, but since some
- loops can match the empty string, this can loop back to `p2`.
-
- To avoid inf-looping, we take advantage of the fact that
- the bytecode we generate is made of syntactically nested loops, more
- specifically, every loop has a single entry point and single exit point.
-
- The function takes 2 more arguments (`loop_entry` and `loop_exit`).
- `loop_entry` points to the sole entry point of the current loop and
- `loop_exit` points to its sole exit point (when non-NULL).
-
- Jumps outside of `loop_entry..exit` should not occur.
- The function can assume that `loop_exit` is "mutually exclusive".
- The same holds for `loop_entry` except when `p2 == loop_entry`.
-
- To guarantee termination, recursive calls should make sure that either
- `loop_entry` is larger, or it's unchanged but `p2` is larger.
+struct mutexcl_data {
+ struct re_pattern_buffer *bufp;
+ re_char *p1;
+};
- FIXME: This is failsafe (can't return true when it shouldn't)
- but it could be too conservative if we start generating bytecode
- with a different shape, so maybe we should bite the bullet and
- replace done_beg/end with an actual list of positions we've
- already processed. */
static bool
-mutually_exclusive_aux (struct re_pattern_buffer *bufp, re_char *p1,
- re_char *p2, re_char *loop_entry, re_char *loop_exit)
+mutually_exclusive_one (re_char *p2, void *arg)
{
- re_opcode_t op2;
- unsigned char *pend = bufp->buffer + bufp->used;
- re_char *p2_orig = p2;
-
- eassert (p1 >= bufp->buffer && p1 < pend
- && p2 >= bufp->buffer && p2 <= pend);
-
- if (p2 == loop_exit)
- return true; /* Presumably already checked elsewhere. */
- eassert (loop_entry && p2 >= loop_entry);
- if (p2 < loop_entry || (loop_exit && p2 > loop_exit))
- { /* The assumptions about the shape of the code aren't true :-( */
-#ifdef ENABLE_CHECKING
- error ("Broken assumption in regex.c:mutually_exclusive_aux");
-#endif
- return false;
- }
-
- /* Skip over open/close-group commands.
- If what follows this loop is a ...+ construct,
- look at what begins its body, since we will have to
- match at least one of that. */
- p2 = skip_noops (p2, pend);
- /* The same skip can be done for p1, except that this function
- is only used in the case where p1 is a simple match operator. */
- /* p1 = skip_noops (p1, pend); */
-
- eassert (p1 >= bufp->buffer && p1 < pend
- && p2 >= bufp->buffer && p2 <= pend);
-
- op2 = p2 == pend ? succeed : *p2;
-
- switch (op2)
+ struct mutexcl_data *data = arg;
+ switch (*p2)
{
- case succeed:
- case endbuf:
- /* If we're at the end of the pattern, we can change. */
- if (skip_one_char (p1))
- {
- DEBUG_PRINT (" End of pattern: fast loop.\n");
- return true;
- }
- break;
-
case endline:
case exactn:
- return mutually_exclusive_exactn (bufp, p1, p2);
-
+ return mutually_exclusive_exactn (data->bufp, data->p1, p2);
case charset:
{
- if ((re_opcode_t) *p1 == exactn)
- return mutually_exclusive_exactn (bufp, p2, p1);
+ if (*data->p1 == exactn)
+ return mutually_exclusive_exactn (data->bufp, p2, data->p1);
else
- return mutually_exclusive_charset (bufp, p1, p2);
+ return mutually_exclusive_charset (data->bufp, data->p1, p2);
}
- break;
case charset_not:
- switch (*p1)
+ switch (*data->p1)
{
case exactn:
- return mutually_exclusive_exactn (bufp, p2, p1);
+ return mutually_exclusive_exactn (data->bufp, p2, data->p1);
case charset:
- return mutually_exclusive_charset (bufp, p2, p1);
+ return mutually_exclusive_charset (data->bufp, p2, data->p1);
case charset_not:
/* When we have two charset_not, it's very unlikely that
they don't overlap. The union of the two sets of excluded
chars should cover all possible chars, which, as a matter of
fact, is virtually impossible in multibyte buffers. */
- break;
+ return false;
}
- break;
-
- case wordend:
- return ((re_opcode_t) *p1 == syntaxspec && p1[1] == Sword);
- case symend:
- return ((re_opcode_t) *p1 == syntaxspec
- && (p1[1] == Ssymbol || p1[1] == Sword));
- case notsyntaxspec:
- return ((re_opcode_t) *p1 == syntaxspec && p1[1] == p2[1]);
-
- case wordbeg:
- return ((re_opcode_t) *p1 == notsyntaxspec && p1[1] == Sword);
- case symbeg:
- return ((re_opcode_t) *p1 == notsyntaxspec
- && (p1[1] == Ssymbol || p1[1] == Sword));
+ return false;
+ case anychar:
+ return false; /* FIXME: exactn \n ? */
case syntaxspec:
- return ((re_opcode_t) *p1 == notsyntaxspec && p1[1] == p2[1]);
-
- case wordbound:
- return (((re_opcode_t) *p1 == notsyntaxspec
- || (re_opcode_t) *p1 == syntaxspec)
- && p1[1] == Sword);
-
+ return (*data->p1 == notsyntaxspec && data->p1[1] == p2[1]);
+ case notsyntaxspec:
+ return (*data->p1 == syntaxspec && data->p1[1] == p2[1]);
case categoryspec:
- return ((re_opcode_t) *p1 == notcategoryspec && p1[1] == p2[1]);
+ return (*data->p1 == notcategoryspec && data->p1[1] == p2[1]);
case notcategoryspec:
- return ((re_opcode_t) *p1 == categoryspec && p1[1] == p2[1]);
+ return (*data->p1 == categoryspec && data->p1[1] == p2[1]);
- case on_failure_jump_nastyloop:
- case on_failure_jump_smart:
- case on_failure_jump_loop:
- case on_failure_keep_string_jump:
- case on_failure_jump:
- {
- int mcnt;
- p2++;
- EXTRACT_NUMBER_AND_INCR (mcnt, p2);
- re_char *p2_other = p2 + mcnt, *tmp;
- /* For `+` loops, we often have an `on_failure_jump` that skips forward
- over a subsequent `jump` for lack of an `on_failure_dont_jump`
- kind of thing. Recognize this pattern since that subsequent
- `jump` is the one that jumps to the loop-entry. */
- if ((re_opcode_t) p2[0] == jump && mcnt == 3)
- {
- EXTRACT_NUMBER (mcnt, p2 + 1);
- p2 += mcnt + 3;
- }
-
- /* We have to check that both destinations are safe.
- Arrange for `p2` to be the smaller of the two. */
- if (p2 > p2_other)
- (tmp = p2, p2 = p2_other, p2_other = tmp);
-
- if (p2_other <= p2_orig /* Both destinations go backward! */
- || !mutually_exclusive_aux (bufp, p1, p2_other,
- loop_entry, loop_exit))
- return false;
+ case endbuf:
+ case succeed:
+ return true;
+ case wordbeg:
+ return (*data->p1 == notsyntaxspec && data->p1[1] == Sword);
+ case wordend:
+ return (*data->p1 == syntaxspec && data->p1[1] == Sword);
+ case symbeg:
+ return (*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));
- /* Now that we know that `p2_other` is a safe (i.e. mutually-exclusive)
- position, let's check `p2`. */
- if (p2 == loop_entry)
- /* If we jump backward to the entry point of the current loop
- it means it's a zero-length cycle through that loop, so
- this cycle itself does not break mutual-exclusion. */
- return true;
- else if (p2 > p2_orig)
- /* Boring forward jump. */
- return mutually_exclusive_aux (bufp, p1, p2, loop_entry, loop_exit);
- else if (loop_entry < p2 && p2 < p2_orig)
- /* We jump backward to a new loop, nested within the current one.
- `p2` is the entry point and `p2_other` the exit of that inner. */
- return mutually_exclusive_aux (bufp, p1, p2, p2, p2_other);
- else
- return false;
- }
+ case duplicate:
+ /* At this point, we know nothing about what this can match, sadly. */
+ return false;
default:
- ;
+#if ENABLE_CHECKING
+ abort (); /* We have listed all the cases. */
+#endif
+ return false;
}
-
- /* Safe default. */
- return false;
}
+/* True if "p1 matches something" implies "p2 fails". */
+
static bool
mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
re_char *p2)
{
- return mutually_exclusive_aux (bufp, p1, p2, bufp->buffer, NULL);
+ struct mutexcl_data data = { bufp, p1 };
+ return forall_firstchar (bufp, p2, NULL, mutually_exclusive_one, &data);
}
/* Matching routines. */
@@ -4071,6 +4107,9 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
/* This keeps track of how many buffer/string positions we examined. */
ptrdiff_t nchars = 0;
+ /* Final return value of the function. */
+ ptrdiff_t retval = -1; /* Presumes failure to match for now. */
+
#ifdef DEBUG_COMPILES_ARGUMENTS
/* Counts the total number of registers pushed. */
ptrdiff_t num_regs_pushed = 0;
@@ -4325,15 +4364,8 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
DEBUG_PRINT ("Returning %td from re_match_2.\n", dcnt);
- unbind_to (count, Qnil);
- SAFE_FREE ();
- /* The factor of 50 below is a heuristic that needs to be tuned. It
- means we consider 50 buffer positions examined by this function
- roughly equivalent to the display engine iterating over a single
- buffer position. */
- if (max_redisplay_ticks > 0 && nchars > 0)
- update_redisplay_ticks (nchars / 50 + 1, NULL);
- return dcnt;
+ retval = dcnt;
+ goto endof_re_match;
}
/* Otherwise match next pattern command. */
@@ -4826,7 +4858,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
/* Have to succeed matching what follows at least n times.
- After that, handle like 'on_failure_jump'. */
+ After that, handle like 'on_failure_jump_loop'. */
case succeed_n:
/* Signedness doesn't matter since we only compare MCNT to 0. */
EXTRACT_NUMBER (mcnt, p + 2);
@@ -5174,8 +5206,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
case succeed_n:
d = str;
continue_failure_jump:
- EXTRACT_NUMBER_AND_INCR (mcnt, pat);
- p = pat + mcnt;
+ p = extract_address (pat);
break;
case no_op:
@@ -5198,13 +5229,18 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
if (best_regs_set)
goto restore_best_regs;
+endof_re_match:
unbind_to (count, Qnil);
SAFE_FREE ();
+ /* The factor of 50 below is a heuristic that needs to be tuned.
+ It means we consider 50 buffer positions examined by this function
+ roughly equivalent to the display engine iterating over a single
+ buffer position. */
if (max_redisplay_ticks > 0 && nchars > 0)
update_redisplay_ticks (nchars / 50 + 1, NULL);
- return -1; /* Failure to match. */
+ return retval;
}
/* Subroutine definitions for re_match_2. */
diff --git a/src/regex-emacs.h b/src/regex-emacs.h
index bc357633135..d9adcc69443 100644
--- a/src/regex-emacs.h
+++ b/src/regex-emacs.h
@@ -195,4 +195,8 @@ extern bool re_iswctype (int ch, re_wctype_t cc);
extern re_wctype_t re_wctype_parse (const unsigned char **strp,
ptrdiff_t limit);
+#if ENABLE_CHECKING
+extern void print_compiled_pattern (FILE *dest, struct re_pattern_buffer
*bufp);
+#endif
+
#endif /* EMACS_REGEX_H */
diff --git a/src/search.c b/src/search.c
index 742a78cb0cd..e9b29bb7179 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3376,6 +3376,46 @@ the buffer. If the buffer doesn't have a cache, the
value is nil. */)
set_buffer_internal_1 (old);
return val;
}
+
+DEFUN ("re--describe-compiled", Fre__describe_compiled, Sre__describe_compiled,
+ 1, 2, 0,
+ doc: /* Return a string describing the compiled form of REGEXP.
+If RAW is non-nil, just return the actual bytecode. */)
+ (Lisp_Object regexp, Lisp_Object raw)
+{
+ struct regexp_cache *cache_entry
+ = compile_pattern (regexp, NULL,
+ (!NILP (BVAR (current_buffer, case_fold_search))
+ ? BVAR (current_buffer, case_canon_table) : Qnil),
+ false,
+ !NILP (BVAR (current_buffer,
+ enable_multibyte_characters)));
+ if (!NILP (raw))
+ return make_unibyte_string ((char *) cache_entry->buf.buffer,
+ cache_entry->buf.used);
+ else
+ { /* FIXME: Why ENABLE_CHECKING? */
+#if !defined ENABLE_CHECKING
+ error ("Not available: rebuild with --enable-checking");
+#elif HAVE_OPEN_MEMSTREAM
+ char *buffer = NULL;
+ size_t size = 0;
+ FILE* f = open_memstream (&buffer, &size);
+ if (!f)
+ report_file_error ("open_memstream failed", regexp);
+ print_compiled_pattern (f, &cache_entry->buf);
+ fclose (f);
+ if (!buffer)
+ return Qnil;
+ Lisp_Object description = make_unibyte_string (buffer, size);
+ free (buffer);
+ return description;
+#else /* ENABLE_CHECKING && !HAVE_OPEN_MEMSTREAM */
+ print_compiled_pattern (stderr, &cache_entry->buf);
+ return build_string ("Description was sent to standard error");
+#endif /* !ENABLE_CHECKING */
+ }
+}
static void syms_of_search_for_pdumper (void);
@@ -3455,6 +3495,7 @@ is to bind it with `let' around a small expression. */);
defsubr (&Smatch_data__translate);
defsubr (&Sregexp_quote);
defsubr (&Snewline_cache_check);
+ defsubr (&Sre__describe_compiled);
pdumper_do_now_and_after_load (syms_of_search_for_pdumper);
}
diff --git a/src/sfntfont.c b/src/sfntfont.c
index d556092db12..3506742a92b 100644
--- a/src/sfntfont.c
+++ b/src/sfntfont.c
@@ -545,6 +545,11 @@ sfnt_parse_style (Lisp_Object style_name, struct
sfnt_font_desc *desc)
continue;
}
+ /* The adstyle must be a symbol, so intern it if it is set. */
+
+ if (!NILP (desc->adstyle))
+ desc->adstyle = Fintern (desc->adstyle, Qnil);
+
SAFE_FREE ();
}
@@ -1655,7 +1660,7 @@ sfntfont_list_1 (struct sfnt_font_desc *desc, Lisp_Object
spec,
if (NILP (desc->instances))
{
tem = AREF (spec, FONT_ADSTYLE_INDEX);
- if (!NILP (tem) && NILP (Fequal (tem, desc->adstyle)))
+ if (!NILP (tem) && !EQ (tem, desc->adstyle))
return 0;
if (FONT_WIDTH_NUMERIC (spec) != -1
diff --git a/src/xterm.c b/src/xterm.c
index c459e5d8d95..18a6c51efb3 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -32812,17 +32812,12 @@ frame placement via frame parameters,
`set-frame-position', and
This is used to support quitting on devices that do not have any kind
of physical keyboard, or where the physical keyboard is incapable of
-entering `C-g'. It defaults to `XF86XK_AudioLowerVolume' on XFree86
-and X.Org servers, and is unset.
+entering `C-g'.
The value is an alist associating between strings, describing X server
vendor names, and a single number describing the keysym to use. The
keysym to use for each display connection is determined upon
connection setup, and does not reflect further changes to this
variable. */);
- Vx_quit_keysym
- = list2 (Fcons (build_string ("The X.Org Foundation"),
- make_int (269025041)),
- Fcons (build_string ("The XFree86 Project, Inc."),
- make_int (269025041)));
+ Vx_quit_keysym = Qnil;
}
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el
b/test/lisp/emacs-lisp/cl-print-tests.el
index e44a8e5ccc4..631dd834a68 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -58,6 +58,23 @@
(cl-print-tests-check-ellipsis-expansion
[a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]")))
+(ert-deftest cl-print-tests-ellipsis-string ()
+ "Ellipsis expansion works in strings."
+ (let ((cl-print-string-length 4))
+ (cl-print-tests-check-ellipsis-expansion
+ "abcdefg" "\"abcd...\"" "efg")
+ (cl-print-tests-check-ellipsis-expansion
+ "abcdefghijk" "\"abcd...\"" "efgh...")
+ (let ((print-length 4)
+ (print-level 3))
+ (cl-print-tests-check-ellipsis-expansion
+ '(1 (2 (3 #("abcde" 0 5 (test t)))))
+ "(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))"))
+ (let ((print-length 4))
+ (cl-print-tests-check-ellipsis-expansion
+ #("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t))
+ "#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ..."))))
+
(ert-deftest cl-print-tests-ellipsis-struct ()
"Ellipsis expansion works in structures."
(let ((print-length 4)
@@ -129,7 +146,7 @@
;; Print something which needs to be abbreviated and which can be.
(should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100))
- 150 ;; 100. The LIMIT argument is advisory rather than
absolute.
+ 100
(length (cl-prin1-to-string thing100))))
;; Print something resistant to easy abbreviation.
diff --git a/test/lisp/eshell/esh-cmd-tests.el
b/test/lisp/eshell/esh-cmd-tests.el
index 7c384471e93..643038f89ff 100644
--- a/test/lisp/eshell/esh-cmd-tests.el
+++ b/test/lisp/eshell/esh-cmd-tests.el
@@ -442,4 +442,20 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
(eshell-command-result-equal "unless {[ foo = bar ]} {echo no} {echo yes}"
"no"))
+
+;; Error handling
+
+(ert-deftest esh-cmd-test/throw ()
+ "Test that calling `throw' as an Eshell command unwinds everything properly."
+ (with-temp-eshell
+ (should (= (catch 'tag
+ (eshell-insert-command
+ "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)
+ ;; Make sure we can call another command after throwing.
+ (eshell-match-command-output "echo again" "\\`again\n")))
+
;; esh-cmd-tests.el ends here
diff --git a/test/lisp/eshell/esh-proc-tests.el
b/test/lisp/eshell/esh-proc-tests.el
index d58764ac29f..9118bcd1c61 100644
--- a/test/lisp/eshell/esh-proc-tests.el
+++ b/test/lisp/eshell/esh-proc-tests.el
@@ -174,23 +174,17 @@
pipeline."
(skip-unless (and (executable-find "sh")
(executable-find "cat")))
- ;; An `eshell-pipe-broken' signal might occur internally; let Eshell
- ;; handle it!
- (let ((debug-on-error nil))
- (eshell-command-result-equal
- (concat "echo hi | " esh-proc-test--detect-pty-cmd " | cat")
- nil)))
+ (eshell-command-result-equal
+ (concat "(ignore) | " esh-proc-test--detect-pty-cmd " | cat")
+ nil))
(ert-deftest esh-proc-test/pipeline-connection-type/last ()
"Test that only output streams are PTYs when a command ends a pipeline."
(skip-unless (executable-find "sh"))
- ;; An `eshell-pipe-broken' signal might occur internally; let Eshell
- ;; handle it!
- (let ((debug-on-error nil))
- (eshell-command-result-equal
- (concat "echo hi | " esh-proc-test--detect-pty-cmd)
- (unless (eq system-type 'windows-nt)
- "stdout\nstderr\n"))))
+ (eshell-command-result-equal
+ (concat "(ignore) | " esh-proc-test--detect-pty-cmd)
+ (unless (eq system-type 'windows-nt)
+ "stdout\nstderr\n")))
;; Synchronous processes
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 69d31a54644..0136e0abd5b 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -3441,12 +3441,12 @@ This tests also `file-directory-p' and
`file-accessible-directory-p'."
(rx-to-string
`(:
;; There might be a summary line.
- (? "total" (+ nonl) (+ digit) (? blank)
+ (? (* blank) "total" (+ nonl) (+ digit) (? blank)
(? (any "EGKMPTYZk")) (? "i") (? "B") "\n")
;; We don't know in which order ".", ".." and "foo" appear.
(= ,(length (directory-files tmp-name1))
(+ nonl) blank
- (regexp ,(regexp-opt (directory-files tmp-name1)))
+ (| . ,(directory-files tmp-name1))
(? " ->" (+ nonl)) "\n"))))))
;; Check error cases.
@@ -7399,13 +7399,13 @@ This requires restrictions of file name syntax."
;; of process output. So we unset it temporarily.
(setenv "PS1")
(with-temp-buffer
- (should (zerop (process-file "printenv" nil t nil)))
- (goto-char (point-min))
- (should
- (search-forward-regexp
- (rx
- bol (literal envvar)
- "=" (literal (getenv envvar)) eol))))))))
+ (when (zerop (process-file "printenv" nil t nil))
+ (goto-char (point-min))
+ (should
+ (search-forward-regexp
+ (rx
+ bol (literal envvar)
+ "=" (literal (getenv envvar)) eol)))))))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
@@ -7876,7 +7876,7 @@ process sentinels. They shall not disturb each other."
(ert-deftest tramp-test47-read-password ()
"Check Tramp password handling."
- :tags '(:expensive-test :unstable)
+ :tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-mock-p))
;; Not all read commands understand argument "-s" or "-p".
@@ -7886,7 +7886,7 @@ process sentinels. They shall not disturb each other."
(shell-command-to-string "read -s -p Password: pass"))))
(let ((pass "secret")
- (mock-entry (copy-sequence (assoc "mock" tramp-methods)))
+ (mock-entry (copy-tree (assoc "mock" tramp-methods)))
mocked-input tramp-methods)
;; We must mock `read-string', in order to avoid interactive
;; arguments.
@@ -7933,6 +7933,65 @@ process sentinels. They shall not disturb each other."
(let ((auth-sources `(,netrc-file)))
(should (file-exists-p ert-remote-temporary-file-directory)))))))))
+(ert-deftest tramp-test47-read-otp-password ()
+ "Check Tramp one-time password handling."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-mock-p))
+ ;; Not all read commands understand argument "-s" or "-p".
+ (skip-unless
+ (string-empty-p
+ (let ((shell-file-name "sh"))
+ (shell-command-to-string "read -s -p Password: pass"))))
+
+ (let ((pass "secret")
+ (mock-entry (copy-tree (assoc "mock" tramp-methods)))
+ mocked-input tramp-methods)
+ ;; We must mock `read-string', in order to avoid interactive
+ ;; arguments.
+ (cl-letf* (((symbol-function #'read-string)
+ (lambda (&rest _args) (pop mocked-input))))
+ (setcdr
+ (assq 'tramp-login-args mock-entry)
+ `((("-c")
+ (,(tramp-shell-quote-argument
+ (concat
+ "read -s -p 'Verification code: ' pass; echo; "
+ "(test \"pass$pass\" != \"pass" pass "\" && "
+ "echo \"Login incorrect\" || sh -i)"))))))
+ (setq tramp-methods `(,mock-entry))
+
+ ;; Reading password from stdin works.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ ;; We don't want to invalidate the password.
+ (setq mocked-input `(,(copy-sequence pass)))
+ (should (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; Don't entering a password returns in error.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input nil)
+ (should-error (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; A wrong password doesn't work either.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input `(,(concat pass pass)))
+ (should-error (file-exists-p ert-remote-temporary-file-directory))
+
+ ;; The password shouldn't be read from auth-source.
+ ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1.
+ (with-no-warnings (when (symbol-plist 'ert-with-temp-file)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (setq mocked-input nil)
+ (auth-source-forget-all-cached)
+ (ert-with-temp-file netrc-file
+ :prefix "tramp-test" :suffix ""
+ :text (format
+ "machine %s port mock password %s"
+ (file-remote-p ert-remote-temporary-file-directory 'host)
+ pass)
+ (let ((auth-sources `(,netrc-file)))
+ (should-error
+ (file-exists-p ert-remote-temporary-file-directory)))))))))
+
;; This test is inspired by Bug#29163.
(ert-deftest tramp-test48-auto-load ()
"Check that Tramp autoloads properly."
diff --git a/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl
b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl
new file mode 100644
index 00000000000..e3f96241ab7
--- /dev/null
+++ b/test/lisp/progmodes/cperl-mode-resources/cperl-bug-35925.pl
@@ -0,0 +1,36 @@
+# This resource file can be run with cperl--run-testcases from
+# cperl-tests.el and works with both perl-mode and cperl-mode.
+
+# -------- Bug#35925: input -------
+format FH =
+@### @.### @###
+42, 3.1415, 0
+.
+write FH;
+
+# -------- Bug#35925: expected output -------
+format FH =
+@### @.### @###
+42, 3.1415, 0
+.
+write FH;
+
+# -------- Bug#35925: end -------
+
+# -------- format not as top-level: input -------
+foo: {
+ format STDOUT =
+^<<<<
+$foo
+.
+write;
+}
+# -------- format not as top-level: expected output -------
+foo: {
+ format STDOUT =
+^<<<<
+$foo
+.
+ write;
+}
+# -------- format not as top-level: end -------
diff --git a/test/lisp/progmodes/cperl-mode-tests.el
b/test/lisp/progmodes/cperl-mode-tests.el
index 87d8ffa2d8d..a29ee54b6b9 100644
--- a/test/lisp/progmodes/cperl-mode-tests.el
+++ b/test/lisp/progmodes/cperl-mode-tests.el
@@ -25,6 +25,10 @@
;;; Commentary:
;; This is a collection of tests for CPerl-mode.
+;; The maintainer would like to use this test file with cperl-mode.el
+;; also in older Emacs versions (currently: Emacs 26.1): Please don't
+;; use Emacs features which are not available in that version (unless
+;; they're already used in existing tests).
;;; Code:
@@ -892,8 +896,8 @@ without a statement terminator on the same line does not
loop
forever. The test starts an asynchronous Emacs batch process
under timeout control."
:tags '(:expensive-test)
- (skip-when (getenv "EMACS_HYDRA_CI")) ; FIXME times out
- (skip-when (< emacs-major-version 28)) ; times out in older Emacsen
+ (skip-unless (not (getenv "EMACS_HYDRA_CI"))) ; FIXME times out
+ (skip-unless (not (< emacs-major-version 28))) ; times out in older Emacsen
(skip-unless (eq cperl-test-mode #'cperl-mode))
(let* ((emacs (concat invocation-directory invocation-name))
(test-function 'cperl-test--run-bug-10483)
@@ -1139,6 +1143,20 @@ Perl is not Lisp: An open paren in column 0 does not
start a function."
(cperl-indent-command)
(forward-line 1))))
+(ert-deftest cperl-test-bug-35925 ()
+ "Check that indentation is correct after a terminating format declaration."
+ (cperl-set-style "PBP") ; Make cperl-mode use the same settings as perl-mode.
+ (cperl--run-test-cases
+ (ert-resource-file "cperl-bug-35925.pl")
+ (let ((tab-function
+ (if (equal cperl-test-mode 'perl-mode)
+ #'indent-for-tab-command
+ #'cperl-indent-command)))
+ (goto-char (point-max))
+ (forward-line -2)
+ (funcall tab-function)))
+ (cperl-set-style-back))
+
(ert-deftest cperl-test-bug-37127 ()
"Verify that closing a paren in a regex goes without a message.
Also check that the message is issued if the regex terminator is
@@ -1242,7 +1260,7 @@ however, must not happen when the keyword occurs in a
variable
\"$else\" or \"$continue\"."
(skip-unless (eq cperl-test-mode #'cperl-mode))
;; `self-insert-command' takes a second argument only since Emacs 27
- (skip-when (< emacs-major-version 27))
+ (skip-unless (not (< emacs-major-version 27)))
(with-temp-buffer
(setq cperl-electric-keywords t)
(cperl-mode)
diff --git a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
index 1f855d3c977..fe09a37a32b 100644
--- a/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
+++ b/test/lisp/progmodes/elixir-ts-mode-resources/indent.erts
@@ -330,6 +330,22 @@ Name: Long tuple
"October", "November", "December"}
=-=-=
+Name: Doc
+
+=-=
+defmodule Foo do
+"""
+ bar
+ """
+end
+=-=
+defmodule Foo do
+ """
+ bar
+ """
+end
+=-=-=
+
Name: Embedded HEEx
=-=
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index f2bee713864..621e4dbe2c0 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -878,10 +878,37 @@ This evaluates the TESTS test cases from glibc."
(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).
(should (looking-at "x*=*"))
(should (looking-at "x*\\(=\\|:\\)"))
(should (looking-at "x*\\(=\\|:\\)*"))
- (should (looking-at "x*=*?"))))
+ (should (looking-at "x*=*?"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*\\|h\\)*?"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*\\|h\\)*"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*?\\|h\\)*"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*?\\|h\\)*?"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*\\|h\\)+?"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*\\|h\\)+"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*?\\|h\\)+"))
+ ;; relint suppression: Repetition of expression matching an empty string
+ (should (looking-at "x*\\(=*?\\|h\\)+?"))
+ (should (looking-at "x*\\(=+\\|h\\)+?"))
+ (should (looking-at "x*\\(=+\\|h\\)+"))
+ (should (looking-at "x*\\(=+?\\|h\\)+"))
+ (should (looking-at "x*\\(=+?\\|h\\)+?"))
+ ;; Regression check for overly optimistic optimization.
+ (should (eq 0 (string-match "\\(ca*\\|ab\\)+d" "cabd")))
+ (should (string-match "\\(aa*\\|b\\)*c" "ababc"))
+ (should (string-match " \\sw*\\bfoo" " foo"))
+ ))
(ert-deftest regexp-tests-zero-width-assertion-repetition ()
;; Check compatibility behaviour with repetition operators after
diff --git a/test/src/regex-resources/PTESTS b/test/src/regex-resources/PTESTS
index 68acc314d37..59dd4b3bc21 100644
--- a/test/src/regex-resources/PTESTS
+++ b/test/src/regex-resources/PTESTS
@@ -269,6 +269,7 @@
#W the expected result for \([a-c]*\)\{2,\} is failure which isn't correct
1¦3¦\([a-c]*\)\{2,\}¦abcdefg¦
1¦3¦\([a-c]*\)\{1,\}¦abcdefg¦
+0¦0¦\([a-c]*\)\{2,\}¦gabcdefg¦
-1¦-1¦a\{64,\}¦aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa¦
# GA142
1¦3¦a\{2,3\}¦aaaa¦