[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/positioned-lambdas ab7e5f9fac8 3/3: Merge branch 'master' into f
|
From: |
Alan Mackenzie |
|
Subject: |
feature/positioned-lambdas ab7e5f9fac8 3/3: Merge branch 'master' into feature/positioned-lambdas |
|
Date: |
Sun, 24 Mar 2024 12:03:23 -0400 (EDT) |
branch: feature/positioned-lambdas
commit ab7e5f9fac89fb41392750c052d761328f9aa4b3
Merge: 1de7a370d17 c5de73a95a6
Author: Alan Mackenzie <acm@muc.de>
Commit: Alan Mackenzie <acm@muc.de>
Merge branch 'master' into feature/positioned-lambdas
---
CONTRIBUTE | 2 +
admin/MAINTAINERS | 7 +-
admin/notes/bugtracker | 4 +-
build-aux/ndk-build-helper-1.mk | 2 +-
build-aux/ndk-build-helper-2.mk | 2 +-
configure.ac | 12 +-
cross/ndk-build/Makefile.in | 26 +-
cross/ndk-build/ndk-build.mk.in | 2 +
cross/ndk-build/ndk-resolve.mk | 32 +-
doc/emacs/android.texi | 14 +-
doc/emacs/files.texi | 8 +-
doc/emacs/help.texi | 7 +
doc/emacs/killing.texi | 28 +-
doc/emacs/misc.texi | 9 +
doc/emacs/rmail.texi | 5 +-
doc/lispref/buffers.texi | 6 +
doc/lispref/control.texi | 2 +-
doc/lispref/display.texi | 24 +
doc/lispref/frames.texi | 4 +-
doc/lispref/markers.texi | 8 +
doc/lispref/objects.texi | 27 +-
doc/lispref/os.texi | 1 +
doc/lispref/strings.texi | 2 +-
doc/lispref/windows.texi | 117 +-
doc/misc/calc.texi | 12 +-
doc/misc/dired-x.texi | 10 +
doc/misc/eww.texi | 21 +
doc/misc/modus-themes.org | 1435 ++++++++++----------
doc/misc/transient.texi | 28 +-
doc/misc/vtable.texi | 13 +-
etc/NEWS | 101 ++
etc/themes/modus-operandi-deuteranopia-theme.el | 77 +-
etc/themes/modus-operandi-theme.el | 75 +-
etc/themes/modus-operandi-tinted-theme.el | 84 +-
etc/themes/modus-operandi-tritanopia-theme.el | 77 +-
etc/themes/modus-themes.el | 545 ++++----
etc/themes/modus-vivendi-deuteranopia-theme.el | 78 +-
etc/themes/modus-vivendi-theme.el | 77 +-
etc/themes/modus-vivendi-tinted-theme.el | 96 +-
etc/themes/modus-vivendi-tritanopia-theme.el | 77 +-
exec/configure.ac | 8 +
exec/exec.c | 2 +-
exec/exec.h | 1 +
exec/trace.c | 151 +-
java/AndroidManifest.xml.in | 4 +-
java/INSTALL | 34 +-
java/org/gnu/emacs/EmacsDesktopNotification.java | 56 +-
java/org/gnu/emacs/EmacsNative.java | 16 +-
java/org/gnu/emacs/EmacsOpenActivity.java | 43 +-
java/org/gnu/emacs/EmacsService.java | 108 +-
java/org/gnu/emacs/EmacsWindow.java | 30 +-
.../gnu/emacs/EmacsWindowAttachmentManager.java | 9 +-
lisp/bind-key.el | 43 +-
lisp/calendar/calendar.el | 2 +-
lisp/calendar/todo-mode.el | 8 +-
lisp/comint.el | 2 +-
lisp/cus-edit.el | 7 +-
lisp/cus-start.el | 4 +
lisp/descr-text.el | 52 +-
lisp/dired-x.el | 26 +-
lisp/dnd.el | 15 +-
lisp/emacs-lisp/advice.el | 2 -
lisp/emacs-lisp/bindat.el | 4 +
lisp/emacs-lisp/byte-opt.el | 1 -
lisp/emacs-lisp/bytecomp.el | 15 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
lisp/emacs-lisp/cl-extra.el | 18 +-
lisp/emacs-lisp/cl-generic.el | 10 +-
lisp/emacs-lisp/cl-macs.el | 47 +-
lisp/emacs-lisp/cl-preloaded.el | 77 +-
lisp/emacs-lisp/cl-print.el | 2 +-
lisp/emacs-lisp/comp-cstr.el | 19 +-
lisp/emacs-lisp/comp-run.el | 21 +-
lisp/emacs-lisp/comp.el | 81 +-
lisp/emacs-lisp/debug.el | 25 +-
lisp/emacs-lisp/edebug.el | 155 ++-
lisp/emacs-lisp/eieio-core.el | 2 +-
lisp/emacs-lisp/eieio-opt.el | 2 +-
lisp/emacs-lisp/nadvice.el | 2 +-
lisp/emacs-lisp/oclosure.el | 2 +-
lisp/emacs-lisp/package.el | 2 +-
lisp/emacs-lisp/pp.el | 34 +-
lisp/emacs-lisp/re-builder.el | 2 +-
lisp/emacs-lisp/seq.el | 3 +-
lisp/emacs-lisp/shortdoc.el | 2 +-
lisp/emacs-lisp/vtable.el | 59 +-
lisp/erc/erc-dcc.el | 2 +-
lisp/erc/erc-desktop-notifications.el | 24 +-
lisp/erc/erc-goodies.el | 58 +-
lisp/erc/erc-stamp.el | 1 +
lisp/erc/erc.el | 58 +-
lisp/eshell/em-unix.el | 2 +-
lisp/ffap.el | 3 +
lisp/files.el | 231 ++--
lisp/format-spec.el | 6 +-
lisp/gnus/gnus-group.el | 2 +-
lisp/gnus/gnus-notifications.el | 46 +-
lisp/help-fns.el | 106 +-
lisp/help-macro.el | 275 ++--
lisp/help-mode.el | 8 +
lisp/help.el | 48 +-
lisp/image-mode.el | 5 +-
lisp/image.el | 221 ++-
lisp/international/mule-cmds.el | 7 +-
lisp/jsonrpc.el | 28 +-
lisp/keymap.el | 2 +-
lisp/menu-bar.el | 5 +-
lisp/minibuffer.el | 24 +-
lisp/mouse.el | 7 +
lisp/net/eww.el | 164 ++-
lisp/net/shr.el | 15 +-
lisp/net/sieve.el | 2 +-
lisp/net/tramp-cmds.el | 2 +-
lisp/obsolete/quickurl.el | 2 +-
lisp/org/ob-calc.el | 2 +-
lisp/org/org-agenda.el | 2 +-
lisp/pcomplete.el | 2 +-
lisp/profiler.el | 74 +-
lisp/progmodes/bug-reference.el | 2 +-
lisp/progmodes/c-ts-common.el | 2 +-
lisp/progmodes/c-ts-mode.el | 71 +-
lisp/progmodes/csharp-mode.el | 7 +-
lisp/progmodes/eglot.el | 5 +-
lisp/progmodes/idlw-help.el | 2 +-
lisp/progmodes/lua-ts-mode.el | 13 +-
lisp/progmodes/project.el | 14 +-
lisp/progmodes/python.el | 29 +-
lisp/progmodes/verilog-mode.el | 2 +-
lisp/replace.el | 2 +-
lisp/simple.el | 19 +-
lisp/sqlite.el | 7 +-
lisp/subr.el | 17 +-
lisp/tab-bar.el | 54 +-
lisp/term.el | 13 +-
lisp/term/android-win.el | 126 +-
lisp/textmodes/bibtex.el | 2 +-
lisp/textmodes/flyspell.el | 31 +-
lisp/thingatpt.el | 17 +-
lisp/time.el | 2 +-
lisp/transient.el | 299 ++--
lisp/treesit.el | 21 +-
lisp/url/url-cache.el | 2 +-
lisp/vc/diff-mode.el | 2 +
lisp/vc/vc-cvs.el | 4 +-
lisp/vc/vc-git.el | 46 +-
lisp/vc/vc-rcs.el | 2 +-
lisp/vc/vc-svn.el | 4 +-
lisp/wid-browse.el | 34 +-
lisp/wid-edit.el | 482 +++----
lisp/window.el | 57 +-
m4/ndk-build.m4 | 354 +++--
src/androidselect.c | 86 +-
src/androidterm.c | 81 +-
src/androidterm.h | 5 +-
src/androidvfs.c | 284 +++-
src/bidi.c | 13 +
src/buffer.c | 26 +-
src/buffer.h | 3 +
src/coding.c | 36 +-
src/comp.c | 45 +-
src/data.c | 40 +-
src/dispextern.h | 1 +
src/emacs.c | 1 +
src/eval.c | 4 +-
src/fileio.c | 2 +-
src/lisp.h | 6 +-
src/lread.c | 6 +-
src/minibuf.c | 30 +-
src/nsterm.m | 25 +-
src/pdumper.c | 3 +-
src/puresize.h | 2 +-
src/sfntfont-android.c | 2 +-
src/sqlite.c | 17 +-
src/w32.c | 5 +
src/w32console.c | 25 +-
src/w32fns.c | 99 +-
src/w32term.h | 3 +-
src/w32xfns.c | 28 +-
src/window.c | 157 ++-
src/xdisp.c | 20 +-
src/xterm.c | 55 +-
src/xwidget.c | 10 +-
test/lisp/calendar/icalendar-tests.el | 2 +-
test/lisp/emacs-lisp/comp-cstr-tests.el | 5 +-
test/lisp/emacs-lisp/pp-tests.el | 30 +
test/lisp/erc/erc-dcc-tests.el | 6 +-
test/lisp/erc/erc-goodies-tests.el | 127 +-
test/lisp/erc/erc-networks-tests.el | 2 +-
test/lisp/erc/erc-scenarios-services-misc.el | 2 +-
test/lisp/erc/erc-stamp-tests.el | 16 +-
test/lisp/erc/erc-tests.el | 2 +-
.../resources/fill/snapshots/merge-01-start.eld | 2 +-
.../resources/fill/snapshots/merge-02-right.eld | 2 +-
.../erc/resources/fill/snapshots/merge-wrap-01.eld | 2 +-
.../snapshots/merge-wrap-indicator-post-01.eld | 2 +-
.../fill/snapshots/merge-wrap-indicator-pre-01.eld | 2 +-
.../fill/snapshots/monospace-01-start.eld | 2 +-
.../fill/snapshots/monospace-02-right.eld | 2 +-
.../resources/fill/snapshots/monospace-03-left.eld | 2 +-
.../fill/snapshots/monospace-04-reset.eld | 2 +-
.../resources/fill/snapshots/spacing-01-mono.eld | 2 +-
test/lisp/help-fns-tests.el | 10 +-
test/lisp/image-tests.el | 144 ++
test/lisp/net/eww-tests.el | 69 +-
test/lisp/net/shr-resources/blockquote.html | 2 +
test/lisp/net/shr-resources/blockquote.txt | 3 +
test/lisp/net/shr-tests.el | 72 +-
.../progmodes/csharp-mode-resources/indent.erts | 19 +
test/lisp/progmodes/csharp-mode-tests.el | 30 +
test/lisp/progmodes/python-tests.el | 31 +-
test/lisp/sqlite-tests.el | 51 +
test/lisp/vc/vc-git-tests.el | 47 +
test/src/comp-resources/comp-test-funcs.el | 3 +
test/src/data-tests.el | 35 +
test/src/emacs-module-tests.el | 2 +-
215 files changed, 6213 insertions(+), 3182 deletions(-)
diff --git a/CONTRIBUTE b/CONTRIBUTE
index bdee16eeab4..7c5c07771eb 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -237,6 +237,8 @@ formatting them:
particular, gnu.org and fsf.org URLs should start with "https:".
- Commit messages should contain only printable UTF-8 characters.
+ However, we ask that non-ASCII characters be used only if strictly
+ necessary, not just for aesthetic purposes.
- Commit messages should not contain the "Signed-off-by:" lines that
are used in some other projects.
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index f59c684e81f..4fa65a8df24 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -360,6 +360,9 @@ Po Lu
X11 and GTK xwidget support in src/xwidget.c
Precision pixel scrolling in lisp/pixel-scroll.el
+Daniel Pettersson
+ lisp/jsonrpc.el
+
==============================================================================
3. Externally maintained packages.
==============================================================================
@@ -378,9 +381,7 @@ Tramp
Modus themes
Maintainer: Protesilaos Stavrou
- Repository: https://git.sr.ht/~protesilaos
- Mailing list: https://lists.sr.ht/~protesilaos/modus-themes
- Bug Reports: M-x modus-themes-report-bug
+ Repository: https://github.com/protesilaos/modus-themes
doc/misc/modus-themes.org
etc/themes/modus*.el
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index b47061884d6..419d91ae854 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -430,8 +430,8 @@ reassign 123 spam
*** To change the title of a bug:
retitle 123 Some New Title
-*** To change the submitter address:
-submitter 123 none@example.com
+*** To change the submitter name and address:
+submitter 123 J. Hacker <none@example.com>
Note that it does not seem to work to specify "Submitter:" in the
pseudo-header when first reporting a bug.
diff --git a/build-aux/ndk-build-helper-1.mk b/build-aux/ndk-build-helper-1.mk
index 5681728154c..490064b6e32 100644
--- a/build-aux/ndk-build-helper-1.mk
+++ b/build-aux/ndk-build-helper-1.mk
@@ -94,7 +94,7 @@ endef
# dependencies can be ignored while building a shared library, as they
# will be linked in to the resulting shared object file later.
-SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog android
libandroid
+SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport libstlport
gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES),
$(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_SHARED_LIBRARIES)
$(LOCAL_STATIC_LIBRARIES) $(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call
add-includes,$(module))))
diff --git a/build-aux/ndk-build-helper-2.mk b/build-aux/ndk-build-helper-2.mk
index 1c2409cfd57..e696fcbdade 100644
--- a/build-aux/ndk-build-helper-2.mk
+++ b/build-aux/ndk-build-helper-2.mk
@@ -87,7 +87,7 @@ endef
# Resolve additional dependencies based on LOCAL_STATIC_LIBRARIES and
# LOCAL_SHARED_LIBRARIES.
-SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ log liblog android
libandroid
+SYSTEM_LIBRARIES = z libz libc c libdl dl libstdc++ stdc++ stlport libstlport
gnustl libgnustl c++ libc++ log liblog android libandroid
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES), $(LOCAL_STATIC_LIBRARIES)
$(LOCAL_WHOLE_STATIC_LIBRARIES)),$(eval $(call add-a-name,$(module))))
$(foreach module,$(filter-out $(SYSTEM_LIBRARIES),
$(LOCAL_SHARED_LIBRARIES)),$(eval $(call add-so-name,$(module))))
diff --git a/configure.ac b/configure.ac
index 452aa0838f1..bd678ea52a3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -171,7 +171,6 @@ AS_IF([test "$XCONFIGURE" = "android"],[
# Make sure to pass through the CFLAGS, as older versions of the
# NDK require them to be able to find system includes.
with_ndk_path="$android_ndk_path"
- with_ndk_cxx_shared="$android_ndk_cxx_shared"
with_ndk_cxx="$android_ndk_cxx"
ndk_INIT([$android_abi], [$ANDROID_SDK], [cross/ndk-build],
[$ANDROID_CFLAGS])
@@ -1233,7 +1232,7 @@ package will likely install on older systems but crash on
startup.])
passthrough="$passthrough --with-harfbuzz=$with_harfbuzz"
passthrough="$passthrough --with-threads=$with_threads"
- # Now pass through some checking options.
+ # Now pass through some checking-related options.
emacs_val="--enable-check-lisp-object-type=$enable_check_lisp_object_type"
passthrough="$passthrough $emacs_val"
@@ -1243,7 +1242,6 @@ package will likely install on older systems but crash on
startup.])
AS_IF([XCONFIGURE=android ANDROID_CC="$ANDROID_CC" \
ANDROID_SDK="$android_sdk" android_abi=$android_abi \
android_ndk_path="$with_ndk_path" \
- android_ndk_cxx_shared="$with_ndk_cxx_shared" \
android_ndk_cxx="$android_ndk_cxx" \
$CONFIG_SHELL $0 $passthrough], [],
[AC_MSG_ERROR([Failed to cross-configure Emacs for android.])])
@@ -1570,7 +1568,13 @@ AC_DEFUN_ONCE([gl_STDLIB_H],
# Initialize gnulib right after choosing the compiler.
dnl Amongst other things, this sets AR and ARFLAGS.
gl_EARLY
-ndk_LATE
+
+# ndk_LATE must be enclosed in this conditional to prevent the
+# AC_PROG_CXX it indirectly requires from being expanded at top level.
+if test "$ndk_INITIALIZED" = "yes"; then
+ ndk_LATE_EARLY
+ ndk_LATE
+fi
if test "$ac_test_CFLAGS" != set; then
# It's helpful to have C macros available to GDB, so prefer -g3 to -g
diff --git a/cross/ndk-build/Makefile.in b/cross/ndk-build/Makefile.in
index 8ba2d356f27..0970a765b45 100644
--- a/cross/ndk-build/Makefile.in
+++ b/cross/ndk-build/Makefile.in
@@ -24,15 +24,17 @@
srcdir = @srcdir@
# This is a list of Android.mk files which provide targets.
-NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
- NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
- NDK_BUILD_ABI = @NDK_BUILD_ABI@
- NDK_BUILD_SDK = @NDK_BUILD_SDK@
- NDK_BUILD_CC = @NDK_BUILD_CC@
- NDK_BUILD_CXX = @NDK_BUILD_CXX@
- NDK_BUILD_AR = @NDK_BUILD_AR@
- NDK_BUILD_NASM = @NDK_BUILD_NASM@
- NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
+ NDK_BUILD_ANDROID_MK = @NDK_BUILD_ANDROID_MK@
+ NDK_BUILD_ARCH = @NDK_BUILD_ARCH@
+ NDK_BUILD_ABI = @NDK_BUILD_ABI@
+ NDK_BUILD_SDK = @NDK_BUILD_SDK@
+ NDK_BUILD_CC = @NDK_BUILD_CC@
+ NDK_BUILD_CXX = @NDK_BUILD_CXX@
+ NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
+NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
+ NDK_BUILD_AR = @NDK_BUILD_AR@
+ NDK_BUILD_NASM = @NDK_BUILD_NASM@
+ NDK_BUILD_CFLAGS = @NDK_BUILD_CFLAGS@
# This is a list of targets to build.
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
@@ -58,8 +60,10 @@ NDK_BUILD_ANDROID_MK := $(call
uniqify,$(NDK_BUILD_ANDROID_MK))
NDK_BUILD_MODULES := $(call uniqify,$(NDK_BUILD_MODULES))
# Define CFLAGS for compiling C++ code; this involves removing all
-# -std=NNN options.
-NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS))
+# -std=NNN options and inserting compilation options for the C++
+# library.
+NDK_BUILD_CFLAGS_CXX := $(filter-out -std=%,$(NDK_BUILD_CFLAGS)) \
+ $(NDK_BUILD_CXX_STL)
define subr-1
diff --git a/cross/ndk-build/ndk-build.mk.in b/cross/ndk-build/ndk-build.mk.in
index 6c85ff5044e..ea1be5af6f1 100644
--- a/cross/ndk-build/ndk-build.mk.in
+++ b/cross/ndk-build/ndk-build.mk.in
@@ -22,6 +22,8 @@
NDK_BUILD_MODULES = @NDK_BUILD_MODULES@
NDK_BUILD_CXX_SHARED = @NDK_BUILD_CXX_SHARED@
+NDK_BUILD_CXX_STL = @NDK_BUILD_CXX_STL@
+NDK_BUILD_CXX_LDFLAGS = @NDK_BUILD_CXX_LDFLAGS@
NDK_BUILD_ANY_CXX_MODULE = @NDK_BUILD_ANY_CXX_MODULE@
NDK_BUILD_SHARED =
NDK_BUILD_STATIC =
diff --git a/cross/ndk-build/ndk-resolve.mk b/cross/ndk-build/ndk-resolve.mk
index d3b398bca62..4d8ecf8667a 100644
--- a/cross/ndk-build/ndk-resolve.mk
+++ b/cross/ndk-build/ndk-resolve.mk
@@ -20,7 +20,7 @@
# which actually builds targets.
# List of system libraries to ignore.
-NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ log liblog
android libandroid
+NDK_SYSTEM_LIBRARIES = z libz libc c libdl dl stdc++ libstdc++ stlport
libstlport gnustl libgnustl c++ libc++ log liblog android libandroid
# Save information.
NDK_LOCAL_PATH_$(LOCAL_MODULE) := $(LOCAL_PATH)
@@ -90,11 +90,35 @@ endif
# Likewise for libstdc++.
ifeq ($(strip $(1)),libstdc++)
-NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
-ifeq ($(strip $(1)),dl)
-NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += -lstdc++
+ifeq ($(strip $(1)),stdc++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libstlport)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),stlport)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libgnustl)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),gnustl)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),libc++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
+endif
+
+ifeq ($(strip $(1)),c++)
+NDK_SO_EXTRA_FLAGS_$(LOCAL_MODULE) += $(NDK_BUILD_CXX_LDFLAGS)
endif
# Likewise for liblog.
diff --git a/doc/emacs/android.texi b/doc/emacs/android.texi
index a45ec84f3f0..b367515cb35 100644
--- a/doc/emacs/android.texi
+++ b/doc/emacs/android.texi
@@ -143,11 +143,13 @@ that if that Emacs in turn does not start the Emacs
server, subsequent
attempts to open the file with the wrapper will fail.
@cindex /content/by-authority directory, android
+@cindex /content/by-authority-named directory, android
Some files are given to Emacs as ``content identifiers'' that the
system provides access to outside the normal filesystem APIs. Emacs
-uses a pseudo-directory named @file{/content/by-authority} to access
-those files. Do not make any assumptions about the contents of this
-directory, or try to open files in it yourself.
+uses pseudo-directories named @file{/content/by-authority} and
+@file{/content/by-authority-named} to access those files. Do not make
+any assumptions about the contents of this directory, or try to open
+files in it yourself.
This feature is not provided on Android 4.3 and earlier, in which
case such files are copied to a temporary directory before being
@@ -862,6 +864,12 @@ behalf of a specific frame, Emacs deletes the frame
displayed within
that window.
@end itemize
+ When the system predates Android 5.0, the window manager will not
+accept more than one user-created Emacs window. If frame creation gives
+rise to windows in excess of this limit, the window manager will
+arbitrarily select one of their number to display, with the rest
+remaining invisible until that window is destroyed with its frame.
+
@cindex windowing limitations, android
@cindex frame parameters, android
Emacs only supports a limited subset of GUI features on Android; the
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index b152b7943a2..ccdeef414e2 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -779,6 +779,12 @@ operations typically break hard links, disconnecting the
file name you
visited from any alternate names for the same file. This has nothing
to do with Emacs---the version control system does it.
+ Some file storage services support @dfn{file versioning}: they
+record history of previous versions of files, and allow reverting to
+those previous versions. If you want to be able to do that with files
+hosted by those services when editing them with Emacs, customize
+@code{backup-by-copying} to a non-@code{nil} value.
+
@node Customize Save
@subsection Customizing Saving of Files
@@ -2392,7 +2398,7 @@ multiply the size by the factor of @w{@code{1 + @var{n} /
10}}, so
@findex image-decrease-size
@kindex i - (Image mode)
@item i -
-Decrease the image size (@code{image-increase-size}) by 20%. Prefix
+Decrease the image size (@code{image-decrease-size}) by 20%. Prefix
numeric argument controls the decrement; the value of @var{n} means to
multiply the size by the factor of @w{@code{1 - @var{n} / 10}}, so
@w{@kbd{C-u 3 i -}} means to decrease the size by 30%.
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 05457a3f34f..d60310456ff 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -310,6 +310,13 @@ name is defined as a Lisp function. Type @kbd{C-g} to
cancel the
@kbd{C-h f} command if you don't really want to view the
documentation.
+ The function's documentation displayed by @code{describe-function}
+includes more than just the documentation string and the signature of
+the function. It also shows auxiliary information such as its type, the
+file where it was defined, whether it has been declared obsolete, and
+yet further information is often reachable by clicking or typing
+@key{RET} on emphasized parts of the text.
+
@vindex help-enable-symbol-autoload
If you request help for an autoloaded function whose @code{autoload}
form (@pxref{Autoload,,, elisp, The Emacs Lisp Reference Manual})
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 9717c02f782..57adc037cb7 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -91,9 +91,11 @@ Delete the next character (@code{delete-char}).
@item M-\
Delete spaces and tabs around point (@code{delete-horizontal-space}).
+@item M-x just-one-space
+Delete spaces and tabs around point, leaving one space.
@item M-@key{SPC}
-Delete spaces and tabs around point, leaving one space
-(@code{just-one-space}).
+Delete spaces and tabs around point in flexible ways
+(@code{cycle-spacing}).
@item C-x C-o
Delete blank lines around the current line (@code{delete-blank-lines}).
@item M-^
@@ -118,12 +120,13 @@ characters before and after point. With a prefix
argument, this only
deletes spaces and tab characters before point.
@findex just-one-space
-@code{just-one-space} does likewise but leaves a single space before
-point, regardless of the number of spaces that existed previously
-(even if there were none before). With a numeric argument @var{n}, it
-leaves @var{n} spaces before point if @var{n} is positive; if @var{n}
-is negative, it deletes newlines in addition to spaces and tabs,
-leaving @minus{}@var{n} spaces before point.
+@kbd{M-x just-one-space} deletes tabs and spaces around point, but
+leaves a single space before point, regardless of the number of spaces
+that existed previously (even if there were none before). With a
+numeric argument @var{n}, it leaves @var{n} spaces before point if
+@var{n} is positive; if @var{n} is negative, it deletes newlines in
+addition to spaces and tabs, leaving @minus{}@var{n} spaces before
+point.
@kindex M-SPC
@findex cycle-spacing
@@ -131,7 +134,14 @@ leaving @minus{}@var{n} spaces before point.
The command @code{cycle-spacing} (@kbd{M-@key{SPC}}) acts like a more
flexible version of @code{just-one-space}. It performs different
space cleanup actions defined by @code{cycle-spacing-actions}, in a
-cyclic manner, if you call it repeatedly in succession.
+cyclic manner, if you call it repeatedly in succession. By default,
+the first invocation does the same as @code{just-one-space}, the
+second deletes all whitespace characters around point like
+@code{delete-horizontal-space}, and the third restores the original
+whitespace characters; then it cycles. If invoked with a prefix
+argument, each action is given that value of the argument. The user
+option @code{cycle-spacing-actions} can include other members; see the
+doc string of that option for the details.
@kbd{C-x C-o} (@code{delete-blank-lines}) deletes all blank lines
after the current line. If the current line is blank, it deletes all
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 7eb28f56826..8f9ee317080 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -3009,6 +3009,15 @@ buffer, and lets you navigate to those pages by hitting
@kbd{RET}.
It is bound to @kbd{H}.
+@vindex xwidget-webkit-disable-javascript
+@cindex disabling javascript in webkit buffers
+ JavaScript is enabled by default inside WebKit buffers, which could be
+undesirable, as Web sites often use it to track your online activity.
+You can disable JavaScript in WebKit buffers by customizing the variable
+@code{xwidget-webkit-disable-javascript} to a non-@code{nil} value.
+You must kill all WebKit buffers for this setting to take effect, after
+it is changed.
+
@node Browse-URL
@subsection Following URLs
@cindex World Wide Web
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 51bd6086ce0..f94708b08ac 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -875,7 +875,10 @@ already composing, or to alter a message you have sent.
If you set the variable @code{rmail-mail-new-frame} to a
non-@code{nil} value, then all the Rmail commands to start sending a
message create a new frame to edit it in. This frame is deleted when
-you send the message.
+you send the message (but not if it is the only visible frame on the
+current display, or if it's a text-mode frame). If this frame cannot
+be deleted when you send the message, Emacs will try to reuse it for
+composing subsequent messages.
@ignore
@c FIXME does not work with Message -> Kill Message
, or when you use the @samp{Cancel} item in the @samp{Mail} menu.
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 77f5f09c7bd..5375eb64155 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -371,6 +371,12 @@ See the related function @code{generate-new-buffer} in
@ref{Creating
Buffers}.
@end defun
+@defun buffer-last-name &optional buffer
+This function returns the previous name of @var{buffer}, before it was
+killed or before the last time it was renamed. If nil or omitted,
+@var{buffer} defaults to the current buffer.
+@end defun
+
@node Buffer File Name
@section Buffer File Name
@cindex visited file
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 78ad5b68a51..f9f3389c398 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -323,7 +323,7 @@ described below.
@defmac if-let spec then-form else-forms...
Evaluate each binding in @var{spec} in turn, like in @code{let*}
-(@pxref{Local Variables}, stopping if a binding value is @code{nil}.
+(@pxref{Local Variables}), stopping if a binding value is @code{nil}.
If all are non-@code{nil}, return the value of @var{then-form},
otherwise the last form in @var{else-forms}.
@end defmac
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index beca470d68a..b497967c445 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -6056,6 +6056,30 @@ to make things match up, you should either specify
@code{:scale 1.0}
when creating the image, or use the result of
@code{image-compute-scaling-factor} to compute the elements of the
map.
+
+When an image's @code{:scale}, @code{:rotation}, or @code{:flip} is
+changed, @code{:map} will be recomputed based on the value of
+@code{:original-map} and the values of those transformation.
+
+@item :original-map @var{original-map}
+@cindex original image map
+This specifies the untransformed image map which will be used to
+recompute @code{:map} after the image's @code{:scale}, @code{:rotation},
+or @code{:flip} is changed.
+
+If @code{:original-map} is not specified when creating an image with
+@code{create-image}, it will be computed based on the supplied
+@code{:map}, as well as any of @code{:scale}, @code{:rotation}, or
+@code{:flip} which are non-nil.
+
+Conversely, if @code{:original-map} is specified but @code{:map} is not,
+@code{:map} will be computed based on @code{:original-map},
+@code{:scale}, @code{:rotation}, and @code{:flip}.
+
+@defopt image-recompute-map-p
+Set this user option to nil to prevent Emacs from automatically
+recomputing an image @code{:map} based on its @code{:original-map}.
+@end defopt
@end table
@defun image-mask-p spec &optional frame
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 16c0432da3a..cf7fc7721c5 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4052,8 +4052,8 @@ programs. It takes two optional arguments, @var{type} and
The @var{data-type} argument specifies the form of data conversion to
use, to convert the raw data obtained from another program into Lisp
-data. @xref{X Selections}, for an enumeration of data types valid
-under X, and @xref{Other Selections} for those elsewhere.
+data. @xref{X Selections}, for an enumeration of data types valid under
+X, and @pxref{Other Selections} for those elsewhere.
@end defun
@defopt selection-coding-system
diff --git a/doc/lispref/markers.texi b/doc/lispref/markers.texi
index 3037790692c..a13edb02ae6 100644
--- a/doc/lispref/markers.texi
+++ b/doc/lispref/markers.texi
@@ -283,6 +283,14 @@ This function returns the position that @var{marker}
points to, or
@code{nil} if it points nowhere.
@end defun
+@defun marker-last-position marker
+This function returns the last known position of @var{marker} in its
+buffer. It behaves like @code{marker-position} with one exception: if
+the buffer of @var{marker} has been killed, it returns the last position
+of @var{marker} in that buffer before the buffer was killed, instead of
+returning @code{nil}.
+@end defun
+
@defun marker-buffer marker
This function returns the buffer that @var{marker} points into, or
@code{nil} if it points nowhere.
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 279f449a994..aa1e073042f 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -1485,8 +1485,8 @@ types that are not built into Emacs.
@subsection Type Descriptors
A @dfn{type descriptor} is a @code{record} which holds information
-about a type. Slot 1 in the record must be a symbol naming the type, and
-@code{type-of} relies on this to return the type of @code{record}
+about a type. The first slot in the record must be a symbol naming the type,
+and @code{type-of} relies on this to return the type of @code{record}
objects. No other type descriptor slot is used by Emacs; they are
free for use by Lisp extensions.
@@ -2175,7 +2175,7 @@ with references to further information.
function @code{type-of}. Recall that each object belongs to one and
only one primitive type; @code{type-of} tells you which one (@pxref{Lisp
Data Types}). But @code{type-of} knows nothing about non-primitive
-types. In most cases, it is more convenient to use type predicates than
+types. In most cases, it is preferable to use type predicates than
@code{type-of}.
@defun type-of object
@@ -2207,6 +2207,27 @@ slot is returned; @ref{Records}.
@end example
@end defun
+@defun cl-type-of object
+This function returns a symbol naming @emph{the} type of
+@var{object}. It usually behaves like @code{type-of}, except
+that it guarantees to return the most precise type possible, which also
+implies that the specific type it returns may change depending on the
+Emacs version. For this reason, as a rule you should never compare its
+return value against some fixed set of types.
+
+@example
+(cl-type-of 1)
+ @result{} fixnum
+@group
+(cl-type-of 'nil)
+ @result{} null
+(cl-type-of (record 'foo))
+ @result{} foo
+@end group
+@end example
+@end defun
+
+
@node Equality Predicates
@section Equality Predicates
@cindex equality
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 435886320fd..3ba3da459bf 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -3244,6 +3244,7 @@ of parameters analogous to its namesake in
@item :on-action @var{on-action}
@item :on-cancel @var{on-close}
@item :actions @var{actions}
+@item :timeout @var{timeout}
@item :resident @var{resident}
These have the same meaning as they do when used in calls to
@code{notifications-notify}, except that no more than three non-default
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 4fe94f78cba..a2285098aad 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -1369,7 +1369,7 @@ given width and precision, if specified.
@item >
This flag causes the substitution to be truncated on the right to the
-given width, if specified.
+given width and precision, if specified.
@item ^
This flag converts the substituted text to upper case (@pxref{Case
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index fe3dc573df5..eef05d94fdb 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -6264,15 +6264,10 @@ this function does is to restore the value of the
variable
@code{minibuffer-selected-window}. In this case, the function returns
@code{nil}. Otherwise, it returns @code{t}.
-If the buffer of a window of @var{configuration} has been killed since
-@var{configuration} was made, that window is, as a rule, removed from
-the restored configuration. However, if that window is the last window
-remaining in the restored configuration, another live buffer is shown in
-it. Also, if the variable @var{window-kept-windows-functions} is
-non-@code{nil}, any window whose buffer is now dead is not deleted.
-Rather, this function will show another live buffer in that window and
-include an entry for that window when calling any function in
-@var{window-kept-windows-functions} (@pxref{Window Hooks}).
+This function consults the variable
+@code{window-restore-killed-buffer-windows} (see below) when it tries to
+restore a window whose buffer was killed after @var{configuration} was
+recorded.
Here is a way of using this function to get the same effect as
@code{save-window-excursion}:
@@ -6361,14 +6356,9 @@ a live window, it is replaced by a new live window
created on the same
frame before putting @var{state} into it. If @var{window} is @code{nil},
it puts the window state into a new window.
-If the buffer of any window recorded in @var{state} has been killed
-since @var{state} was made, that window is, as a rule, not restored.
-However, if that window is the only window in @var{state}, another live
-buffer will be shown in it. Also, if the variable
-@var{window-kept-windows-functions} is non-@code{nil}, any window whose
-buffer is now dead is restored. This function will show another live
-buffer in it and include an entry for that window when calling a
-function in @var{window-kept-windows-functions} (@pxref{Window Hooks}).
+This function consults the variable
+@code{window-restore-killed-buffer-windows} (see below) when it tries to
+restore a window whose buffer was killed after @var{state} was recorded.
If the optional argument @var{ignore} is non-@code{nil}, it means to ignore
minimum window sizes and fixed-size restrictions. If @var{ignore}
@@ -6376,6 +6366,78 @@ is @code{safe}, this means windows can get as small as
one line
and/or two columns.
@end defun
+By default, @code{set-window-configuration} and @code{window-state-put}
+may delete a window from the restored configuration when they find out
+that its buffer was killed since the corresponding configuration or
+state has been recorded. The variable described next can be used to
+fine-tune that behavior.
+
+@cindex restoring windows whose buffers have been killed
+@defvar window-restore-killed-buffer-windows
+This variable specifies how @code{set-window-configuration} and
+@code{window-state-put} shall handle a window whose buffer has been
+killed since the corresponding configuration or state was recorded. Any
+such window may be live---in which case it shows some other buffer---or
+dead at the time one of these functions is called. Usually,
+@code{set-window-configuration} leaves the window alone if it is live
+while @code{window-state-put} deletes it.
+
+The following values can be used to override the default behavior for
+dead windows in the case of @code{set-window-configuration} and for dead
+and live windows in the case of @code{window-state-put}.
+
+@table @asis
+@item @code{t}
+This value means to unconditionally restore the window and show some
+other buffer in it.
+
+@item @code{delete}
+This means to unconditionally try to delete the window.
+
+@item @code{dedicated}
+This means to try to delete the window if and only if it is dedicated to
+its buffer.
+
+@item @code{nil}
+This is the default, and it means that @code{set-window-configuration}
+will try to delete the window if and only if it is dedicated to its
+buffer, and @code{window-state-put} will unconditionally try to delete
+it.
+
+@item a function
+This means to restore the window and show some other buffer in it, like
+if the value is @code{t}, and also add an entry for that window to a
+list that will be later passed as the second argument to that function.
+@end table
+
+If a window cannot be deleted (typically, because it is the last window
+on its frame), @code{set-window-configuration} and
+@code{window-state-put} will show another buffer in it.
+
+If the value of this variable is a function, that function should take
+three arguments. The first argument specifies the frame whose windows
+have been restored. The third argument is either the symbol
+@code{configuration} if the windows are restored by
+@code{set-window-configuration}, or the symbol @code{state} if the
+windows are restored by @code{window-state-put}.
+
+The second argument specifies a list of entries for @emph{all} windows
+whose previous buffers have been found dead at the time
+@code{set-window-configuration} or @code{window-state-put} tried to
+restore them (minibuffer windows are excluded). This means that the
+function may also delete windows which were found live by
+@code{set-window-configuration}.
+
+Each entry in the list that is passed as the second argument to the
+function is itself a list of six values: the window whose buffer was
+found dead, the dead buffer or its name, the positions of window-start
+(@pxref{Window Start and End}) and window-point (@pxref{Window Point})
+of the buffer in that window, the dedicated state of the window as
+previously reported by @code{window-dedicated-p} and a flag that is
+@code{t} if the window has been found to be alive by
+@code{set-window-configuration} and @code{nil} otherwise.
+@end defvar
+
The functions @code{window-state-get} and @code{window-state-put} also
allow exchanging the contents of two live windows. The following
function does precisely that:
@@ -6636,27 +6698,6 @@ Lock fontification function, which will be called
whenever parts of a
buffer are (re)fontified because a window was scrolled or its size
changed. @xref{Other Font Lock Variables}.
-@cindex window kept windows functions
-@defvar window-kept-windows-functions
- This variable holds a list of functions that Emacs will call after
-restoring a window configuration via @code{set-window-configuration} or
-state via @code{window-state-put} (@pxref{Window Configurations}). When
-the value of this variable is non-@code{nil}, these functions will not
-delete any window whose buffer has been killed since the corresponding
-configuration or state was saved, but show some live buffer in it.
-
-The value should be a list of functions that take two arguments. The
-first argument specifies the frame whose windows have been restored.
-The second argument specifies a list of entries for each window whose
-buffer has been found dead at the time @code{set-window-configuration}
-or @code{window-state-put} tried to restore it. Each entry is a list of
-four values - the window whose buffer was found dead, the dead buffer,
-and the last known positions of start and point of the buffer in that
-window. Any function run by this hook should check that the window is
-live since another function run by this hook may have deleted it in the
-meantime.
-@end defvar
-
@cindex window change functions
The remainder of this section covers six hooks that are called
during redisplay provided a significant, non-scrolling change of a
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index dacf1451cc2..ac2ac5a0f91 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -6,6 +6,7 @@
@settitle GNU Emacs Calc Manual
@include docstyle.texi
@setchapternewpage odd
+@documentencoding UTF-8
@comment %**end of header (This is for running Texinfo on a region.)
@include emacsver.texi
@@ -10572,12 +10573,11 @@ Non-decimal fractions are entered and displayed as
form). The numerator and denominator always use the same radix.
@ifnottex
-Fractions may also be entered with @kbd{@U{2044}} (U+2044 FRACTION
-SLASH) in place of any @kbd{:}. Precomposed fraction characters from
-@kbd{@U{00BD}} (U+00BD VULGAR FRACTION ONE HALF) through
-@kbd{@U{215E}} (U+215E VULGAR FRACTION SEVEN EIGHTHS) are supported as
-well. Thus, @samp{2:3}, @samp{2@U{2044}3}, and @samp{@U{2154}} are all
-equivalent.
+Fractions may also be entered with @kbd{⁄} (U+2044 FRACTION SLASH) in
+place of any @kbd{:}. Precomposed fraction characters from @kbd{½}
+(U+00BD VULGAR FRACTION ONE HALF) through @kbd{⅞} (U+215E VULGAR
+FRACTION SEVEN EIGHTHS) are supported as well. Thus, @samp{2:3},
+@samp{2⁄3}, and @samp{⅞} are all equivalent.
@end ifnottex
@iftex
Fractions may also be entered with U+2044 FRACTION SLASH in place of
diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi
index 4cad016a0f6..e23ce3792e0 100644
--- a/doc/misc/dired-x.texi
+++ b/doc/misc/dired-x.texi
@@ -346,6 +346,16 @@ only match against the non-directory part of the file
name. Set it to
match the file name relative to the buffer's top-level directory.
@end defvar
+@defvar dired-omit-size-limit
+If non-@code{nil}, @code{dired-omit-mode} will be effectively disabled
+in directories whose listing has size (in bytes) larger than the value
+of this option. Since omitting can be slow for very large directories,
+this avoids having to wait before seeing the directory. This variable
+is ignored when @code{dired-omit-mode} is called interactively, such as
+by @kbd{C-x M-o}, so you can still enable omitting in the directory
+after the initial display.
+@end defvar
+
@cindex omitting additional files
@defvar dired-omit-marker-char
Temporary marker used by Dired to implement omitting. Should never be used
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi
index d31fcf1802b..eec6b3c3299 100644
--- a/doc/misc/eww.texi
+++ b/doc/misc/eww.texi
@@ -146,6 +146,27 @@ a new tab is created on the frame tab bar.
which part of the document contains the ``readable'' text, and will
only display this part. This usually gets rid of menus and the like.
+ When called interactively, this command toggles the display of the
+readable parts. With a positive prefix argument, this command always
+displays the readable parts, and with a zero or negative prefix, it
+always displays the full page.
+
+@vindex eww-readable-urls
+ If you want EWW to render a certain page in ``readable'' mode by
+default, you can add a regular expression matching its URL to
+@code{eww-readable-urls}. Each entry can either be a regular expression
+in string form or a cons cell of the form
+@w{@code{(@var{regexp} . @var{readability})}}. If @var{readability} is
+non-@code{nil}, this behaves the same as the string form; otherwise,
+URLs matching @var{regexp} will never be displayed in readable mode by
+default. For example, you can use this to make all pages default to
+readable mode, except for a few outliers:
+
+@example
+(setq eww-readable-urls '(("https://example\\.com/"; . nil)
+ ".*"))
+@end example
+
@findex eww-toggle-fonts
@vindex shr-use-fonts
@kindex F
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 45f96778203..c3de15c35ad 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -4,9 +4,9 @@
#+language: en
#+options: ':t toc:nil author:t email:t num:t
#+startup: content
-#+macro: stable-version 4.3.0
-#+macro: release-date 2023-09-19
-#+macro: development-version 4.4.0-dev
+#+macro: stable-version 4.4.0
+#+macro: release-date 2024-03-17
+#+macro: development-version 4.5.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -37,12 +37,10 @@ Current development target is {{{development-version}}}.
+ Change log: <https://protesilaos.com/emacs/modus-themes-changelog>
+ Color palette: <https://protesilaos.com/emacs/modus-themes-colors>
+ Sample pictures: <https://protesilaos.com/emacs/modus-themes-pictures>
-+ Git repo on SourceHut: <https://git.sr.ht/~protesilaos/modus-themes>
- - Mirrors:
- + GitHub: <https://github.com/protesilaos/modus-themes>
- + GitLab: <https://gitlab.com/protesilaos/modus-themes>
-+ Mailing list: <https://lists.sr.ht/~protesilaos/modus-themes>
-+ Backronym: My Old Display Unexpectedly Sharpened ... themes
++ Git repositories:
+ + GitHub: <https://github.com/protesilaos/modus-themes>
+ + GitLab: <https://gitlab.com/protesilaos/modus-themes>
++ Backronym: My Old Display Unexpectedly Sharpened ... themes.
#+toc: headlines 8 insert TOC here, with eight headline levels
@@ -90,7 +88,7 @@ The Modus themes consist of eight themes, divided into four
subgroups.
are variants of the two main themes. They slightly tone down the
intensity of the background and provide a bit more color variety.
~modus-operandi-tinted~ has a set of base tones that are shades of
- light ocher (earthly colors), while ~modus-vivendi-tinted~ gives a
+ light ochre (earthly colors), while ~modus-vivendi-tinted~ gives a
night sky impression.
- Deuteranopia themes :: ~modus-operandi-deuteranopia~ and its
@@ -265,9 +263,6 @@ wrong.
:properties:
:custom_id: h:3f3c3728-1b34-437d-9d0c-b110f5b161a9
:end:
-#+findex: modus-themes-toggle
-#+findex: modus-themes-load-theme
-#+vindex: modus-themes-after-load-theme-hook
#+cindex: Essential configuration
NOTE that Emacs can load multiple themes, which typically produces
@@ -285,7 +280,7 @@ theme of their preference by adding either form to their
init file:
(load-theme 'modus-vivendi) ; Dark theme
#+end_src
-Remember that the Modus themes are six themes
([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the
+Remember that there are multiple Modus themes
([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]]). Adapt the
above snippet accordingly.
Users of packaged variants of the themes must add a few more lines to
@@ -342,6 +337,38 @@ This is how a basic setup could look like
([[#h:b66b128d-54a4-4265-b59f-4d1ea2fe
[[#h:e979734c-a9e1-4373-9365-0f2cd36107b8][Sample configuration with and
without use-package]].
+To disable other themes before loading a Modus theme, use something
+like this:
+
+#+begin_src emacs-lisp
+(mapc #'disable-theme custom-enabled-themes)
+(load-theme 'modus-operandi :no-confirm)
+#+end_src
+
+#+findex: modus-themes-load-theme
+Instead of using the basic ~load-theme~ function, users can rely on
+the ~modus-themes-load-theme~. It accepts a single argument, which is
+a symbol representing the Modus theme of choice, such as:
+
+#+begin_src emacs-lisp
+(modus-themes-load-theme 'modus-operandi)
+#+end_src
+
+#+vindex: modus-themes-after-load-theme-hook
+#+vindex: modus-themes-post-load-hook
+The ~modus-themes-load-theme~ takes care to disable other themes, if
+the user opts in ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for
disabling other themes while loading Modus]]).
+After loading the theme of choice, this function calls the
+hook ~modus-themes-after-load-theme-hook~ (alias
~modus-themes-post-load-hook~).
+Users can add their own functions to this hook to make further
+customizations ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced
customization]]).
+
+#+findex: modus-themes-toggle
+#+findex: modus-themes-select
+The commands ~modus-themes-toggle~ and ~modus-themes-select~ use
+~modus-themes-load-theme~ internally
([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to
toggle]]).
+The aforementioned hold true for them as well.
+
** The ~require-theme~ for built-in Emacs themes
:PROPERTIES:
:CUSTOM_ID: h:b66b128d-54a4-4265-b59f-4d1ea2feb073
@@ -449,8 +476,6 @@ will lead to failures in loading the files. If either or
both of those
variables need to be changed, their values should be defined before the
package declaration of the themes.
-[[#h:aabcada6-810d-4eee-b34a-d2a9c301824d][Make the themes look like what the
maintainer uses]]
-
** Differences between loading and enabling
:properties:
:custom_id: h:e68560b3-7fb0-42bc-a151-e015948f8a35
@@ -608,9 +633,9 @@ Possible values:
When the value is non-~nil~, the commands ~modus-themes-toggle~ and
~modus-themes-select~, as well as the ~modus-themes-load-theme~
function, will disable all other themes while loading the specified
-Modus theme. This is done to ensure that Emacs does not blend two or
-more themes: such blends lead to awkward results that undermine the
-work of the designer.
+Modus theme ([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which
themes to toggle]]). This is done to
+ensure that Emacs does not blend two or more themes: such blends lead
+to awkward results that undermine the work of the designer.
When the value is ~nil~, the aforementioned commands and function will
only disable other themes within the Modus collection.
@@ -678,6 +703,32 @@ Advanced users may also want to configure the exact
attributes of the
[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
+** Option for which themes to toggle
+:PROPERTIES:
+:CUSTOM_ID: h:4fbfed66-5a89-447a-a07d-a03f6819c5bd
+:END:
+#+vindex: modus-themes-to-toggle
+
+Brief: Choose to Modus themes to toggle between
+
+Symbol: ~modus-themes-to-toggle~ (=list= type)
+
+Default value: ='(modus-operandi modus-vivendi)=
+
+Possible values:
+
+- ~modus-operandi~
+- ~modus-vivendi~
+- ~modus-operandi-tinted~
+- ~modus-vivendi-tinted~
+- ~modus-operandi-deuteranopia~
+- ~modus-vivendi-deuteranopia~
+- ~modus-operandi-tritanopia~
+- ~modus-vivendi-tritanopia~
+
+Specify two themes to toggle between using the command
+~modus-themes-toggle~.
+
** Option for font mixing
:properties:
:alt_title: Mixed fonts
@@ -851,43 +902,13 @@ Is the same as:
:end:
#+vindex: modus-themes-org-blocks
-Brief: Set the overall style of Org code blocks, quotes, and the like.
-
-Symbol: ~modus-themes-org-blocks~ (=choice= type)
-
-Possible values:
+As part of version =4.4.0=, the ~modus-themes-org-blocks~ is no more.
+Users can apply palette overrides to set a style that fits their
+preference (purple, blue, yellow, green, etc.). It is more flexible
+and more powerful ([[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org
block colors more or less colorful]])
-1. ~nil~ (default)
-2. ~gray-background~
-3. ~tinted-background~
-
-Option ~nil~ (the default) means that the block has no background of
-its own: it uses the one that applies to the rest of the buffer.
-In this case, the delimiter lines have a gray color for their text,
-making them look exactly like all other Org properties.
-
-Option ~gray-background~ applies a subtle gray background to the
-block's contents. It also affects the begin and end lines of the
-block as they get another shade of gray as their background, which
-differentiates them from the contents of the block. All background
-colors extend to the edge of the window, giving the area a
-rectangular, "blocky" presentation. If the begin/end lines do not
-extend in this way, check the value of the Org user option
-~org-fontify-whole-block-delimiter-line~.
-
-Option ~tinted-background~ uses a colored background for the contents
-of the block. The exact color value will depend on the programming
-language and is controlled by the variable ~org-src-block-faces~
-(refer to the theme's source code for the current association list).
-For this to take effect, the Org buffer needs to be restarted with
-~org-mode-restart~.
-
-Code blocks use their major mode's fontification (syntax highlighting)
-only when the variable ~org-src-fontify-natively~ is non-~nil~. While
-quote/verse blocks require setting
-~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value.
-
-[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter
fontification]].
+For the option to change the background of Org source blocks, we
+provide the relevant setup ([[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use
colored Org source blocks per language]]).
** Option for the headings' overall style
:properties:
@@ -1169,22 +1190,175 @@ Named colors can be previewed, such as with the command
For a video tutorial that users of all skill levels can approach,
watch: https://protesilaos.com/codelog/2022-12-17-modus-themes-v4-demo/.
+* Preview theme colors
+:properties:
+:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d
+:end:
+#+cindex: Preview named colors or semantic color mappings
+
+#+findex: modus-themes-list-colors
+The command ~modus-themes-list-colors~ uses minibuffer completion to
+select an item from the Modus themes and then produces a buffer with
+previews of its color palette entries. The buffer has a naming scheme
+that reflects the given choice, like =modus-operandi-list-colors= for
+the ~modus-operandi~ theme.
+
+#+findex: modus-themes-list-colors-current
+The command ~modus-themes-list-colors-current~ skips the minibuffer
+selection process and just produces a preview for the current Modus
+theme.
+
+When called with a prefix argument (=C-u= with the default key
+bindings), these commands will show a preview of the palette's
+semantic color mappings instead of the named colors. In this context,
+"named colors" are entries that associate a symbol to a string color
+value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color
+mappings" associate a named color to a symbol, like =(string
+blue-warmer)=, thus making the theme render all string constructs in
+the =blue-warmer= color value
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
+
+#+findex: modus-themes-preview-colors
+#+findex: modus-themes-preview-colors-current
+Aliases for those commands are ~modus-themes-preview-colors~ and
+~modus-themes-preview-colors-current~.
+
+Each row shows a foreground and background coloration using the
+underlying value it references. For example a line with =#a60000= (a
+shade of red) will show red text followed by a stripe with that same
+color as a backdrop.
+
+The name of the buffer describes the given Modus theme and what the
+contents are, such as =*modus-operandi-list-colors*= for named colors
+and ==*modus-operandi-list-mappings*= for the semantic color mappings.
+
+* Use colors from the Modus themes palette
+:PROPERTIES:
+:CUSTOM_ID: h:33460ae8-984b-40fd-8baa-383cc5fc2698
+:END:
+
+The Modus themes provide the means to access the palette of (i) the
+active theme or (ii) any theme in the Modus collection. These are
+useful for Do-It-Yourself customizations
([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]),
+though it can also be helpful in other cases, such as to reuse a color
+value in some other application.
+
+- Function :: [[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color
from the palette with ~modus-themes-get-color-value~]]
+- Macro :: [[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code
with ~modus-themes-with-colors~]].
+
+** Get a single color from the palette with ~modus-themes-get-color-value~
+:PROPERTIES:
+:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e
+:END:
+
+#+findex: modus-themes-get-color-value
+The fuction ~modus-themes-get-color-value~ can be called from Lisp to
+return the value of a color from the active Modus theme palette. It
+takea a =COLOR= argument and an optional =OVERRIDES=. It also accepts
+a third =THEME= argument, to get the color from the given theme.
+
+=COLOR= is a symbol that represents a named color entry in the
+palette ([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
+
+If the value is the name of another color entry in the palette (so a
+mapping), this function recurs until it finds the underlying color
+value.
+
+With an optional =OVERRIDES= argument as a non-~nil~ value, it
+accounts for palette overrides. Else it reads only the default palette
+([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]])
+
+With an optional =THEME= as a symbol among the ~modus-themes-items~
+(alias ~modus-themes-collection~), it uses the palette of that theme.
+Else it uses the current Modus theme.
+
+If =COLOR= is not present in the palette, this function returns the
+~unspecified~ symbol, which is safe when used as a face attribute's
+value.
+
+An example with ~modus-operandi~ to show how this function behaves
+with/without overrides and when recursive mappings are introduced.
+
+#+begin_src emacs-lisp
+;; Here we show the recursion of palette mappings. In general, it is
+;; better for the user to specify named colors to avoid possible
+;; confusion with their configuration, though those still work as
+;; expected.
+(setq modus-themes-common-palette-overrides
+ '((cursor red)
+ (fg-mode-line-active cursor)
+ (border-mode-line-active fg-mode-line-active)))
+
+;; Ignore the overrides and get the original value.
+(modus-themes-get-color-value 'border-mode-line-active)
+;; => "#5a5a5a"
+
+;; Read from the overrides and deal with any recursion to find the
+;; underlying value.
+(modus-themes-get-color-value 'border-mode-line-active :overrides)
+;; => "#a60000"
+#+end_src
+
+** Use theme colors in code with ~modus-themes-with-colors~
+:properties:
+:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
+:end:
+#+cindex: Use colors from the palette anywhere
+
+[ Note that for common cases the following is not not needed. Just rely on
+ the comprehensive overrides we provide
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]). ]
+
+#+findex: modus-themes-with-colors
+Advanced users may want to apply many colors from the palette of the
+active Modus theme in their custom code. In such a case, retrieving
+each value with the function ~modus-themes-get-color-value~ is
+inefficient ([[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color
from the palette]]). The Lisp macro
+~modus-themes-with-colors~ provides the requisite functionality. It
+supplies the current theme's palette to the code called from inside of
+it. For example:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
+;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045")
+#+end_src
+
+The above return value is for ~modus-operandi~ when that is the active
+theme. Switching to another theme and evaluating this code anew will
+return the relevant results for that theme (remember that since
+version 4, the Modus themes consist of many items
([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The
+same with ~modus-vivendi~ as the active theme:
+
+#+begin_src emacs-lisp
+(modus-themes-with-colors
+ (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
+;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0")
+#+end_src
+
+The ~modus-themes-with-colors~ has access to the whole palette of the
+active theme, meaning that it can instantiate both (i) named colors
+like =blue-warmer= and (ii) semantic color mappings like =warning=.
+We provide commands to inspect those
([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
+
+Others sections in this manual show how to use the aforementioned
+macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
In practice, the use of a hook will
+also be needed ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at
the post-load-theme phase]]).
+
* Advanced customization
:properties:
:custom_id: h:f4651d55-8c07-46aa-b52b-bed1e53463bb
:end:
-Unlike the predefined customization options which follow a clear pattern
-of allowing the user to quickly specify their preference, the themes
-also provide a more flexible, albeit difficult, mechanism to control
-things with precision
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
+Unlike the predefined customization options which follow a clear
+pattern of allowing the user to quickly specify their preference, the
+themes also provide a more flexible, albeit a bit more difficult,
+mechanism to control things with precision
([[#h:bf1c82f2-46c7-4eb2-ad00-dd11fdd8b53f][Customization Options]]).
This section is of interest only to users who are prepared to maintain
their own local tweaks and who are willing to deal with any possible
-incompatibilities between versioned releases of the themes. As such,
+incompatibilities between versioned releases of the themes. As such,
they are labeled as "do-it-yourself" or "DIY".
-** Palette override presets
+** DIY Palette override presets
:PROPERTIES:
:CUSTOM_ID: h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc
:END:
@@ -1257,7 +1431,7 @@ the general idea (extra space for didactic purposes):
,@modus-themes-preset-overrides-intense))
#+end_src
-** Stylistic variants using palette overrides
+** DIY Stylistic variants using palette overrides
:PROPERTIES:
:CUSTOM_ID: h:df1199d8-eaba-47db-805d-6b568a577bf3
:END:
@@ -1269,7 +1443,7 @@ to take effect. To apply overrides at startup simply
define them
before the call that loads the theme. Remember that we also provide
presets that are easier to apply
([[#h:b0bc811c-227e-42ec-bf67-15e1f41eb7bc][Palette override presets]]).
-*** Make the mode line borderless
+*** DIY Make the mode line borderless
:PROPERTIES:
:CUSTOM_ID: h:80ddba52-e188-411f-8cc0-480ebd75befe
:END:
@@ -1284,14 +1458,6 @@ set their color to that of the underlying background.
[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Remove the border
(setq modus-themes-common-palette-overrides
'((border-mode-line-active unspecified)
@@ -1306,7 +1472,9 @@ set their color to that of the underlying background.
(border-mode-line-inactive bg-mode-line-inactive)))
#+end_src
-*** Make the active mode line colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make the active mode line colorful
:PROPERTIES:
:CUSTOM_ID: h:e8d781be-eefc-4a81-ac4e-5ed156190df7
:END:
@@ -1323,14 +1491,6 @@ have a blue mode line for ~modus-operandi~ and a red one
for
[[#h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c][Add padding to mode line]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Blue background, neutral foreground, intense blue border
(setq modus-themes-common-palette-overrides
'((bg-mode-line-active bg-blue-intense)
@@ -1343,14 +1503,28 @@ have a blue mode line for ~modus-operandi~ and a red
one for
(fg-mode-line-active fg-main)
(border-mode-line-active blue-intense)))
-;; Subtle red background, red foreground, invisible border
+;; Sage (green/cyan) background, neutral foreground, slightly distinct green
border
+(setq modus-themes-common-palette-overrides
+ '((bg-mode-line-active bg-sage)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-green-intense)))
+
+;; As above, but with a purple style
(setq modus-themes-common-palette-overrides
- '((bg-mode-line-active bg-red-subtle)
- (fg-mode-line-active red-warmer)
- (border-mode-line-active bg-red-subtle)))
+ '((bg-mode-line-active bg-lavender)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-magenta-intense)))
+
+;; As above, but with an earthly style
+(setq modus-themes-common-palette-overrides
+ '((bg-mode-line-active bg-ochre)
+ (fg-mode-line-active fg-main)
+ (border-mode-line-active bg-yellow-intense)))
#+end_src
-*** Make the tab bar more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make the tab bar more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:096658d7-a0bd-4a99-b6dc-9b20a20cda37
:END:
@@ -1365,15 +1539,6 @@ fringes, and line numbers. These are shown in other
sections of this
manual.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the `tab-bar-mode' mode subtle while keepings its original
;; gray aesthetic.
(setq modus-themes-common-palette-overrides
@@ -1402,7 +1567,9 @@ manual.
(bg-tab-other bg-cyan-subtle)))
#+end_src
-*** Make the fringe invisible or another color
+Reload the theme for changes to take effect.
+
+*** DIY Make the fringe invisible or another color
:PROPERTIES:
:CUSTOM_ID: h:c312dcac-36b6-4a1f-b1f5-ab1c9abe27b0
:END:
@@ -1415,14 +1582,6 @@ side of the Emacs window which shows indicators such as
for truncation
or continuation lines.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Make the fringe invisible
(setq modus-themes-common-palette-overrides
'((fringe unspecified)))
@@ -1436,7 +1595,9 @@ or continuation lines.
'((fringe bg-blue-nuanced)))
#+end_src
-*** Make links use subtle or no underlines
+Reload the theme for changes to take effect.
+
+*** DIY Make links use subtle or no underlines
:PROPERTIES:
:CUSTOM_ID: h:6c1d1dea-5cbf-4d92-b7bb-570a7a23ffe9
:END:
@@ -1460,7 +1621,9 @@ that underline mappings can read correctly.
(underline-link-symbolic unspecified)))
#+end_src
-*** Make prompts more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make prompts more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:bd75b43a-0bf1-45e7-b8b4-20944ca8b7f8
:END:
@@ -1472,14 +1635,6 @@ block we show how to add or remove color from prompts.
[[#h:db5a9a7c-2928-4a28-b0f0-6f2b9bd52ba1][Option for command prompt styles]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Keep the background unspecified (like the default), but use a faint
;; foreground color.
(setq modus-themes-common-palette-overrides
@@ -1497,7 +1652,9 @@ block we show how to add or remove color from prompts.
(bg-prompt bg-yellow-subtle))) ; try to replace "subtle" with "intense"
#+end_src
-*** Make completion matches more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make completion matches more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:d959f789-0517-4636-8780-18123f936f91
:END:
@@ -1510,14 +1667,6 @@ three different degrees of intensity.
[[#h:f1c20c02-7b34-4c35-9c65-99170efb2882][Option for completion framework
aesthetics]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Add a nuanced background color to completion matches, while keeping
;; their foreground intact (foregrounds do not need to be specified in
;; this case, but we do it for didactic purposes).
@@ -1584,7 +1733,9 @@ colors to two:
The user can mix and match to their liking.
-*** Make comments yellow and strings green
+Reload the theme for changes to take effect.
+
+*** DIY Make comments yellow and strings green
:PROPERTIES:
:CUSTOM_ID: h:26f53daa-0065-48dc-88ab-6a718d16cd95
:END:
@@ -1601,14 +1752,6 @@ reproduce the effect, but also how to tweak it to one's
liking.
[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for
code syntax]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Yellow comments and green strings like older versions of the Modus
;; themes
(setq modus-themes-common-palette-overrides
@@ -1627,7 +1770,9 @@ reproduce the effect, but also how to tweak it to one's
liking.
(string yellow-cooler)))
#+end_src
-*** Make code syntax use the old alt-syntax style
+Reload the theme for changes to take effect.
+
+*** DIY Make code syntax use the old alt-syntax style
:PROPERTIES:
:CUSTOM_ID: h:c8767172-bf11-4c96-81dc-e736c464fc9c
:END:
@@ -1640,16 +1785,7 @@ upside of using overrides for this purpose is that we
can tweak the
style to our liking, but first let's start with its recreation:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
-;; The old "alt-syntax"
+;; The old "alt-syntax" (before version 4.0.0 of the Modus themes)
(setq modus-themes-common-palette-overrides
'((builtin magenta)
(comment fg-dim)
@@ -1712,7 +1848,9 @@ The user can always mix and match styles to their liking.
[[#h:943063da-7b27-4ba4-9afe-f8fe77652fd1][Make use of alternative styles for
code syntax]].
-*** Make use of alternative styles for code syntax
+Reload the theme for changes to take effect.
+
+*** DIY Make use of alternative styles for code syntax
:PROPERTIES:
:CUSTOM_ID: h:943063da-7b27-4ba4-9afe-f8fe77652fd1
:END:
@@ -1730,18 +1868,9 @@ theme palette.
[[#h:26f53daa-0065-48dc-88ab-6a718d16cd95][Make comments yellow and strings
green]].
-[[*Make code syntax use the old alt-syntax style][Make code syntax use the old
alt-syntax style]].
+[[#h:c8767172-bf11-4c96-81dc-e736c464fc9c][Make code syntax use the old
alt-syntax style]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Mimic `ef-night' theme (from my `ef-themes') for code syntax
;; highlighting, while still using the Modus colors (and other
;; mappings).
@@ -1803,7 +1932,9 @@ theme palette.
(variable cyan-warmer)))
#+end_src
-*** Make matching parenthesis more or less intense
+Reload the theme for changes to take effect.
+
+*** DIY Make matching parenthesis more or less intense
:PROPERTIES:
:CUSTOM_ID: h:259cf8f5-48ec-4b13-8a69-5d6387094468
:END:
@@ -1815,14 +1946,6 @@ delimiters when ~show-paren-mode~ is enabled. We also
demonstrate how
to enable underlines for those highlights.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Change the background to a shade of magenta
(setq modus-themes-common-palette-overrides
'((bg-paren-match bg-magenta-intense)))
@@ -1831,9 +1954,17 @@ to enable underlines for those highlights.
(setq modus-themes-common-palette-overrides
'((bg-paren-match bg-magenta-intense)
(underline-paren-match fg-main)))
+
+;; Do not use any background color and instead apply an intense red
+;; foreground.
+(setq modus-themes-common-palette-overrides
+ '((bg-paren-match unspecified)
+ (fg-paren-match red-intense)))
#+end_src
-*** Make box buttons more or less gray
+Reload the theme for changes to take effect.
+
+*** DIY Make box buttons more or less gray
:PROPERTIES:
:CUSTOM_ID: h:4f6b6ca3-f5bb-4830-8312-baa232305360
:END:
@@ -1846,14 +1977,6 @@ removes the gray from the active buttons and amplifies
it for the
inactive ones.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
(setq modus-themes-common-palette-overrides
'((bg-button-active bg-main)
(fg-button-active fg-main)
@@ -1861,7 +1984,9 @@ inactive ones.
(fg-button-inactive "gray50")))
#+end_src
-*** Make TODO and DONE more or less intense
+Reload the theme for changes to take effect.
+
+*** DIY Make TODO and DONE more or less intense
:PROPERTIES:
:CUSTOM_ID: h:b57bb50b-a863-4ea8-bb38-6de2275fa868
:END:
@@ -1877,14 +2002,6 @@ to subdue them.
[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use
alternative styles]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Increase intensity
(setq modus-themes-common-palette-overrides
'((prose-done green-intense)
@@ -1901,7 +2018,9 @@ to subdue them.
'((prose-done fg-dim)))
#+end_src
-*** Make headings more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make headings more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:11297984-85ea-4678-abe9-a73aeab4676a
:END:
@@ -1916,15 +2035,6 @@ match styles at will.
[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more intense]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Apply more colorful foreground to some headings (headings 0-8).
;; Level 0 is for Org #+title and related.
(setq modus-themes-common-palette-overrides
@@ -1958,7 +2068,107 @@ match styles at will.
(overline-heading-1 border)))
#+end_src
-*** Make Org agenda more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make Org block colors more or less colorful
+:properties:
+:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
+:end:
+
+This is one of our practical examples to override the semantic colors
+of the Modus themes ([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic
variants using palette overrides]]). Here
+we show how to change the presentation of Org blocks (and other such
+blocks like Markdown fenced code sections, though the exact
+presentation depends on each major mode).
+
+The default style of Org blocks is a subtle gray background for the
+contents and for the delimiter lines (the =#+begin_= and =#+end_=
+parts). The text of the delimiter lines is a subtle gray foreground
+color.
+
+[[#h:bb5b396f-5532-4d52-ab13-149ca24854f1][Make inline code in prose use
alternative styles]].
+
+#+begin_src emacs-lisp
+;; Make code blocks (in Org, for example) use a more colorful style
+;; for their delimiter lines as well as their contents. Give this a
+;; purple feel. Make the delimiter lines distinct from the contents.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-magenta-nuanced)
+ (bg-prose-block-delimiter bg-lavender)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a more blue feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-blue-nuanced)
+ (bg-prose-block-delimiter bg-lavender)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a green feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-green-nuanced)
+ (bg-prose-block-delimiter bg-sage)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a yellow/gold feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-yellow-nuanced)
+ (bg-prose-block-delimiter bg-ochre)
+ (fg-prose-block-delimiter fg-main)))
+
+;; As above, but with a slightly more red feel.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-red-nuanced)
+ (bg-prose-block-delimiter bg-ochre)
+ (fg-prose-block-delimiter fg-main)))
+#+end_src
+
+The previous examples differentiate the delimiter lines from the
+block's contents. Though we can mimic the default aesthetic of a
+uniform background, while changing the applicable colors. Here are
+some nice combinations:
+
+#+begin_src emacs-lisp
+;; Solid green style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-green-nuanced)
+ (bg-prose-block-delimiter bg-green-nuanced)
+ (fg-prose-block-delimiter green-warmer)))
+
+;; Solid yellow style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-yellow-nuanced)
+ (bg-prose-block-delimiter bg-yellow-nuanced)
+ (fg-prose-block-delimiter yellow-cooler)))
+
+;; Solid cyan style.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents bg-cyan-nuanced)
+ (bg-prose-block-delimiter bg-cyan-nuanced)
+ (fg-prose-block-delimiter cyan-cooler)))
+#+end_src
+
+[ Combine the above with a suitable mode line style for maximum effect
+ ([[#h:e8d781be-eefc-4a81-ac4e-5ed156190df7][DIY Make the active mode line
colorful]]). ]
+
+Finally, the following makes code blocks have no distinct background.
+The minimal styles are applied to the delimiter lines, which only use
+a subtle gray foreground. This was the default for the Modus themes up
+until version 4.3.0.
+
+#+begin_src emacs-lisp
+;; Make code blocks more minimal, so that (i) the delimiter lines have
+;; no background, (ii) the delimiter foreground is a subtle gray, and
+;; (iii) the block contents have no distinct background either. This
+;; was the default in versions of the Modus themes before 4.4.0
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-block-contents unspecified)
+ (bg-prose-block-delimiter unspeficied)
+ (fg-prose-block-delimiter fg-dim)))
+#+end_src
+
+[[#h:8c842804-43b7-4287-b4e9-8c07d04d1f89][DIY Use colored Org source blocks
per language]].
+
+*** DIY Make Org agenda more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:a5af0452-a50f-481d-bf60-d8143f98105f
:END:
@@ -1973,14 +2183,6 @@ these styles with what we show in the other chapters
with practical
stylistic variants.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
;; Make the Org agenda use alternative and varied colors.
(setq modus-themes-common-palette-overrides
'((date-common cyan) ; default value (for timestamps and more)
@@ -2004,7 +2206,7 @@ An example with faint coloration:
(date-holiday magenta) ; default (for M-x calendar)
(date-now fg-main) ; default
(date-scheduled yellow-faint)
- (date-weekday fg-dim)
+ (date-weekday fg-alt)
(date-weekend fg-dim)))
#+end_src
@@ -2041,7 +2243,9 @@ Yet another example that also affects =DONE= and =TODO=
keywords:
(prose-todo yellow)))
#+end_src
-*** Make inline code in prose use alternative styles
+Reload the theme for changes to take effect.
+
+*** DIY Make inline code in prose use alternative styles
:PROPERTIES:
:CUSTOM_ID: h:bb5b396f-5532-4d52-ab13-149ca24854f1
:END:
@@ -2053,54 +2257,47 @@ Org's verbatim, code, and macro entries. We also
provide mappings for
tables, property drawers, tags, and code block delimiters, though we
do not show every possible permutation.
-[[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less
intense]].
+- [[#h:b57bb50b-a863-4ea8-bb38-6de2275fa868][Make TODO and DONE more or less
intense]].
+- [[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or
less colorful]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
+;; A nuanced accented background, combined with a suitable foreground.
+(setq modus-themes-common-palette-overrides
+ '((bg-prose-code bg-green-nuanced)
+ (fg-prose-code green-cooler)
+ (bg-prose-verbatim bg-magenta-nuanced)
+ (fg-prose-verbatim magenta-warmer)
-;; These are all the mappings at their default values for didactic
-;; purposes
-(setq modus-themes-common-palette-overrides
- '((prose-block fg-dim)
- (prose-code green-cooler)
- (prose-done green)
- (prose-macro magenta-cooler)
- (prose-metadata fg-dim)
- (prose-metadata-value fg-alt)
- (prose-table fg-alt)
- (prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)))
-
-;; Make code block delimiters use a shade of red, tone down verbatim,
-;; code, and macro, and amplify the style of property drawers
+ (bg-prose-macro bg-blue-nuanced)
+ (fg-prose-macro magenta-cooler)))
+
+;; A more noticeable accented background, combined with a suitable foreground.
(setq modus-themes-common-palette-overrides
- '((prose-block red-faint)
- (prose-code fg-dim)
- (prose-macro magenta-faint)
- (prose-metadata cyan)
- (prose-metadata-value green-warmer)
- (prose-verbatim fg-dim)))
-
-;; Like the above but with more color variety for the inline code
-;; elements
+ '((bg-prose-code bg-sage)
+ (fg-prose-code green-faint)
+
+ (bg-prose-verbatim bg-ochre)
+ (fg-prose-verbatim red-faint)
+
+ (bg-prose-macro bg-lavender)
+ (fg-prose-macro blue-faint)))
+
+;; Leave the backgrounds without a color and simply make the foregrounds more
intense.
(setq modus-themes-common-palette-overrides
- '((prose-block red-faint)
- (prose-code blue-cooler)
- (prose-macro yellow-warmer)
- (prose-metadata cyan)
- (prose-metadata-value green-warmer)
- (prose-verbatim red-warmer)))
+ '((bg-prose-code unspecified)
+ (fg-prose-code green-intense)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-intense)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro cyan-intense)))
#+end_src
-*** Make mail citations and headers more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make mail citations and headers more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:7da7a4ad-5d3a-4f11-9796-5a1abed0f0c4
:END:
@@ -2125,15 +2322,6 @@ This is some sample text
We thus have the following:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Reduce the intensity of mail citations and headers
(setq modus-themes-common-palette-overrides
'((mail-cite-0 cyan-faint)
@@ -2169,7 +2357,9 @@ We thus have the following:
(mail-other green)))
#+end_src
-*** Make the region preserve text colors, plus other styles
+Reload the theme for changes to take effect.
+
+*** DIY Make the region preserve text colors, plus other styles
:PROPERTIES:
:CUSTOM_ID: h:c8605d37-66e1-42aa-986e-d7514c3af6fe
:END:
@@ -2183,15 +2373,6 @@ with an appropriate foreground value.
[[#h:a5140c9c-18b2-45db-8021-38d0b5074116][Do not extend the region
background]].
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; A background with no specific foreground (use foreground of
;; underlying text)
(setq modus-themes-common-palette-overrides
@@ -2209,7 +2390,9 @@ with an appropriate foreground value.
(fg-region fg-main)))
#+end_src
-*** Make mouse highlights more or less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make mouse highlights more or less colorful
:PROPERTIES:
:CUSTOM_ID: h:b5cab69d-d7cb-451c-8ff9-1f545ceb6caf
:END:
@@ -2220,15 +2403,6 @@ the following code block we show how to affect the
semantic color
mapping that covers mouse hover effects and related highlights:
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the background an intense yellow
(setq modus-themes-common-palette-overrides
'((bg-hover bg-yellow-intense)))
@@ -2238,7 +2412,9 @@ mapping that covers mouse hover effects and related
highlights:
'((bg-hover bg-green-subtle)))
#+end_src
-*** Make language underlines less colorful
+Reload the theme for changes to take effect.
+
+*** DIY Make language underlines less colorful
:PROPERTIES:
:CUSTOM_ID: h:03dbd5af-6bae-475e-85a2-cec189f69598
:END:
@@ -2249,15 +2425,6 @@ Here we show how to affect the color of the underlines
that are used
by code linters and prose spell checkers.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make the underlines less intense
(setq modus-themes-common-palette-overrides
'((underline-err red-faint)
@@ -2271,7 +2438,9 @@ by code linters and prose spell checkers.
(underline-note green-intense)))
#+end_src
-*** Make line numbers use alternative styles
+Reload the theme for changes to take effect.
+
+*** DIY Make line numbers use alternative styles
:PROPERTIES:
:CUSTOM_ID: h:b6466f51-cb58-4007-9ebe-53a27af655c7
:END:
@@ -2281,15 +2450,6 @@ of the Modus themes
([[#h:df1199d8-eaba-47db-805d-6b568a577bf3][Stylistic varian
this section we show how to affect the ~display-line-numbers-mode~.
#+begin_src emacs-lisp
-;; These overrides are common to all Modus themes. We also provide
-;; theme-specific options, such as `modus-operandi-palette-overrides'.
-;;
-;; In general, the theme-specific overrides are better for overriding
-;; color values, such as redefining what `blue-faint' looks like. The
-;; common overrides are best used for changes to semantic color
-;; mappings, as we show below.
-
-
;; Make line numbers less intense
(setq modus-themes-common-palette-overrides
'((fg-line-number-inactive "gray50")
@@ -2313,7 +2473,9 @@ this section we show how to affect the
~display-line-numbers-mode~.
(bg-line-number-active bg-cyan-intense)))
#+end_src
-*** Make diffs use only a foreground
+Reload the theme for changes to take effect.
+
+*** DIY Make diffs use only a foreground
:PROPERTIES:
:CUSTOM_ID: h:b3761482-bcbf-4990-a41e-4866fb9dad15
:END:
@@ -2377,7 +2539,9 @@ just using the "common" overrides.
(fg-removed-intense yellow-intense)))
#+end_src
-*** Make deuteranopia diffs red and blue instead of yellow and blue
+Reload the theme for changes to take effect.
+
+*** DIY Make deuteranopia diffs red and blue instead of yellow and blue
:PROPERTIES:
:CUSTOM_ID: h:16389ea1-4cb6-4b18-9409-384324113541
:END:
@@ -2428,112 +2592,9 @@ respectively. This is achieved by overriding the
"changed" and
(fg-removed-intense "#ff9095")))
#+end_src
-*** Make the themes look like what the maintainer uses
-:PROPERTIES:
-:CUSTOM_ID: h:aabcada6-810d-4eee-b34a-d2a9c301824d
-:END:
-
-Based on what we have learnt from the previous sections of this
-manual, here is what Protesilaos uses:
-
-#+begin_src emacs-lisp
-;; Always reload the theme for changes to take effect!
-
-(setq modus-themes-custom-auto-reload nil
- modus-themes-to-toggle '(modus-operandi modus-vivendi)
- modus-themes-mixed-fonts t
- modus-themes-variable-pitch-ui nil
- modus-themes-italic-constructs t
- modus-themes-bold-constructs nil
- modus-themes-org-blocks nil
- modus-themes-completions '((t . (extrabold)))
- modus-themes-prompts nil
- modus-themes-headings
- '((agenda-structure . (variable-pitch light 2.2))
- (agenda-date . (variable-pitch regular 1.3))
- (t . (regular 1.15))))
-
-(setq modus-themes-common-palette-overrides
- '((cursor magenta-cooler)
- ;; Make the fringe invisible.
- (fringe unspecified)
- ;; Make line numbers less intense and add a shade of cyan
- ;; for the current line number.
- (fg-line-number-inactive "gray50")
- (fg-line-number-active cyan-cooler)
- (bg-line-number-inactive unspecified)
- (bg-line-number-active unspecified)
- ;; Make the current line of `hl-line-mode' a fine shade of
- ;; gray (though also see my `lin' package).
- (bg-hl-line bg-dim)
- ;; Make the region have a cyan-green background with no
- ;; specific foreground (use foreground of underlying text).
- ;; "bg-sage" refers to Salvia officinalis, else the common
- ;; sage.
- (bg-region bg-sage)
- (fg-region unspecified)
- ;; Make matching parentheses a shade of magenta. It
- ;; complements the region nicely.
- (bg-paren-match bg-magenta-intense)
- ;; Make email citations faint and neutral, reducing the
- ;; default four colors to two; make mail headers cyan-blue.
- (mail-cite-0 fg-dim)
- (mail-cite-1 blue-faint)
- (mail-cite-2 fg-dim)
- (mail-cite-3 blue-faint)
- (mail-part cyan-warmer)
- (mail-recipient blue-warmer)
- (mail-subject magenta-cooler)
- (mail-other cyan-warmer)
- ;; Change dates to a set of more subtle combinations.
- (date-deadline magenta-cooler)
- (date-scheduled magenta)
- (date-weekday fg-main)
- (date-event fg-dim)
- (date-now blue-faint)
- ;; Make tags (Org) less colorful and tables look the same as
- ;; the default foreground.
- (prose-done cyan-cooler)
- (prose-tag fg-dim)
- (prose-table fg-main)
- ;; Make headings less colorful (though I never use deeply
- ;; nested headings).
- (fg-heading-2 blue-faint)
- (fg-heading-3 magenta-faint)
- (fg-heading-4 blue-faint)
- (fg-heading-5 magenta-faint)
- (fg-heading-6 blue-faint)
- (fg-heading-7 magenta-faint)
- (fg-heading-8 blue-faint)
- ;; Make the active mode line a fine shade of lavender
- ;; (purple) and tone down the gray of the inactive mode
- ;; lines.
- (bg-mode-line-active bg-lavender)
- (border-mode-line-active bg-lavender)
-
- (bg-mode-line-inactive bg-dim)
- (border-mode-line-inactive bg-inactive)
- ;; Make the prompts a shade of magenta, to fit in nicely with
- ;; the overall blue-cyan-purple style of the other overrides.
- ;; Add a nuanced background as well.
- (bg-prompt bg-magenta-nuanced)
- (fg-prompt magenta-cooler)
- ;; Tweak some more constructs for stylistic consistency.
- (name blue-warmer)
- (identifier magenta-faint)
- (keybind magenta-cooler)
- (accent-0 magenta-cooler)
- (accent-1 cyan-cooler)
- (accent-2 blue-warmer)
- (accent-3 red-cooler)))
-
-;; Make the active mode line have a pseudo 3D effect (this assumes
-;; you are using the default mode line and not an extra package).
-(custom-set-faces
- '(mode-line ((t :box (:style released-button)))))
-#+end_src
+Reload the theme for changes to take effect.
-** More accurate colors in terminal emulators
+** DIY More accurate colors in terminal emulators
:PROPERTIES:
:CUSTOM_ID: h:fbb5e254-afd6-4313-bb05-93b3b4f67358
:END:
@@ -2562,7 +2623,7 @@ Another example that can be bound to a key:
: TERM=xterm-direct uxterm -e emacsclient -nw
-** Range of color with terminal emulators
+** DIY Range of color with terminal emulators
:PROPERTIES:
:CUSTOM_ID: h:6b8211b0-d11b-4c00-9543-4685ec3b742f
:END:
@@ -2633,48 +2694,7 @@ xterm*color14: #6ae4b9
xterm*color15: #ffffff
#+end_src
-** Preview theme colors
-:properties:
-:custom_id: h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d
-:end:
-#+cindex: Preview named colors or semantic color mappings
-
-#+findex: modus-themes-list-colors
-The command ~modus-themes-list-colors~ uses minibuffer completion to
-select an item from the Modus themes and then produces a buffer with
-previews of its color palette entries. The buffer has a naming scheme
-that reflects the given choice, like =modus-operandi-list-colors= for
-the ~modus-operandi~ theme.
-
-#+findex: modus-themes-list-colors-current
-The command ~modus-themes-list-colors-current~ skips the minibuffer
-selection process and just produces a preview for the current Modus
-theme.
-
-When called with a prefix argument (=C-u= with the default key
-bindings), these commands will show a preview of the palette's
-semantic color mappings instead of the named colors. In this context,
-"named colors" are entries that associate a symbol to a string color
-value, such as =(blue-warmer "#354fcf")=. Whereas "semantic color
-mappings" associate a named color to a symbol, like =(string
-blue-warmer)=, thus making the theme render all string constructs in
-the =blue-warmer= color value
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
-
-#+findex: modus-themes-preview-colors
-#+findex: modus-themes-preview-colors-current
-Aliases for those commands are ~modus-themes-preview-colors~ and
-~modus-themes-preview-colors-current~.
-
-Each row shows a foreground and background coloration using the
-underlying value it references. For example a line with =#a60000= (a
-shade of red) will show red text followed by a stripe with that same
-color as a backdrop.
-
-The name of the buffer describes the given Modus theme and what the
-contents are, such as =*modus-operandi-list-colors*= for named colors
-and ==*modus-operandi-list-mappings*= for the semantic color mappings.
-
-** Per-theme customization settings
+** DIY Per-theme customization settings
:properties:
:custom_id: h:a897b302-8e10-4a26-beab-3caaee1e1193
:end:
@@ -2709,114 +2729,9 @@ equivalent the themes provide.
For a more elaborate design, it is better to inspect the source code of
~modus-themes-toggle~ and relevant functions.
-** Get a single color from the palette
-:PROPERTIES:
-:CUSTOM_ID: h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e
-:END:
-
-[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
-
-#+findex: modus-themes-get-color-value
-The function ~modus-themes-get-color-value~ can be called from Lisp to
-return the value of a color from the active Modus theme palette. It
-takea a =COLOR= argument and an optional =OVERRIDES=.
-
-=COLOR= is a symbol that represents a named color entry in the
-palette.
+Reload the theme for changes to take effect.
-[[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]].
-
-If the value is the name of another color entry in the palette (so a
-mapping), this function recurs until it finds the underlying color
-value.
-
-With an optional =OVERRIDES= argument as a non-~nil~ value, it accounts
-for palette overrides. Else it reads only the default palette.
-
-[[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]].
-
-With optional =THEME= as a symbol among ~modus-themes-items~ (alias
-~modus-themes-collection~), use the palette of that item. Else use
-the current Modus theme.
-
-If =COLOR= is not present in the palette, this function returns the
-~unspecified~ symbol, which is safe when used as a face attribute's
-value.
-
-An example with ~modus-operandi~ to show how this function behaves
-with/without overrides and when recursive mappings are introduced.
-
-#+begin_src emacs-lisp
-;; Here we show the recursion of palette mappings. In general, it is
-;; better for the user to specify named colors to avoid possible
-;; confusion with their configuration, though those still work as
-;; expected.
-(setq modus-themes-common-palette-overrides
- '((cursor red)
- (fg-mode-line-active cursor)
- (border-mode-line-active fg-mode-line-active)))
-
-;; Ignore the overrides and get the original value.
-(modus-themes-get-color-value 'border-mode-line-active)
-;; => "#5a5a5a"
-
-;; Read from the overrides and deal with any recursion to find the
-;; underlying value.
-(modus-themes-get-color-value 'border-mode-line-active :overrides)
-;; => "#a60000"
-#+end_src
-
-** Use theme colors in code with modus-themes-with-colors
-:properties:
-:custom_id: h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae
-:end:
-#+cindex: Use colors from the palette anywhere
-
-[[#h:1cc552c1-5f5f-4a56-ae78-7b69e8512c4e][Get a single color from the
palette]].
-
-Note that users most probably do not need the following. Just rely on
-the comprehensive overrides we provide
([[#h:34c7a691-19bb-4037-8d2f-67a07edab150][Option for palette overrides]]).
-
-#+findex: modus-themes-with-colors
-Advanced users may want to apply colors from the palette of the active
-Modus theme in their custom code. The ~modus-themes-with-colors~
-macro supplies those to any form called inside of it. For example:
-
-#+begin_src emacs-lisp
-(modus-themes-with-colors
- (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
-;; => ("#354fcf" "#531ab6" "#005000" "#884900" "#005e8b" "#721045")
-#+end_src
-
-The above return value is for ~modus-operandi~ when that is the active
-theme. Switching to another theme and evaluating this code anew will
-give us the relevant results for that theme (remember that since
-version 4, the Modus themes consist of six items
([[#h:f0f3dbcb-602d-40cf-b918-8f929c441baf][Overview]])). The
-same with ~modus-vivendi~ as the active theme:
-
-#+begin_src emacs-lisp
-(modus-themes-with-colors
- (list blue-warmer magenta-cooler fg-added warning variable fg-heading-4))
-;; => ("#79a8ff" "#b6a0ff" "#a0e0a0" "#fec43f" "#00d3d0" "#feacd0")
-#+end_src
-
-The ~modus-themes-with-colors~ has access to the whole palette of the
-active theme, meaning that it can instantiate both (i) named colors
-like =blue-warmer= and (ii) semantic color mappings like =warning=.
-We provide commands to inspect those
([[#h:f4d4b71b-2ca5-4c3d-b0b4-9bfd7aa7fb4d][Preview theme colors]]).
-
-Others sections in this manual show how to use the aforementioned
-macro ([[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]]).
-
-Because the ~modus-themes-with-colors~ will most likely be used to
-customize faces, note that any function that calls it must be run at
-startup after the theme loads. The same function must also be
-assigned to the ~modus-themes-after-load-theme-hook~ for its effects
-to persist and be updated when switching between Modus themes (e.g. to
-update the exact value of =blue-warmer= when toggling between
-~modus-operandi~ to ~modus-vivendi~.
-
-** Do not extend the region background
+** DIY Do not extend the region background
:PROPERTIES:
:CUSTOM_ID: h:a5140c9c-18b2-45db-8021-38d0b5074116
:END:
@@ -2834,11 +2749,14 @@ this to the Emacs configuration file will suffice:
[[#h:c8605d37-66e1-42aa-986e-d7514c3af6fe][Make the region preserve text
colors, plus other styles]].
-** Add padding to mode line
+** DIY Add padding to the mode line
:PROPERTIES:
:CUSTOM_ID: h:5a0c58cc-f97f-429c-be08-927b9fbb0a9c
:END:
+[ Consider using the ~spacious-padding~ package from GNU ELPA (by
+ Protesilaos) for more than just the mode line. ]
+
Emacs faces do not have a concept of "padding" for the space between
the text and its box boundaries. We can approximate the effect by
adding a =:box= attribute, making its border several pixels thick, and
@@ -2849,7 +2767,7 @@ mode line.
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Add "padding" to the mode lines
@@ -2859,6 +2777,8 @@ mode line.
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
The above has the effect of removing the border around the mode lines.
In older versions of the themes, we provided the option for a padded
mode line which could also have borders around it. Those were not
@@ -2866,7 +2786,7 @@ real border, however, but an underline and an overline.
Adjusting the
above:
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Add "padding" to the mode lines
@@ -2886,13 +2806,15 @@ above:
The reason we no longer provide this option is because it depends on a
non-~nil~ value for ~x-underline-at-descent-line~. That variable
affects ALL underlines, including those of links. The effect is
-intrusive and looks awkward in prose.
+intrusive and looks awkard in prose.
As such, the Modus themes no longer provide that option but instead
offer this piece of documentation to make the user fully aware of the
state of affairs.
-** Remap face with local value
+Reload the theme for changes to take effect.
+
+** DIY Remap face with local value
:properties:
:custom_id: h:7a93cb6f-4eca-4d56-a85c-9dcd813d6b0f
:end:
@@ -2954,12 +2876,17 @@ Perhaps you may wish to generalize those findings in to
a set of
functions that also accept an arbitrary face. We shall leave the
experimentation up to you.
-** Font configurations for Org and others
+Reload the theme for changes to take effect.
+
+** DIY Font configurations for Org and others
:properties:
:custom_id: h:defcf4fc-8fa8-4c29-b12e-7119582cc929
:end:
#+cindex: Font configurations
+[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos)
+ for all font-related configurations. ]
+
The themes are designed to optionally cope well with mixed font
configurations. This mostly concerns ~org-mode~ and ~markdown-mode~, though
expect to find it elsewhere like in ~Info-mode~.
@@ -2979,9 +2906,6 @@ the ~variable-pitch~ (proportional spacing) and
~fixed-pitch~ (monospaced)
faces respectively. It may also be convenient to set your main typeface
by configuring the ~default~ face the same way.
-[ The ~fontaine~ package on GNU ELPA (by Protesilaos) is designed to
- handle this case. ]
-
Put something like this in your initialization file (also consider
reading the doc string of ~set-face-attribute~):
@@ -3023,12 +2947,15 @@ absolute height).
[[#h:e6c5451f-6763-4be7-8fdb-b4706a422a4c][Note for EWW and Elfeed fonts]].
-** Configure bold and italic faces
+** DIY Configure bold and italic faces
:properties:
:custom_id: h:2793a224-2109-4f61-a106-721c57c01375
:end:
#+cindex: Bold and italic fonts
+[ Consider using the ~fontaine~ package from GNU ELPA (by Protesilaos)
+ for all font-related configurations. ]
+
The Modus themes do not hardcode a ~:weight~ or ~:slant~ attribute in the
thousands of faces they cover. Instead, they configure the generic
faces called ~bold~ and ~italic~ to use the appropriate styles and then
@@ -3082,12 +3009,12 @@ To reset the font family, one can use this:
#+end_src
To ensure that the effects persist after switching between the Modus
-themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user needs to
-write their configurations to a function and pass it to the
-~modus-themes-after-load-theme-hook~. This is necessary because themes
-set the styles of faces upon activation, overriding prior values where
-conflicts occur between the previous and the current states (otherwise
-changing themes would not be possible).
+themes (such as with {{{kbd(M-x modus-themes-toggle)}}}), the user
+needs to write their configurations to a function and pass it to the
+~modus-themes-after-load-theme-hook~
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enable and load]]). This is
+necessary because themes set the styles of faces upon activation,
+overriding prior values where conflicts occur between the previous and
+the current states (otherwise changing themes would not be possible).
[[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme
loading]].
@@ -3100,14 +3027,14 @@ of the themes, which can make it easier to redefine
faces in bulk).
#+begin_src emacs-lisp
;; our generic function
-(defun my-modes-themes-bold-italic-faces ()
+(defun my-modes-themes-bold-italic-faces (&rest _)
(set-face-attribute 'default nil :family "Source Code Pro" :height 110)
(set-face-attribute 'bold nil :weight 'semibold))
;; or use this if you configure a lot of face and attributes and
;; especially if you plan to use `modus-themes-with-colors', as shown
;; elsewhere in the manual
-(defun my-modes-themes-bold-italic-faces ()
+(defun my-modes-themes-bold-italic-faces (&rest _)
(custom-set-faces
'(default ((t :family "Source Code Pro" :height 110)))
'(bold ((t :weight semibold)))))
@@ -3118,7 +3045,11 @@ of the themes, which can make it easier to redefine
faces in bulk).
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
-** Custom Org todo keyword and priority faces
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
+Reload the theme for changes to take effect.
+
+** DIY Custom Org todo keyword and priority faces
:properties:
:custom_id: h:89f0678d-c5c3-4a57-a526-668b2bb2d7ad
:end:
@@ -3207,7 +3138,7 @@ it if you plan to control face attributes.
[[#h:02e25930-e71a-493d-828a-8907fc80f874][Check color combinations]].
-** Custom Org emphasis faces
+** DIY Custom Org emphasis faces
:properties:
:custom_id: h:26026302-47f4-4471-9004-9665470e7029
:end:
@@ -3229,7 +3160,7 @@ specification of that variable looks like this:
With the exception of ~org-verbatim~ and ~org-code~ faces, everything else
uses the corresponding type of emphasis: a bold typographic weight, or
-italicized, underlined, and struck through text.
+italicised, underlined, and struck through text.
The best way for users to add some extra attributes, such as a
foreground color, is to define their own faces and assign them to the
@@ -3340,49 +3271,97 @@ styled by the themes, it probably is best not to edit
them:
That's it! For changes to take effect in already visited Org files,
invoke {{{kbd(M-x org-mode-restart)}}}.
-** Update Org block delimiter fontification
-:properties:
-:custom_id: h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50
-:end:
+** DIY Use colored Org source blocks per language
+:PROPERTIES:
+:CUSTOM_ID: h:8c842804-43b7-4287-b4e9-8c07d04d1f89
+:END:
-As noted in the section about ~modus-themes-org-blocks~, Org contains a
-variable that determines whether the block's begin and end lines are
-extended to the edge of the window
([[#h:b7e328c0-3034-4db7-9cdf-d5ba12081ca2][Option for org-mode block styles]]).
-The variable is ~org-fontify-whole-block-delimiter-line~.
+[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][DIY Make Org block colors more or
less colorful]].
-Users who change the style of Org blocks from time to time may prefer to
-automatically update delimiter line fontification, such as with the
-following setup:
+In versions of the Modus themes before =4.4.0= there was an option to
+change the coloration of Org source blocks so that certain languages
+would have a distinctly colored background. This was not flexible
+enough, because (i) we cannot cover all languages effectively and (ii)
+the user had no choice over the =language --> color= mapping.
-#+begin_src emacs-lisp
-(defun my-modus-themes-org-fontify-block-delimiter-lines ()
- "Match `org-fontify-whole-block-delimiter-line' to theme style.
-Run this function at the post theme load phase, such as with the
-`modus-themes-after-load-theme-hook'."
- (if (eq modus-themes-org-blocks 'gray-background)
- (setq org-fontify-whole-block-delimiter-line t)
- (setq org-fontify-whole-block-delimiter-line nil)))
+As such, the old user option is no more. Users can use the following
+to achieve what they want:
-(add-hook 'modus-themes-after-load-theme-hook
- #'my-modus-themes-org-fontify-block-delimiter-lines)
+[ All this is done by setting the Org user option ~org-src-block-faces~,
+ so it is not related to the palette overrides mechanism provided by
+ the Modus themes. ]
+
+#+begin_src emacs-lisp
+(defun my-modus-themes-org-block-faces (&rest _)
+ (modus-themes-with-colors
+ ;; The `org-src-block-faces' does not get re-applied in existing
+ ;; Org buffers. Do M-x org-mode-restart for changes to take
+ ;; effect.
+ (setq org-src-block-faces
+ `(("emacs-lisp" modus-themes-nuanced-magenta)
+ ("elisp" modus-themes-nuanced-magenta)
+ ("clojure" modus-themes-nuanced-magenta)
+ ("clojurescript" modus-themes-nuanced-magenta)
+ ("c" modus-themes-nuanced-blue)
+ ("c++" modus-themes-nuanced-blue)
+ ("sh" modus-themes-nuanced-yellow)
+ ("shell" modus-themes-nuanced-yellow)
+ ("python" modus-themes-nuanced-yellow)
+ ("ipython" modus-themes-nuanced-yellow)
+ ("r" modus-themes-nuanced-yellow)
+ ("html" modus-themes-nuanced-green)
+ ("xml" modus-themes-nuanced-green)
+ ("css" modus-themes-nuanced-red)
+ ("scss" modus-themes-nuanced-red)
+ ("yaml" modus-themes-nuanced-cyan)
+ ("conf" modus-themes-nuanced-cyan)
+ ("docker" modus-themes-nuanced-cyan)))))
+
+(add-hook 'modus-themes-after-load-theme-hook
#'my-modus-themes-org-block-faces)
#+end_src
-Then {{{kbd(M-x org-mode-restart)}}} for changes to take effect, though manual
-intervention can be circumvented by tweaking the function thus:
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][DIY Use a hook at the
post-load-theme phase]].
+
+Note that the ~org-src-block-faces~ accepts a named face, as shown
+above, as well as a list of face attributes. The latter approach is
+not good enough because it hardcodes values in such a way that an
+~org-mode-restart~ is necessary. Whereas the indirection of the named
+face lets the theme change the values while Org buffers continue to
+show the right colors.
+
+Still, if a user prefers to hardcode face attributes, here is the
+idea:
#+begin_src emacs-lisp
-(defun my-modus-themes-org-fontify-block-delimiter-lines ()
- "Match `org-fontify-whole-block-delimiter-line' to theme style.
-Run this function at the post theme load phase, such as with the
-`modus-themes-after-load-theme-hook'."
- (if (eq modus-themes-org-blocks 'gray-background)
- (setq org-fontify-whole-block-delimiter-line t)
- (setq org-fontify-whole-block-delimiter-line nil))
- (when (derived-mode-p 'org-mode)
- (font-lock-flush)))
+;; This is for the sake of completeness. I DO NOT RECOMMEND THIS
+;; method because it hardcodes values and thus requires
+;; `org-mode-restart' every time you change a theme.
+(defun my-modus-themes-org-block-faces (&rest _)
+ (modus-themes-with-colors
+ (setq org-src-block-faces
+ `(("emacs-lisp" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("elisp" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("clojure" (:inherit org-block :background ,bg-magenta-nuanced))
+ ("clojurescript" (:inherit org-block :background
,bg-magenta-nuanced))
+ ("c" (:inherit org-block :background ,bg-blue-nuanced))
+ ("c++" (:inherit org-block :background ,bg-blue-nuanced))
+ ("sh" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("shell" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("python" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("ipython" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("r" (:inherit org-block :background ,bg-yellow-nuanced))
+ ("html" (:inherit org-block :background ,bg-green-nuanced))
+ ("xml" (:inherit org-block :background ,bg-green-nuanced))
+ ("css" (:inherit org-block :background ,bg-red-nuanced))
+ ("scss" (:inherit org-block :background ,bg-red-nuanced))
+ ("yaml" (:inherit org-block :background ,bg-cyan-nuanced))
+ ("conf" (:inherit org-block :background ,bg-cyan-nuanced))
+ ("docker" (:inherit org-block :background ,bg-cyan-nuanced))))))
+
+(add-hook 'modus-themes-after-load-theme-hook
#'my-modus-themes-org-block-faces)
#+end_src
-** Measure color contrast
+** DIY Measure color contrast
:properties:
:custom_id: h:02e25930-e71a-493d-828a-8907fc80f874
:end:
@@ -3455,7 +3434,7 @@ minutia and relevant commentary.
Such knowledge may prove valuable while attempting to customize the
theme's color palette.
-** Load theme depending on time of day
+** DIY Load theme depending on time of day
:properties:
:custom_id: h:1d1ef4b4-8600-4a09-993c-6de3af0ddd26
:end:
@@ -3483,7 +3462,7 @@ the ~circadian~ package:
(circadian-setup))
#+end_src
-** Backdrop for pdf-tools
+** DIY Backdrop for pdf-tools
:properties:
:custom_id: h:ff69dfe1-29c0-447a-915c-b5ff7c5509cd
:end:
@@ -3504,7 +3483,7 @@ buffer-local value of the ~default~ face.
To remap the buffer's backdrop, we start with a function like this one:
#+begin_src emacs-lisp
-(defun my-pdf-tools-backdrop ()
+(defun my-pdf-tools-backdrop (&rest _)
(modus-themes-with-colors
(face-remap-add-relative
'default
@@ -3518,7 +3497,8 @@ The idea is to assign that function to a hook that gets
called when
when you only use one theme. However it has the downside of setting the
background color value only at render time. In other words, the face
remapping function does not get evaluated anew whenever the theme
-changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}.
+changes, such as upon invoking {{{kbd(M-x modus-themes-toggle)}}}
+([[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to
toggle]]).
To have our face remapping adapt gracefully while switching between the
Modus themes, we need to also account for the current theme and control
@@ -3526,20 +3506,20 @@ the activation of ~pdf-view-midnight-minor-mode~. To
which end we arrive
at something like the following, which builds on the above example:
#+begin_src emacs-lisp
-(defun my-pdf-tools-backdrop ()
+(defun my-pdf-tools-backdrop (&rest _)
(modus-themes-with-colors
(face-remap-add-relative
'default
`(:background ,bg-dim))))
-(defun my-pdf-tools-midnight-mode-toggle ()
+(defun my-pdf-tools-midnight-mode-toggle (&rest _)
(when (derived-mode-p 'pdf-view-mode)
(if (eq (car custom-enabled-themes) 'modus-vivendi)
(pdf-view-midnight-minor-mode 1)
(pdf-view-midnight-minor-mode -1))
(my-pdf-tools-backdrop)))
-(defun my-pdf-tools-themes-toggle ()
+(defun my-pdf-tools-themes-toggle (&rest _)
(mapc
(lambda (buf)
(with-current-buffer buf
@@ -3550,11 +3530,15 @@ at something like the following, which builds on the
above example:
(add-hook 'modus-themes-after-load-theme-hook #'my-pdf-tools-themes-toggle)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
With those in place, PDFs have a distinct backdrop for their page, while
buffers with major-mode as ~pdf-view-mode~ automatically switches to dark
mode when ~modus-themes-toggle~ is called.
-** Toggle themes without reloading them
+Reload the theme for changes to take effect.
+
+** DIY Toggle themes without reloading them
:properties:
:custom_id: h:b40aca50-a3b2-4c43-be58-2c26fcd14237
:end:
@@ -3583,58 +3567,7 @@ manual."
Recall that ~modus-themes-toggle~ uses ~load-theme~.
-** A theme-agnostic hook for theme loading
-:properties:
-:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
-:end:
-
-The themes are designed with the intent to be useful to Emacs users of
-varying skill levels, from beginners to experts. This means that we try
-to make things easier by not expecting anyone reading this document to
-be proficient in Emacs Lisp or programming in general.
-
-Such a case is with the use of ~modus-themes-after-load-theme-hook~,
-which runs after the ~modus-themes-load-theme~ function (used by the
-command ~modus-themes-toggle~). We recommend using that hook for
-advanced customizations, because (1) we know for sure that it is
-available once the themes are loaded, and (2) anyone consulting this
-manual, especially the sections on enabling and loading the themes,
-will be in a good position to benefit from that hook.
-
-Advanced users who have a need to switch between the Modus themes and
-other items will find that such a hook does not meet their requirements:
-it only works with the Modus themes and only with the aforementioned
-functions.
-
-A theme-agnostic setup can be configured thus:
-
-#+begin_src emacs-lisp
-(defvar after-enable-theme-hook nil
- "Normal hook run after enabling a theme.")
-
-(defun run-after-enable-theme-hook (&rest _args)
- "Run `after-enable-theme-hook'."
- (run-hooks 'after-enable-theme-hook))
-
-(advice-add 'enable-theme :after #'run-after-enable-theme-hook)
-#+end_src
-
-This creates the ~after-enable-theme-hook~ and makes it run after each
-call to ~enable-theme~, which means that it will work for all themes and
-also has the benefit that it does not depend on functions such as
-~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is
-called internally by ~load-theme~, so the hook works everywhere.
-
-The downside of the theme-agnostic hook is that any functions added to
-it will likely not be able to benefit from macro calls that read the
-active theme, such as ~modus-themes-with-colors~. Not all Emacs
-themes have the same capabilities.
-
-In this document, we cover ~modus-themes-after-load-theme-hook~ though
-the user can replace it with ~after-enable-theme-hook~ should they
-need to (provided they understand the implications).
-
-** Use more spacious margins or padding in Emacs frames
+** DIY Use more spacious margins or padding in Emacs frames
:PROPERTIES:
:CUSTOM_ID: h:43bcb5d0-e25f-470f-828c-662cee9e21f1
:END:
@@ -3687,7 +3620,7 @@ The reason we do this with a function is so we can hook
it to the
faces will no longer be invisible).
#+begin_src emacs-lisp
-(defun my-modus-themes-invisible-dividers ()
+(defun my-modus-themes-invisible-dividers (&rest _)
"Make window dividers invisible.
Add this to the `modus-themes-post-load-hook'."
(let ((bg (face-background 'default)))
@@ -3700,6 +3633,8 @@ Add this to the `modus-themes-post-load-hook'."
(add-hook 'modus-themes-post-load-hook #'my-modus-themes-invisible-dividers)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
The above will work only for themes that belong to the Modus family.
For users of Emacs version 29 or higher, there exists a theme-agnostic
hook that takes a function with one argument---that of the theme---and
@@ -3707,7 +3642,7 @@ calls in the the "post enable" phase of theme loading.
Here is the
above snippet, with the necessary tweaks:
#+begin_src emacs-lisp
-(defun my-modus-themes-invisible-dividers (_theme)
+(defun my-modus-themes-invisible-dividers (&rest _)
"Make window dividers for THEME invisible."
(let ((bg (face-background 'default)))
(custom-set-faces
@@ -3722,7 +3657,7 @@ above snippet, with the necessary tweaks:
Users of older versions of Emacs can read the entry herein about
defining their own theme-agnostic hook
([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][A theme-agnostic hook for theme
loading]]).
-** Custom hl-todo colors
+** DIY Custom hl-todo colors
:PROPERTIES:
:CUSTOM_ID: h:2ef83a21-2f0a-441e-9634-473feb940743
:END:
@@ -3735,7 +3670,7 @@ may still prefer to apply their custom values, in which
case the
following approach is necessary:
#+begin_src emacs-lisp
-(defun my-modus-themes-hl-todo-faces ()
+(defun my-modus-themes-hl-todo-faces (&rest _)
(setq hl-todo-keyword-faces '(("TODO" . "#ff0000")
("HACK" . "#ffff00")
("XXX" . "#00ffff")
@@ -3744,10 +3679,12 @@ following approach is necessary:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
Or include a ~let~ form, if needed:
#+begin_src emacs-lisp
-(defun my-modus-themes-hl-todo-faces ()
+(defun my-modus-themes-hl-todo-faces (&rest _)
(let ((red "#ff0000")
(blue "#0000ff"))
(setq hl-todo-keyword-faces `(("TODO" . ,blue)
@@ -3758,10 +3695,14 @@ Or include a ~let~ form, if needed:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-hl-todo-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
Normally, we do not touch user options, though this is an exception:
otherwise the defaults are not always legible.
-** Add support for solaire-mode
+Reload the theme for changes to take effect.
+
+** DIY Add support for solaire-mode
:PROPERTIES:
:CUSTOM_ID: h:439c9e46-52e2-46be-b1dc-85841dd99671
:END:
@@ -3806,7 +3747,7 @@ on what we cover at length elsewhere in this manual:
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
`(solaire-default-face ((,c :inherit default :background ,bg-dim
:foreground ,fg-dim)))
@@ -3817,7 +3758,106 @@ on what we cover at length elsewhere in this manual:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
-As always, re-load the theme for changes to take effect.
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
+Reload the theme for changes to take effect.
+
+** DIY Use a hook at the post-load-theme phase
+:PROPERTIES:
+:CUSTOM_ID: h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24
+:END:
+
+Many of the Do-It-Yourself (DIY) snippets provided herein make use of
+a hook to apply the desired changes. In most examples, this hook is
+the ~modus-themes-after-load-theme-hook~ (alias ~modus-themes-post-load-hook~).
+This hook is provided by the Modus themes and is called at the end of
+one the following:
+
+- Command ~modus-themes-toggle~ ::
[[#h:4fbfed66-5a89-447a-a07d-a03f6819c5bd][Option for which themes to toggle]].
+
+- Command ~modus-themes-select~ :: Select a Modus theme using minibuffer
+ completion and then load it.
+
+- Function ~modus-themes-load-theme~ :: Called only from Lisp, such as
+ in the user's init file, with the quoted symbol of a Modus theme as
+ an argument ([[#h:adb0c49a-f1f9-4690-868b-013a080eed68][Option for disabling
other themes while loading Modus]]).
+ This function is used internally by ~modus-themes-toggle~ and
+ ~modus-themes-select~.
+
+Users who switch between themes that are not limited to the Modus
+collection cannot benefit from the aforementioned hook: it only works
+with the Modus themes. A theme-agnostic hook is needed in such a case.
+Before Emacs 29, this had to be set up manually
([[#h:86f6906b-f090-46cc-9816-1fe8aeb38776][DIY A theme-agnostic hook for theme
loading]]).
+Starting with Emacs 29, the special hook ~enable-theme-functions~
+works with anything that uses the basic ~enable-theme~ function.
+
+To use the ~enable-theme-functions~ just add the given function to it
+the way it is done with every hook:
+
+#+begin_src emacs-lisp
+(add-hook 'enable-theme-functions 'MY-FUNCTION-HERE)
+#+end_src
+
+Functions added to ~enable-theme-functions~ accept a single =THEME=
+argument. The examples shown in this manual use the pattern =(&rest
+_)=, which is how a function accepts one or more arguments but
+declares it will not use them (in plain terms, the code works with or
+without ~enable-theme-functions~).
+
+*** DIY A theme-agnostic hook for theme loading
+:properties:
+:custom_id: h:86f6906b-f090-46cc-9816-1fe8aeb38776
+:end:
+
+[ NOTE: The following is for versions of Emacs before 29. For Emacs 29
+ or higher, users can rely on the built-in ~enable-theme-functions~
+ ([[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the
post-load-theme phase]]). ]
+
+The themes are designed with the intent to be useful to Emacs users of
+varying skill levels, from beginners to experts. This means that we try
+to make things easier by not expecting anyone reading this document to
+be proficient in Emacs Lisp or programming in general.
+
+Such a case is with the use of ~modus-themes-after-load-theme-hook~,
+which runs after the ~modus-themes-load-theme~ function (used by the
+command ~modus-themes-toggle~). We recommend using that hook for
+advanced customizations, because (1) we know for sure that it is
+available once the themes are loaded, and (2) anyone consulting this
+manual, especially the sections on enabling and loading the themes,
+will be in a good position to benefit from that hook.
+
+Advanced users who have a need to switch between the Modus themes and
+other items will find that such a hook does not meet their requirements:
+it only works with the Modus themes and only with the aforementioned
+functions.
+
+A theme-agnostic setup can be configured thus:
+
+#+begin_src emacs-lisp
+(defvar after-enable-theme-hook nil
+ "Normal hook run after enabling a theme.")
+
+(defun run-after-enable-theme-hook (&rest _args)
+ "Run `after-enable-theme-hook'."
+ (run-hooks 'after-enable-theme-hook))
+
+(advice-add 'enable-theme :after #'run-after-enable-theme-hook)
+#+end_src
+
+This creates the ~after-enable-theme-hook~ and makes it run after each
+call to ~enable-theme~, which means that it will work for all themes and
+also has the benefit that it does not depend on functions such as
+~modus-themes-toggle~ and the others mentioned above. ~enable-theme~ is
+called internally by ~load-theme~, so the hook works everywhere.
+
+The downside of the theme-agnostic hook is that any functions added to
+it will likely not be able to benefit from macro calls that read the
+active theme, such as ~modus-themes-with-colors~. Not all Emacs
+themes have the same capabilities.
+
+In this document, we cover ~modus-themes-after-load-theme-hook~ though
+the user can replace it with ~after-enable-theme-hook~ should they
+need to (provided they understand the implications).
* Face coverage
:properties:
@@ -3882,7 +3922,9 @@ have lots of extensions, so the "full support" may not be
100% true…
+ custom (what you get with {{{kbd(M-x customize)}}})
+ dashboard
+ deadgrep
++ debbugs
+ deft
++ denote
+ devdocs
+ dictionary
+ diff-hl
@@ -3978,6 +4020,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ marginalia
+ markdown-mode
+ markup-faces (~adoc-mode~)
++ mct
+ messages
+ minimap
+ mode-line
@@ -4089,6 +4132,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ xterm-color (and ansi-colors)
+ yaml-mode
+ yasnippet
++ ztree
Plus many other miscellaneous faces that are provided by Emacs.
@@ -4213,7 +4257,7 @@ length elsewhere in this manual:
[[#h:51ba3547-b8c8-40d6-ba5a-4586477fd4ae][Use theme colors in code with
modus-themes-with-colors]].
#+begin_src emacs-lisp
-(defun my-modus-themes-custom-faces ()
+(defun my-modus-themes-custom-faces (&rest _)
(modus-themes-with-colors
(custom-set-faces
;; Make foreground the same as background for a uniform bar on
@@ -4229,6 +4273,8 @@ length elsewhere in this manual:
(add-hook 'modus-themes-after-load-theme-hook #'my-modus-themes-custom-faces)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
As always, re-load the theme for changes to take effect.
If the above does not work, try this instead:
@@ -4260,7 +4306,7 @@ multiline comments in PHP with the ~php-mode~ package use
the
This seems to make all comments use the appropriate face:
#+begin_src emacs-lisp
-(defun my-multine-comments ()
+(defun my-multine-comments (&rest _)
(setq-local c-doc-face-name 'font-lock-comment-face))
(add-hook 'php-mode-hook #'my-multine-comments)
@@ -4396,7 +4442,7 @@ advanced customization options of the themes.
[[#h:f4651d55-8c07-46aa-b52b-bed1e53463bb][Advanced customization]].
In the following example, we are assuming that the user wants to (i)
-reuse color variables provided by the themes, (ii) be able to retain
+re-use color variables provided by the themes, (ii) be able to retain
their tweaks while switching between ~modus-operandi~ and ~modus-vivendi~,
and (iii) have the option to highlight either the foreground of the
parentheses or the background as well.
@@ -4416,7 +4462,7 @@ Then we can update our preference with this:
(setq my-highlight-parentheses-use-background nil)
#+end_src
-To reuse colors from the themes, we must wrap our code in the
+To re-use colors from the themes, we must wrap our code in the
~modus-themes-with-colors~ macro. Our implementation must interface with
the variables ~highlight-parentheses-background-colors~ and/or
~highlight-parentheses-colors~.
@@ -4472,7 +4518,7 @@ implementation:
(setq my-highlight-parentheses-use-background nil) ; Set to nil to disable
backgrounds
-(defun my-modus-themes-highlight-parentheses ()
+(defun my-modus-themes-highlight-parentheses (&rest _)
(modus-themes-with-colors
;; Our preference for setting either background or foreground
;; styles, depending on `my-highlight-parentheses-use-background'.
@@ -4507,6 +4553,8 @@ implementation:
(add-hook 'modus-themes-after-load-theme-hook
#'my-modus-themes-highlight-parentheses)
#+end_src
+[[#h:d87673fe-2ce1-4c80-a4b8-be36ca9f2d24][Using a hook at the post-load-theme
phase]].
+
As always, re-load the theme for changes to take effect.
** Note on mmm-mode.el background colors
@@ -5026,7 +5074,7 @@ more effective than trying to do the same with either red
or blue (the
latter is the least effective in that regard).
When we need to work with several colors, it is always better to have
-sufficient maneuvering space, especially since we cannot pick arbitrary
+sufficient manoeuvring space, especially since we cannot pick arbitrary
colors but only those that satisfy the accessibility objectives of the
themes.
@@ -5080,7 +5128,7 @@ each of the three channels of light (red, green, blue).
For example:
: xrandr --output LVDS1 --brightness 1.0 --gamma 0.76:0.75:0.68
Typography is another variable. Some font families are blurry at small
-point sizes. Others may have a regular weight that is lighter (thinner)
+point sizes. Others may have a regular weight that is lighter (thiner)
than that of their peers which may, under certain circumstances, cause a
halo effect around each glyph.
@@ -5132,7 +5180,7 @@ it is already understood that one must follow the
indicator or headline
to view its contents and (ii) underlining everything would make the
interface virtually unusable.
-Again, one must exercise judgment in order to avoid discrimination,
+Again, one must exercise judgement in order to avoid discrimination,
where "discrimination" refers to:
+ The treatment of substantially different magnitudes as if they were of
@@ -5206,7 +5254,7 @@ the themes, which is partially fleshed out in this manual.
With regard to the artistic aspect (where "art" qua skill may amount to
an imprecise science), there is no hard-and-fast rule in effect as it
-requires one to exercise discretion and make decisions based on
+requires one to exercize discretion and make decisions based on
context-dependent information or constraints. As is true with most
things in life, when in doubt, do not cling on to the letter of the law
but try to understand its spirit.
@@ -5356,12 +5404,12 @@ The Modus themes are a collective effort. Every bit of
work matters.
Daniel Mendler, David Edmondson, Eli Zaretskii, Fritz Grabo, Gautier
Ponsinet, Illia Ostapyshyn, Kévin Le Gouguec, Koen van Greevenbroek,
Kostadin Ninev, Madhavan Krishnan, Manuel Giraud, Markus Beppler,
- Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Nicolas De
- Jaeghere, Paul David, Philip Kaludercic, Pierre Téchoueyres, Rudolf
- Adamkovič, Sergey Nichiporchik, Shreyas Ragavan, Stefan Kangas,
- Stephen Berman, Stephen Gildea, Steve Downey, Tomasz Hołubowicz,
- Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen Xie, fluentpwn,
- okamsn.
+ Matthew Stevenson, Mauro Aranda, Nacho Barrientos, Niall Dooley,
+ Nicolas De Jaeghere, Paul David, Philip Kaludercic, Pierre
+ Téchoueyres, Rudolf Adamkovič, Sergey Nichiporchik, Shreyas Ragavan,
+ Stefan Kangas, Stephen Berman, Stephen Gildea, Steve Downey, Tomasz
+ Hołubowicz, Utkarsh Singh, Vincent Murphy, Xinglu Chen, Yuanchen
+ Xie, fluentpwn, okamsn.
+ Ideas and user feedback :: Aaron Jensen, Adam Porter, Adam Spiers,
Adrian Manea, Aleksei Pirogov, Alex Griffin, Alex Koen, Alex
@@ -5376,13 +5424,13 @@ The Modus themes are a collective effort. Every bit of
work matters.
Gonçalo Marrafa, Guilherme Semente, Gustavo Barros, Hörmetjan
Yiltiz, Ilja Kocken, Imran Khan, Iris Garcia, Ivan Popovych, James
Ferguson, Jeremy Friesen, Jerry Zhang, Johannes Grødem, John Haman,
- Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C. Villasante,
- Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin Kainan Li,
- Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg, Lennart
- C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Giraud, Manuel
- Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic, Markus
- Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård, Mauro
- Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan
+ John Wick, Jonas Collberg, Jorge Morais, Joshua O'Connor, Julio C.
+ Villasante, Kenta Usami, Kevin Fleming, Kévin Le Gouguec, Kevin
+ Kainan Li, Kostadin Ninev, Laith Bahodi, Lasse Lindner, Len Trigg,
+ Lennart C.{{{space()}}} Karssen, Luis Miguel Castañeda, Magne Hov, Manuel
Giraud,
+ Manuel Uberti, Mark Bestley, Mark Burton, Mark Simpson, Marko Kocic,
+ Markus Beppler, Matt Armstrong, Matthias Fuchs, Mattias Engdegård,
+ Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan
Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere,
Nicolas Semrau, Olaf Meeuwissen, Oliver Epper, Pablo Stafforini,
Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip
@@ -5392,11 +5440,12 @@ The Modus themes are a collective effort. Every bit of
work matters.
Ragavan, Simon Pugnet, Steve Downey, Tassilo Horn, Thanos Apollo,
Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman, Trey
Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh Singh,
- Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1,
+ Vincent Foley, Zoltan Kiraly. As well as users: Ben, CsBigDataHub1,
Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer
Emacs, TheBlob42, TitusMu, Trey, bepolymathe, bit9tream,
bangedorrunt, derek-upham, doolio, fleimgruber, gitrj95, iSeeU,
- jixiuf, okamsn, pRot0ta1p, soaringbird, tumashu, wakamenod.
+ jixiuf, ltmsyvag, okamsn, pRot0ta1p, soaringbird, tumashu,
+ wakamenod.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index f76edc6b1e4..3a6486903bf 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -31,7 +31,7 @@ General Public License for more details.
@finalout
@titlepage
@title Transient User and Developer Manual
-@subtitle for version 0.5.2
+@subtitle for version 0.6.0
@author Jonas Bernoulli
@page
@vskip 0pt plus 1filll
@@ -53,7 +53,7 @@ resource to get over that hurdle is Psionic K's interactive
tutorial,
available at @uref{https://github.com/positron-solutions/transient-showcase}.
@noindent
-This manual is for Transient version 0.5.2.
+This manual is for Transient version 0.6.0.
@insertcopying
@end ifnottex
@@ -554,7 +554,7 @@ state, you have to make sure that that state is currently
active.
@item @kbd{C-x a} (@code{transient-toggle-level-limit})
@kindex C-x a
@findex transient-toggle-level-limit
-This command toggle whether suffixes that are on levels lower than
+This command toggle whether suffixes that are on levels higher than
the level specified by @code{transient-default-level} are temporarily
available anyway.
@end table
@@ -1206,9 +1206,19 @@ The returned children must have the same form as stored
in the
prefix's @code{transient--layout} property, but it is often more convenient
to use the same form as understood by @code{transient-define-prefix},
described below. If you use the latter approach, you can use the
-@code{transient-parse-child} and @code{transient-parse-children} functions to
+@code{transient-parse-suffixes} and @code{transient-parse-suffix} functions to
transform them from the convenient to the expected form.
+If you explicitly specify children and then transform them using
+@code{:setup-chilren}, then the class of the group is determined as usual,
+based on explicitly specified children.
+
+If you do not explicitly specify children and thus rely solely on
+@code{:setup-children}, then you must specify the class using @code{:class}.
+For backward compatibility, if you fail to do so, @code{transient-column}
+is used and a warning is displayed. This warning will eventually
+be replaced with an error.
+
@item
The boolean @code{:pad-keys} argument controls whether keys of all suffixes
contained in a group are right padded, effectively aligning the
@@ -1220,11 +1230,11 @@ The @var{ELEMENT}s are either all subgroups, or all
suffixes and strings.
subgroups with commands at the same level, though in principle there
is nothing that prevents that.)
-If the @var{ELEMENT}s are not subgroups, then they can be a mixture of lists
-that specify commands and strings. Strings are inserted verbatim into
-the buffer. The empty string can be used to insert gaps between
-suffixes, which is particularly useful if the suffixes are outlined as
-a table.
+If the @var{ELEMENT}s are not subgroups, then they can be a mixture of
+lists, which specify commands, and strings. Strings are inserted
+verbatim into the buffer. The empty string can be used to insert gaps
+between suffixes, which is particularly useful if the suffixes are
+outlined as a table.
Inside group specifications, including inside contained suffix
specifications, nothing has to be quoted and quoting anyway is
diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index a4f2ed29d93..dd5b70cf32f 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -554,12 +554,19 @@ the object after this object; otherwise append to
@var{table}. This
also updates the displayed table.
@end defun
-@defun vtable-update-object table object old-object
-Change @var{old-object} into @var{object} in @var{table}. This also
-updates the displayed table.
+@defun vtable-update-object table object &optional old-object
+Update @var{object}'s representation in @var{table}. Optional argument
+@var{old-object}, if non-@code{nil}, means to replace @var{old-object}
+with @var{object} and redisplay the associated row in the table. In
+either case, if the existing object is not found in the table (being
+compared with @code{equal}), signal an error.
This has the same effect as calling @code{vtable-remove-object} and
then @code{vtable-insert-object}, but is more efficient.
+
+Note a limitation: if the table's buffer is not in a visible window, or
+if its window has changed width since it was updated, updating the table
+is not possible, and an error is signaled.
@end defun
@defun vtable-column table index
diff --git a/etc/NEWS b/etc/NEWS
index 19cd170e5c7..19588fe8eeb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -108,6 +108,12 @@ to your init:
* Changes in Emacs 30.1
+** 'describe-function' now shows the type of the function object.
+The text used to say things like "car is is a built-in function"
+whereas it now says "car is a primitive-function" where "primitive-function"
+is the symbol returned by `cl-type-of` and you can click on it to get
+information about that type.
+
** 'advice-remove' is now an interactive command.
When called interactively, 'advice-remove' now prompts for an advised
function to the advice to remove.
@@ -283,8 +289,21 @@ right-aligned to is controlled by the new user option
It specifies whether the window of the displayed buffer should be
selected or deselected at the end of executing the current command.
++++
+*** New variable 'window-restore-killed-buffer-windows'.
+It specifies how 'set-window-configuration' and 'window-state-put'
+should proceed with windows whose buffer was killed after the
+corresponding configuration or state was recorded.
+
** Tab Bars and Tab Lines
+---
+*** New user option 'tab-bar-select-restore-windows'.
+It defines what to do with windows whose buffer was killed
+since the tab was last selected. By default it displays
+a placeholder buffer that provides information about the name
+of the killed buffer that was displayed in that window.
+
---
*** New user option 'tab-bar-tab-name-format-functions'.
It can be used to add, remove and reorder functions that change
@@ -686,6 +705,12 @@ marked or clicked on files according to the OS
conventions. For
example, on systems supporting XDG, this runs 'xdg-open' on the
files.
+*** The default value of 'dired-omit-size-limit' was increased.
+After performance improvements to omitting in large directories, the new
+default value is 300k, up from 100k. This means 'dired-omit-mode' will
+omit files in directories whose directory listing is up to 300 kilobytes
+in size.
+
+++
*** 'dired-listing-switches' handles connection-local values if exist.
This allows to customize different switches for different remote machines.
@@ -1041,6 +1066,24 @@ entries newer than the current page. To change the
behavior when
browsing from "historical" pages, you can customize
'eww-before-browse-history-function'.
++++
+*** 'eww-readable' now toggles display of the readable parts of a web page.
+When called interactively, 'eww-readable' toggles whether to display
+only the readable parts of a page or the full page. With a positive
+prefix argument, it always displays the readable parts, and with a zero
+or negative prefix, it always displays the full page.
+
++++
+*** New option 'eww-readable-urls'.
+This is a list of regular expressions matching the URLs where EWW should
+display only the readable parts by default. For more details, see
+"(eww) Basics" in the EWW manual.
+
+---
+*** New option 'eww-readable-adds-to-history'.
+When non-nil (the default), calling 'eww-readable' adds a new entry to
+the EWW page history.
+
** go-ts-mode
+++
@@ -1129,6 +1172,12 @@ distracting and easily confused with actual code, or a
significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Flyspell
+
+*** New user option 'flyspell-check-changes'.
+When non-nil, Flyspell mode spell-checks only words that you edited; it
+does not check unedited words just because you move point across them.
+
** JS mode.
The binding 'M-.' has been removed from the major mode keymaps in
'js-mode' and 'js-ts-mode', having it default to the global binding
@@ -1319,6 +1368,18 @@ without specifying a file, like this:
(notifications-notify
:title "I am playing music" :app-icon 'multimedia-player)
+** Image
+
++++
+*** Image :map property is now recomputed when image is transformed.
+Now images with clickable maps work as expected after you run commands
+such as `image-increase-size', `image-decrease-size', `image-rotate',
+`image-flip-horizontally', and `image-flip-vertically'.
+
++++
+*** New user option 'image-recompute-map-p'
+Set this option to nil to prevent Emacs from recomputing image maps.
+
** Image Dired
*** New user option 'image-dired-thumb-naming'.
@@ -1437,6 +1498,12 @@ This allows the user to customize the key selection
method, which can be
either by using a pop-up buffer or from the minibuffer. The pop-up
buffer method is the default, which preserves previous behavior.
+** Xwidget Webkit
+
++++
+*** New user option 'xwidget-webkit-disable-javascript'.
+This allows disabling JavaScript in xwidget Webkit sessions.
+
* New Modes and Packages in Emacs 30.1
@@ -1622,6 +1689,21 @@ values.
* Lisp Changes in Emacs 30.1
+** New function 'help-fns-function-name'.
+For named functions, it just returns the name and otherwise
+it returns a short "unique" string that identifies the function.
+In either case, the string is propertized so clicking on it gives
+further details.
+
+** New function 'cl-type-of'.
+This function is like 'type-of' except that it sometimes returns
+a more precise type. For example, for nil and t it returns 'null'
+and 'boolean' respectively, instead of just 'symbol'.
+
+** New function `primitive-function-p`.
+This is like `subr-primitive-p` except that it returns t only if the
+argument is a function rather than a special-form.
+
** Built-in types have now corresponding classes.
At the Lisp level, this means that things like (cl-find-class 'integer)
will now return a class object, and at the UI level it means that
@@ -1794,6 +1876,16 @@ styles to skip eager fontification of completion
candidates, which
improves performance. Such a Lisp program can then use the
'completion-lazy-hilit' function to fontify candidates just in time.
+** New primitive 'buffer-last-name'.
+It returns the name of a buffer before the last time it was renamed or
+killed.
+
+** New primitive 'marker-last-position'.
+It returns the last position of a marker in its buffer even if that
+buffer has been killed. ('marker-position' would return nil in that
+case.)
+
+
** Functions and variables to transpose sexps
+++
@@ -2153,6 +2245,15 @@ aforementioned functions:
(and (arrayp executing-kbd-macro)
(>= executing-kbd-macro-index (length executing-kbd-macro))))
++++
+** 'vtable-update-object' updates an existing object with just two arguments.
+It is now possible to update the representation of an object in a vtable
+by calling 'vtable-update-object' with just the vtable and the object as
+arguments. (Previously the 'old-object' argument was required which, in
+this case, would mean repeating the object in the argument list.) When
+replacing an object with a different one, passing both the new and old
+objects is still necessary.
+
* Changes in Emacs 30.1 on Non-Free Operating Systems
diff --git a/etc/themes/modus-operandi-deuteranopia-theme.el
b/etc/themes/modus-operandi-deuteranopia-theme.el
index 4d210b977eb..42479965300 100644
--- a/etc/themes/modus-operandi-deuteranopia-theme.el
+++ b/etc/themes/modus-operandi-deuteranopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-deuteranopia-theme.el --- Deuteranopia-optimized theme with
a white background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-blue-nuanced)
+ (fg-active-value blue-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -289,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
- (date-now blue-faint)
+ (date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done blue)
- (prose-macro magenta-cooler)
+ (prose-todo yellow-warmer)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula yellow-warmer)
+
(prose-tag magenta-faint)
- (prose-todo yellow-warmer)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 yellow-faint)
(rainbow-8 cyan)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-blue-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-cyan-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-blue-subtle)
+ (bg-search-rx-group-3 bg-yellow-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index b41d5491c2e..fb2ff99a74b 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-theme.el --- Elegant, highly legible theme with a white
background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -126,12 +125,12 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -210,6 +209,7 @@ which corresponds to a minimum contrast in relative
luminance of
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -239,6 +239,11 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -341,16 +346,29 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code green-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -364,6 +382,17 @@ which corresponds to a minimum contrast in relative
luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -372,10 +401,10 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -407,10 +436,10 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-tinted-theme.el
b/etc/themes/modus-operandi-tinted-theme.el
index 7e0ad3d7ea8..f112456034b 100644
--- a/etc/themes/modus-operandi-tinted-theme.el
+++ b/etc/themes/modus-operandi-tinted-theme.el
@@ -1,11 +1,11 @@
-;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a
light ocher background -*- lexical-binding:t -*-
+;;; modus-operandi-tinted-theme.el --- Elegant, highly legible theme with a
light ochre background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -44,7 +44,7 @@
;;;###theme-autoload
(deftheme modus-operandi-tinted
- "Elegant, highly legible theme with a light ocher background.
+ "Elegant, highly legible theme with a light ochre background.
Conforms with the highest legibility standard for color contrast
between background and foreground in any given piece of text,
which corresponds to a minimum contrast in relative luminance of
@@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#ffe8f0")
- (bg-green-nuanced "#e0f5e0")
- (bg-yellow-nuanced "#f9ead0")
- (bg-blue-nuanced "#ebebff")
- (bg-magenta-nuanced "#f6e7ff")
- (bg-cyan-nuanced "#e1f3fc")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative
luminance of
;;; Paren match
(bg-paren-match "#7fdfcf")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; General mappings
(fringe bg-dim)
- (cursor red)
+ (cursor red-intense)
- (keybind blue-cooler)
+ (keybind red)
(name magenta)
(identifier yellow-cooler)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code green-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative
luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-operandi-tritanopia-theme.el
b/etc/themes/modus-operandi-tritanopia-theme.el
index 968a6526ca3..56be8329784 100644
--- a/etc/themes/modus-operandi-tritanopia-theme.el
+++ b/etc/themes/modus-operandi-tritanopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-operandi-tritanopia-theme.el --- Tritanopia-optimized theme with a
white background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#ffddff")
(bg-cyan-subtle "#bfefff")
- (bg-red-nuanced "#fff1f0")
- (bg-green-nuanced "#ecf7ed")
- (bg-yellow-nuanced "#fff3da")
- (bg-blue-nuanced "#f3f3ff")
- (bg-magenta-nuanced "#fdf0ff")
- (bg-cyan-nuanced "#ebf6fa")
+ (bg-red-nuanced "#ffe8e8")
+ (bg-green-nuanced "#e0f6e0")
+ (bg-yellow-nuanced "#f8f0d0")
+ (bg-blue-nuanced "#ecedff")
+ (bg-magenta-nuanced "#f8e6f5")
+ (bg-cyan-nuanced "#e0f2fa")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#5fcfff")
+ (fg-paren-match fg-main)
(bg-paren-expression "#efd3f5")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-red-nuanced)
+ (fg-active-argument red-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan)
+
;;;; Code mappings
(builtin magenta)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro red-warmer)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done cyan)
- (prose-macro red-warmer)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
- (prose-tag fg-alt)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
+ (prose-table-formula red-cooler)
+
+ (prose-tag magenta-faint)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-red-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-cyan-subtle)
+ (bg-search-rx-group-3 bg-red-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index 44f25182a30..b776f12671e 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -1,12 +1,11 @@
;;; modus-themes.el --- Elegant, highly legible and customizable themes -*-
lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 4.3.0
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Version: 4.4.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -37,9 +36,7 @@
-(eval-when-compile
- (require 'cl-lib)
- (require 'subr-x))
+(eval-when-compile (require 'subr-x))
(defgroup modus-themes ()
"User options for the Modus themes.
@@ -66,11 +63,6 @@ deficiency (deuteranopia or tritanopia, respectively)."
:prefix "modus-themes-"
:tag "Modus Themes Faces")
-(make-obsolete-variable 'modus-themes-operandi-colors nil "4.0.0")
-(make-obsolete-variable 'modus-themes-vivendi-colors nil "4.0.0")
-(make-obsolete-variable 'modus-themes-version nil "4.0.0")
-(make-obsolete 'modus-themes-report-bug nil "4.0.0")
-
;;;; Custom faces
@@ -139,7 +131,7 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(dolist (scope '(current lazy))
+(dolist (scope '(current lazy replace))
(custom-declare-face
(intern (format "modus-themes-search-%s" scope))
nil (format "Search of type %s." scope)
@@ -147,15 +139,13 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(define-obsolete-variable-alias
- 'modus-themes-search-success
- 'modus-themes-search-current
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-search-success-lazy
- 'modus-themes-search-lazy
- "4.0.0")
+(dotimes (n 4)
+ (custom-declare-face
+ (intern (format "modus-themes-search-rx-group-%s" n))
+ nil (format "Search regexp group number %s." n)
+ :package-version '(modus-themes . "4.4.0")
+ :version "30.1"
+ :group 'modus-themes-faces))
(dolist (scope '(code macro verbatim))
(custom-declare-face
@@ -165,21 +155,6 @@ deficiency (deuteranopia or tritanopia, respectively)."
:version "30.1"
:group 'modus-themes-faces))
-(define-obsolete-variable-alias
- 'modus-themes-markup-code
- 'modus-themes-prose-code
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-markup-macro
- 'modus-themes-prose-macro
- "4.0.0")
-
-(define-obsolete-variable-alias
- 'modus-themes-markup-verbatim
- 'modus-themes-prose-verbatim
- "4.0.0")
-
(dotimes (n 9)
(custom-declare-face
(intern (format "modus-themes-heading-%d" n))
@@ -248,67 +223,6 @@ text should not be underlined as well) yet still blend in."
:version "30.1"
:group 'modus-themes-faces))
-(make-obsolete-variable 'modus-themes-reset-hard nil "4.0.0")
-(make-obsolete-variable 'modus-themes-subtle-neutral nil "4.0.0")
-(make-obsolete-variable 'modus-themes-intense-neutral nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-refine-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-active-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-red nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-green nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-yellow nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-blue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-magenta nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringe-cyan nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-red-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-green-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-yellow-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-blue-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-magenta-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-cyan-nuanced nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-calm nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-cold nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-mild nil "4.0.0")
-(make-obsolete-variable 'modus-themes-special-warm nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-refine-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-added nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-changed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-focus-removed nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diff-heading nil "4.0.0")
-(make-obsolete-variable 'modus-themes-pseudo-header nil "4.0.0")
-(make-obsolete-variable 'modus-themes-mark-symbol nil "4.0.0")
-(make-obsolete-variable 'modus-themes-hl-line nil "4.0.0")
-(make-obsolete-variable 'modus-themes-search-success-modeline nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-intense nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-subtle nil "4.0.0")
-(make-obsolete-variable 'modus-themes-grue-background-refine nil "4.0.0")
-(make-obsolete-variable 'modus-themes-link-broken nil "4.0.0")
-(make-obsolete-variable 'modus-themes-link-symlink nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-backdrop nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-active nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tab-inactive nil "4.0.0")
-(make-obsolete-variable 'modus-themes-completion-selected-popup nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-button nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-button-pressed nil "4.0.0")
-
;;;; Customization variables
@@ -331,8 +245,6 @@ consequences. The user must manually reload the theme."
:type 'boolean
:link '(info-link "(modus-themes) Custom reload theme"))
-(make-obsolete-variable 'modus-themes-inhibit-reload
'modus-themes-custom-auto-reload "4.0.0")
-
(defun modus-themes--set-option (sym val)
"Custom setter for theme related user options.
Will set SYM to VAL, and reload the current theme, unless
@@ -422,9 +334,6 @@ This is used by the command `modus-themes-toggle'."
:initialize #'custom-initialize-default
:group 'modus-themes)
-(make-obsolete-variable 'modus-themes-operandi-color-overrides nil "4.0.0")
-(make-obsolete-variable 'modus-themes-vivendi-color-overrides nil "4.0.0")
-
(defvaralias 'modus-themes-slanted-constructs 'modus-themes-italic-constructs)
(defcustom modus-themes-italic-constructs nil
@@ -477,8 +386,6 @@ Protesilaos))."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Mixed fonts"))
-(make-obsolete-variable 'modus-themes-intense-mouseovers nil "4.0.0")
-
(defconst modus-themes--weight-widget
'(choice :tag "Font weight (must be supported by the typeface)"
(const :tag "Unspecified (use whatever the default is)" nil)
@@ -611,51 +518,7 @@ and related user options."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Heading styles"))
-(make-obsolete-variable 'modus-themes-org-agenda nil "4.0.0")
-(make-obsolete-variable 'modus-themes-fringes nil "4.0.0")
-(make-obsolete-variable 'modus-themes-lang-checkers nil "4.0.0")
-
-(defcustom modus-themes-org-blocks nil
- "Set the overall style of Org code blocks, quotes, and the like.
-
-Nil (the default) means that the block has no background of its
-own: it uses the one that applies to the rest of the buffer. In
-this case, the delimiter lines have a gray color for their text,
-making them look exactly like all other Org properties.
-
-Option `gray-background' applies a subtle gray background to the
-block's contents. It also affects the begin and end lines of the
-block as they get another shade of gray as their background,
-which differentiates them from the contents of the block. All
-background colors extend to the edge of the window, giving the
-area a rectangular, \"blocky\" presentation. If the begin/end
-lines do not extend in this way, check the value of the Org user
-option `org-fontify-whole-block-delimiter-line'.
-
-Option `tinted-background' uses a colored background for the
-contents of the block. The exact color value will depend on the
-programming language and is controlled by the variable
-`org-src-block-faces' (refer to the theme's source code for the
-current association list). For this to take effect, the Org
-buffer needs to be restarted with `org-mode-restart'.
-
-Code blocks use their major mode's fontification (syntax
-highlighting) only when the variable `org-src-fontify-natively'
-is non-nil. While quote/verse blocks require setting
-`org-fontify-quote-and-verse-blocks' to a non-nil value."
- :group 'modus-themes
- :package-version '(modus-themes . "4.0.0")
- :version "30.1"
- :type '(choice
- (const :format "[%v] %t\n" :tag "No Org block background (default)"
nil)
- (const :format "[%v] %t\n" :tag "Subtle gray block background"
gray-background)
- (const :format "[%v] %t\n" :tag "Color-coded background per
programming language" tinted-background))
- :set #'modus-themes--set-option
- :initialize #'custom-initialize-default
- :link '(info-link "(modus-themes) Org mode blocks"))
-
-(make-obsolete-variable 'modus-themes-mode-line nil "4.0.0")
-(make-obsolete-variable 'modus-themes-diffs nil "4.0.0")
+(make-obsolete-variable 'modus-themes-org-blocks nil "4.4.0: Use palette
overrides")
(defcustom modus-themes-completions nil
"Control the style of completion user interfaces.
@@ -778,17 +641,6 @@ In user configuration files the form may look like this:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Command prompts"))
-(make-obsolete-variable 'modus-themes-subtle-line-numbers nil "4.0.0")
-(make-obsolete-variable 'modus-themes-markup nil "4.0.0")
-(make-obsolete-variable 'modus-themes-paren-match nil "4.0.0")
-(make-obsolete-variable 'modus-themes-syntax nil "4.0.0")
-(make-obsolete-variable 'modus-themes-links nil "4.0.0")
-(make-obsolete-variable 'modus-themes-region nil "4.0.0")
-(make-obsolete-variable 'modus-themes-deuteranopia nil "4.0.0")
-(make-obsolete-variable 'modus-themes-mail-citations nil "4.0.0")
-(make-obsolete-variable 'modus-themes-tabs-accented nil "4.0.0")
-(make-obsolete-variable 'modus-themes-box-buttons nil "4.0.0")
-
(defcustom modus-themes-common-palette-overrides nil
"Set palette overrides for all the Modus themes.
@@ -918,12 +770,13 @@ represents."
(fg-prompt cyan-faint)
- (prose-code olive)
+ (fg-prose-code olive)
+ (fg-prose-macro indigo)
+ (fg-prose-verbatim maroon)
+
(prose-done green-faint)
- (prose-macro indigo)
(prose-tag rust)
(prose-todo red-faint)
- (prose-verbatim maroon)
(rainbow-0 fg-main)
(rainbow-1 magenta)
@@ -983,17 +836,18 @@ Info node `(modus-themes) Option for palette overrides'.")
(keybind blue-intense)
(mail-cite-0 blue)
- (mail-cite-1 yellow)
- (mail-cite-2 green)
+ (mail-cite-1 yellow-cooler)
+ (mail-cite-2 green-warmer)
(mail-cite-3 magenta)
- (mail-part magenta-cooler)
- (mail-recipient cyan)
+ (mail-part cyan)
+ (mail-recipient magenta-cooler)
(mail-subject red-warmer)
(mail-other cyan-cooler)
(fg-prompt blue-intense)
- (prose-block red-faint)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter red-faint)
(prose-done green-intense)
(prose-metadata magenta-faint)
(prose-metadata-value blue-cooler)
@@ -1081,7 +935,7 @@ Info node `(modus-themes) Option for palette overrides'.")
(mail-other blue)
(prose-tag fg-dim)
- (prose-verbatim blue-cooler))
+ (fg-prose-verbatim blue-cooler))
"Preset of palette overrides with cooler colors.
This changes parts of the palette to use more blue and
@@ -1136,7 +990,7 @@ Info node `(modus-themes) Option for palette overrides'.")
(mail-subject blue-warmer)
(mail-other magenta-warmer)
- (prose-macro red-cooler)
+ (fg-prose-macro red-cooler)
(prose-tag fg-dim))
"Preset of palette overrides with warmer colors.
@@ -1162,14 +1016,22 @@ Info node `(modus-themes) Option for palette
overrides'.")
;;;; Helper functions for theme setup
;; This is the WCAG formula: https://www.w3.org/TR/WCAG20-TECHS/G18.html
+(defun modus-themes--wcag-contribution (channel weight)
+ "Return the CHANNEL contribution to overall luminance given WEIGHT."
+ (* weight
+ (if (<= channel 0.03928)
+ (/ channel 12.92)
+ (expt (/ (+ channel 0.055) 1.055) 2.4))))
+
(defun modus-themes-wcag-formula (hex)
"Get WCAG value of color value HEX.
The value is defined in hexadecimal RGB notation, such #123456."
- (cl-loop for k in '(0.2126 0.7152 0.0722)
- for x in (color-name-to-rgb hex)
- sum (* k (if (<= x 0.03928)
- (/ x 12.92)
- (expt (/ (+ x 0.055) 1.055) 2.4)))))
+ (let ((channels (color-name-to-rgb hex))
+ (weights '(0.2126 0.7152 0.0722))
+ contribution)
+ (while channels
+ (push (modus-themes--wcag-contribution (pop channels) (pop weights))
contribution))
+ (apply #'+ contribution)))
;;;###autoload
(defun modus-themes-contrast (c1 c2)
@@ -1179,32 +1041,27 @@ C1 and C2 are color values written in hexadecimal RGB."
(+ (modus-themes-wcag-formula c2) 0.05))))
(max ct (/ ct))))
-(make-obsolete 'modus-themes-color nil "4.0.0")
-(make-obsolete 'modus-themes-color-alts nil "4.0.0")
-
-(declare-function cl-remove-if-not "cl-seq" (cl-pred cl-list &rest cl-keys))
+(defun modus-themes--modus-p (theme)
+ "Return non-nil if THEME name has a modus- prefix."
+ (string-prefix-p "modus-" (symbol-name theme)))
(defun modus-themes--list-enabled-themes ()
"Return list of `custom-enabled-themes' with modus- prefix."
- (cl-remove-if-not
- (lambda (theme)
- (string-prefix-p "modus-" (symbol-name theme)))
- custom-enabled-themes))
+ (seq-filter #'modus-themes--modus-p custom-enabled-themes))
+
+(defun modus-themes--load-no-enable (theme)
+ "Load but do not enable THEME if it belongs to `custom-known-themes'."
+ (unless (memq theme custom-known-themes)
+ (load-theme theme :no-confirm :no-enable)))
(defun modus-themes--enable-themes ()
"Enable the Modus themes."
- (mapc (lambda (theme)
- (unless (memq theme custom-known-themes)
- (load-theme theme :no-confirm :no-enable)))
- modus-themes-items))
+ (mapc #'modus-themes--load-no-enable modus-themes-items))
(defun modus-themes--list-known-themes ()
"Return list of `custom-known-themes' with modus- prefix."
(modus-themes--enable-themes)
- (cl-remove-if-not
- (lambda (theme)
- (string-prefix-p "modus-" (symbol-name theme)))
- custom-known-themes))
+ (seq-filter #'modus-themes--modus-p custom-known-themes))
(defun modus-themes--current-theme ()
"Return first enabled Modus theme."
@@ -1311,10 +1168,6 @@ symbol, which is safe when used as a face attribute's
value."
;;;; Commands
-(make-obsolete 'modus-themes-load-themes nil "4.0.0")
-(make-obsolete 'modus-themes-load-operandi nil "4.0.0; Check
`modus-themes-load-theme'")
-(make-obsolete 'modus-themes-load-vivendi nil "4.0.0; Check
`modus-themes-load-theme'")
-
(defvar modus-themes--select-theme-history nil
"Minibuffer history of `modus-themes--select-prompt'.")
@@ -1322,7 +1175,9 @@ symbol, which is safe when used as a face attribute's
value."
"Return completion annotation for THEME."
(when-let ((symbol (intern-soft theme))
(doc-string (get symbol 'theme-documentation)))
- (format " -- %s" (car (split-string doc-string "\\.")))))
+ (format " -- %s"
+ (propertize (car (split-string doc-string "\\."))
+ 'face 'completions-annotations))))
(defun modus-themes--completion-table (category candidates)
"Pass appropriate metadata CATEGORY to completion CANDIDATES."
@@ -1486,8 +1341,7 @@ Check PROPERTIES for an alist value that corresponds to
ALIST-KEY. If no alist is present, search the PROPERTIES
list given LIST-PRED, using DEFAULT as a fallback."
(if-let* ((val (or (alist-get alist-key properties)
- (cl-loop for x in properties
- if (funcall list-pred x) return x)
+ (seq-filter (lambda (x) (funcall list-pred x)) properties)
default))
((listp val)))
(car val)
@@ -1535,7 +1389,7 @@ color that is combined with FG-FOR-BG."
:foreground fg
:weight
;; If we have `bold' specifically, we inherit the face of
- ;; the same name. This allows the user to customize that
+ ;; the same name. This allows the user to customise that
;; face, such as to change its font family.
(if (and weight (not (eq weight 'bold)))
weight
@@ -1581,16 +1435,6 @@ Optional OL is the color of an overline."
'unspecified)
:weight (or weight 'unspecified))))
-(defun modus-themes--org-block (fg bg)
- "Conditionally set the FG and BG of Org blocks."
- (let ((gray (or (eq modus-themes-org-blocks 'gray-background)
- (eq modus-themes-org-blocks 'grayscale) ; for backward
compatibility
- (eq modus-themes-org-blocks 'greyscale))))
- (list :inherit 'modus-themes-fixed-pitch
- :background (if gray bg 'unspecified)
- :foreground (if gray 'unspecified fg)
- :extend (if gray t 'unspecified))))
-
(defun modus-themes--completion-line (bg)
"Styles for `modus-themes-completions' with BG as the background."
(let* ((var (modus-themes--list-or-warn 'modus-themes-completions))
@@ -1723,12 +1567,18 @@ FG and BG are the main colors."
`(modus-themes-prominent-note ((,c :background ,bg-prominent-note
:foreground ,fg-prominent-note)))
`(modus-themes-prominent-warning ((,c :background ,bg-prominent-warning
:foreground ,fg-prominent-warning)))
;;;;; markup
- `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch
:foreground ,prose-code)))
- `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch
:foreground ,prose-macro)))
- `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch
:foreground ,prose-verbatim)))
+ `(modus-themes-prose-code ((,c :inherit modus-themes-fixed-pitch
:background ,bg-prose-code :foreground ,fg-prose-code)))
+ `(modus-themes-prose-macro ((,c :inherit modus-themes-fixed-pitch
:background ,bg-prose-macro :foreground ,fg-prose-macro)))
+ `(modus-themes-prose-verbatim ((,c :inherit modus-themes-fixed-pitch
:background ,bg-prose-verbatim :foreground ,fg-prose-verbatim)))
;;;;; search
- `(modus-themes-search-current ((,c :background ,bg-yellow-intense
:foreground ,fg-main)))
- `(modus-themes-search-lazy ((,c :background ,bg-cyan-intense :foreground
,fg-main)))
+ `(modus-themes-search-current ((,c :background ,bg-search-current
:foreground ,fg-main)))
+ `(modus-themes-search-lazy ((,c :background ,bg-search-lazy :foreground
,fg-main)))
+ `(modus-themes-search-replace ((,c :background ,bg-search-replace
:foreground ,fg-main)))
+;;;;; search regexp groups
+ `(modus-themes-search-rx-group-0 ((,c :background ,bg-search-rx-group-0
:foreground ,fg-main)))
+ `(modus-themes-search-rx-group-1 ((,c :background ,bg-search-rx-group-1
:foreground ,fg-main)))
+ `(modus-themes-search-rx-group-2 ((,c :background ,bg-search-rx-group-2
:foreground ,fg-main)))
+ `(modus-themes-search-rx-group-3 ((,c :background ,bg-search-rx-group-3
:foreground ,fg-main)))
;;;;; completion frameworks
`(modus-themes-completion-match-0 ((,c ,@(modus-themes--completion-match
fg-completion-match-0 bg-completion-match-0))))
`(modus-themes-completion-match-1 ((,c ,@(modus-themes--completion-match
fg-completion-match-1 bg-completion-match-1))))
@@ -1756,12 +1606,12 @@ FG and BG are the main colors."
`(cursor ((,c :background ,cursor)))
`(fringe ((,c :background ,fringe :foreground ,fg-main)))
`(menu ((,c :background ,bg-dim :foreground ,fg-main)))
- `(scroll-bar ((,c :background ,bg-dim :foreground ,fg-dim)))
+ `(scroll-bar ((,c :background ,fringe :foreground ,border)))
`(tool-bar ((,c :background ,bg-dim :foreground ,fg-main)))
`(vertical-border ((,c :foreground ,border)))
;;;;; basic and/or ungrouped styles
- `(appt-notification ((,c :inherit error)))
- `(blink-matching-paren-highlight-offscreen ((,c :background
,bg-paren-match)))
+ `(appt-notification ((,c :inherit bold :foreground ,modeline-err)))
+ `(blink-matching-paren-offscreen ((,c :background ,bg-paren-match)))
`(bold ((,c :weight bold)))
`(bold-italic ((,c :inherit (bold italic))))
`(underline ((,c :underline ,fg-dim)))
@@ -1776,7 +1626,7 @@ FG and BG are the main colors."
`(escape-glyph ((,c :foreground ,err)))
`(file-name-shadow ((,c :inherit shadow)))
`(header-line ((,c :inherit modus-themes-ui-variable-pitch :background
,bg-dim)))
- `(header-line-highlight ((,c :inherit highlight)))
+ `(header-line-highlight ((,c :background ,bg-hover :foreground ,fg-main
:box ,fg-main)))
`(help-argument-name ((,c :inherit modus-themes-slant :foreground
,variable)))
`(help-key-binding ((,c :inherit modus-themes-key-binding)))
`(highlight ((,c :background ,bg-hover :foreground ,fg-main)))
@@ -1792,7 +1642,7 @@ FG and BG are the main colors."
`(mm-uu-extract ((,c :foreground ,mail-part)))
`(next-error ((,c :inherit modus-themes-prominent-error :extend t)))
`(pgtk-im-0 ((,c :inherit modus-themes-prominent-note)))
- `(read-multiple-choice-face ((,c :inherit (bold modus-themes-mark-alt))))
+ `(read-multiple-choice-face ((,c :inherit modus-themes-mark-sel)))
`(rectangle-preview ((,c :inherit secondary-selection)))
`(region ((,c :background ,bg-region :foreground ,fg-region)))
`(secondary-selection ((,c :background ,bg-hover-secondary :foreground
,fg-main)))
@@ -1909,7 +1759,7 @@ FG and BG are the main colors."
`(anzu-match-3 ((,c :inherit modus-themes-subtle-yellow)))
`(anzu-mode-line ((,c :inherit bold)))
`(anzu-mode-line-no-match ((,c :inherit error)))
- `(anzu-replace-highlight ((,c :inherit modus-themes-prominent-error
:underline t)))
+ `(anzu-replace-highlight ((,c :inherit modus-themes-search-replace)))
`(anzu-replace-to ((,c :inherit modus-themes-search-current)))
;;;;; auctex and Tex
`(font-latex-bold-face ((,c :inherit bold)))
@@ -2097,6 +1947,7 @@ FG and BG are the main colors."
`(completions-annotations ((,c :inherit modus-themes-slant :foreground
,docstring)))
`(completions-common-part ((,c :inherit modus-themes-completion-match-0)))
`(completions-first-difference ((,c :inherit
modus-themes-completion-match-1)))
+ `(completions-highlight ((,c :inherit modus-themes-completion-selected)))
;;;;; consult
`(consult-async-split ((,c :inherit error)))
`(consult-file ((,c :inherit modus-themes-bold :foreground ,info)))
@@ -2104,6 +1955,7 @@ FG and BG are the main colors."
`(consult-imenu-prefix ((,c :inherit shadow)))
`(consult-line-number ((,c :inherit shadow)))
`(consult-line-number-prefix ((,c :inherit shadow)))
+ `(consult-preview-insertion ((,c :background ,bg-dim)))
;;;;; corfu
`(corfu-current ((,c :inherit modus-themes-completion-selected)))
`(corfu-bar ((,c :background ,fg-dim)))
@@ -2164,6 +2016,22 @@ FG and BG are the main colors."
`(deadgrep-meta-face ((,c :inherit shadow)))
`(deadgrep-regexp-metachar-face ((,c :inherit
font-lock-regexp-grouping-construct)))
`(deadgrep-search-term-face ((,c :inherit success)))
+;;;;; debbugs
+ `(debbugs-gnu-archived ((,c :background ,bg-inactive :foreground ,fg-dim)))
+ `(debbugs-gnu-done ((,c :inherit success)))
+ `(debbugs-gnu-forwarded ((,c :inherit modus-themes-slant :foreground
,info)))
+ `(debbugs-gnu-handled (( )))
+ `(debbugs-gnu-marked ((,c :inherit modus-themes-mark-sel)))
+ `(debbugs-gnu-marked-stale ((,c :inherit modus-themes-mark-alt)))
+ `(debbugs-gnu-new ((,c :inherit error)))
+ `(debbugs-gnu-pending ((,c :inherit modus-themes-slant :foreground
,fg-alt)))
+ `(debbugs-gnu-stale-1 ((,c :foreground ,red-cooler)))
+ `(debbugs-gnu-stale-2 ((,c :foreground ,yellow-warmer)))
+ `(debbugs-gnu-stale-3 ((,c :foreground ,magenta-warmer)))
+ `(debbugs-gnu-stale-4 ((,c :foreground ,magenta-cooler)))
+ `(debbugs-gnu-stale-5 ((,c :foreground ,cyan-faint)))
+ `(debbugs-gnu-tagged ((,c :inherit modus-themes-mark-alt)))
+ `(debbugs-gnu-title ((,c :inherit bold)))
;;;;; deft
`(deft-filter-string-face ((,c :inherit success)))
`(deft-header-face ((,c :inherit shadow)))
@@ -2171,6 +2039,20 @@ FG and BG are the main colors."
`(deft-summary-face ((,c :inherit (shadow modus-themes-slant))))
`(deft-time-face ((,c :foreground ,date-common)))
`(deft-title-face ((,c :inherit bold)))
+;;;;; denote
+ `(denote-faces-date ((,c :foreground ,date-common)))
+ `(denote-faces-delimiter ((,c :inherit shadow)))
+ `(denote-faces-extension ((,c :inherit shadow)))
+ `(denote-faces-keywords ((,c :inherit modus-themes-bold :foreground
,keyword)))
+ `(denote-faces-link ((,c :inherit link)))
+ `(denote-faces-prompt-current-name ((,c :inherit modus-themes-slant
:foreground ,fg-changed-intense)))
+ `(denote-faces-prompt-new-name ((,c :inherit modus-themes-slant
:foreground ,fg-added-intense)))
+ `(denote-faces-prompt-old-name ((,c :inherit modus-themes-slant
:foreground ,fg-removed-intense)))
+ `(denote-faces-signature ((,c :inherit modus-themes-bold :foreground
,string)))
+ `(denote-faces-subdirectory ((,c :inherit modus-themes-bold :foreground
,fg-alt)))
+ `(denote-faces-time ((,c :inherit denote-faces-date)))
+ `(denote-faces-time-delimiter ((,c :inherit shadow)))
+ `(denote-faces-title (( )))
;;;;; devdocs
`(devdocs-code-block ((,c :inherit modus-themes-fixed-pitch :background
,bg-dim :extend t)))
;;;;; dictionary
@@ -2340,7 +2222,7 @@ FG and BG are the main colors."
`(el-search-occur-match ((,c :inherit match)))
;;;;; eldoc
;; NOTE: see https://github.com/purcell/package-lint/issues/187
- (list 'eldoc-highlight-function-argument `((,c :inherit
modus-themes-mark-alt)))
+ (list 'eldoc-highlight-function-argument `((,c :inherit bold :background
,bg-active-argument :foreground ,fg-active-argument)))
;;;;; eldoc-box
`(eldoc-box-body ((,c :background ,bg-dim :foreground ,fg-main)))
`(eldoc-box-border ((,c :background ,border)))
@@ -2420,9 +2302,11 @@ FG and BG are the main colors."
`(erc-dangerous-host-face ((,c :inherit error)))
`(erc-direct-msg-face ((,c :inherit shadow)))
`(erc-error-face ((,c :inherit error)))
+ `(erc-fill-wrap-merge-indicator-face ((,c :foreground ,fg-dim)))
`(erc-fool-face ((,c :inherit shadow)))
`(erc-input-face ((,c :foreground ,fnname)))
`(erc-inverse-face ((,c :inherit erc-default-face :inverse-video t)))
+ `(erc-keep-place-indicator-arrow ((,c :foreground ,info)))
`(erc-keyword-face ((,c :inherit bold :foreground ,keyword)))
`(erc-my-nick-face ((,c :inherit bold :foreground ,name)))
`(erc-my-nick-prefix-face ((,c :inherit erc-my-nick-face)))
@@ -2463,7 +2347,7 @@ FG and BG are the main colors."
`(evil-ex-info ((,c :inherit font-lock-type-face)))
`(evil-ex-lazy-highlight ((,c :inherit modus-themes-search-lazy)))
`(evil-ex-search ((,c :inherit modus-themes-search-current)))
- `(evil-ex-substitute-matches ((,c :inherit modus-themes-prominent-error
:underline t)))
+ `(evil-ex-substitute-matches ((,c :inherit modus-themes-search-replace)))
`(evil-ex-substitute-replacement ((,c :inherit
modus-themes-search-current)))
;;;;; eww
`(eww-invalid-certificate ((,c :foreground ,err)))
@@ -2533,7 +2417,7 @@ FG and BG are the main colors."
`(font-lock-variable-name-face ((,c :foreground ,variable)))
`(font-lock-warning-face ((,c :inherit modus-themes-bold :foreground
,warning)))
;;;;; geiser
- `(geiser-font-lock-autodoc-current-arg ((,c :inherit
modus-themes-mark-alt)))
+ `(geiser-font-lock-autodoc-current-arg ((,c :inherit bold :background
,bg-active-argument :foreground ,fg-active-argument)))
`(geiser-font-lock-autodoc-identifier ((,c :foreground ,docstring)))
`(geiser-font-lock-doc-button ((,c :inherit button)))
`(geiser-font-lock-doc-link ((,c :inherit button)))
@@ -2574,7 +2458,7 @@ FG and BG are the main colors."
`(git-timemachine-minibuffer-author-face ((,c :foreground ,name)))
`(git-timemachine-minibuffer-detail-face ((,c :foreground ,fg-main)))
;;;;; gnus
- `(gnus-button ((,c :inherit button)))
+ `(gnus-button ((,c :inherit button :underline nil)))
`(gnus-cite-1 ((,c :inherit message-cited-text-1)))
`(gnus-cite-2 ((,c :inherit message-cited-text-2)))
`(gnus-cite-3 ((,c :inherit message-cited-text-3)))
@@ -2665,37 +2549,37 @@ FG and BG are the main colors."
;; entries in their palette for such an edge case. Defining those
;; entries is not appropriate.
`(hi-aquamarine ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#227f9f" :inverse-video
t)
+ :background "#ffffff" :foreground "#227f9f"
:inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#66cbdc" :inverse-video
t)))
+ :background "#000000" :foreground "#66cbdc"
:inverse-video t)))
`(hi-black-b ((,c :inverse-video t)))
`(hi-black-hb ((,c :background ,bg-main :foreground ,fg-dim :inverse-video
t)))
`(hi-blue ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#3366dd" :inverse-video t)
+ :background "#ffffff" :foreground "#3366dd" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#aaccff" :inverse-video t)))
+ :background "#000000" :foreground "#aaccff" :inverse-video t)))
`(hi-blue-b ((,c :inherit (bold hi-blue))))
`(hi-green ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#008a00" :inverse-video t)
+ :background "#ffffff" :foreground "#008a00" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#66dd66" :inverse-video t)))
+ :background "#000000" :foreground "#66dd66" :inverse-video
t)))
`(hi-green-b ((,c :inherit (bold hi-green))))
`(hi-pink ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#bd30aa" :inverse-video t)
+ :background "#ffffff" :foreground "#bd30aa" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#ff88ee" :inverse-video t)))
+ :background "#000000" :foreground "#ff88ee" :inverse-video t)))
`(hi-red-b ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#dd0000" :inverse-video t)
+ :background "#ffffff" :foreground "#dd0000" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#f06666" :inverse-video t)))
+ :background "#000000" :foreground "#f06666" :inverse-video
t)))
`(hi-salmon ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#bf555a" :inverse-video t)
+ :background "#ffffff" :foreground "#bf555a" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#e08a50" :inverse-video t)))
+ :background "#000000" :foreground "#e08a50" :inverse-video
t)))
`(hi-yellow ((((class color) (min-colors 88) (background light))
- :background "white" :foreground "#af6400" :inverse-video t)
+ :background "#ffffff" :foreground "#af6400" :inverse-video t)
(((class color) (min-colors 88) (background dark))
- :background "black" :foreground "#faea00" :inverse-video t)))
+ :background "#000000" :foreground "#faea00" :inverse-video
t)))
`(highlight-changes ((,c :foreground ,warning :underline nil)))
`(highlight-changes-delete ((,c :foreground ,err :underline t)))
`(hl-line ((,c :background ,bg-hl-line :extend t)))
@@ -2735,14 +2619,14 @@ FG and BG are the main colors."
`(image-dired-thumb-header-file-size ((,c :foreground ,constant)))
`(image-dired-thumb-mark ((,c :inherit modus-themes-mark-sel :box
(:line-width -3))))
;;;;; imenu-list
- `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-0)))
- `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-1)))
- `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-2)))
- `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-3)))
- `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground
,fg-heading-4 :underline t)))
- `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground
,fg-heading-5 :underline t)))
- `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground
,fg-heading-6 :underline t)))
- `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground
,fg-heading-7 :underline t)))
+ `(imenu-list-entry-face-0 ((,c :foreground ,fg-heading-1)))
+ `(imenu-list-entry-face-1 ((,c :foreground ,fg-heading-2)))
+ `(imenu-list-entry-face-2 ((,c :foreground ,fg-heading-3)))
+ `(imenu-list-entry-face-3 ((,c :foreground ,fg-heading-4)))
+ `(imenu-list-entry-subalist-face-0 ((,c :inherit bold :foreground
,fg-heading-1 :underline t)))
+ `(imenu-list-entry-subalist-face-1 ((,c :inherit bold :foreground
,fg-heading-2 :underline t)))
+ `(imenu-list-entry-subalist-face-2 ((,c :inherit bold :foreground
,fg-heading-3 :underline t)))
+ `(imenu-list-entry-subalist-face-3 ((,c :inherit bold :foreground
,fg-heading-4 :underline t)))
;;;;; indium
`(indium-breakpoint-face ((,c :foreground ,err)))
`(indium-frame-url-face ((,c :inherit (shadow button))))
@@ -2807,11 +2691,11 @@ FG and BG are the main colors."
;;;;; isearch, occur, and the like
`(isearch ((,c :inherit modus-themes-search-current)))
`(isearch-fail ((,c :inherit modus-themes-prominent-error)))
- `(isearch-group-1 ((,c :inherit modus-themes-intense-blue)))
- `(isearch-group-2 ((,c :inherit modus-themes-intense-magenta)))
+ `(isearch-group-1 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(isearch-group-2 ((,c :inherit modus-themes-search-rx-group-1)))
`(lazy-highlight ((,c :inherit modus-themes-search-lazy)))
`(match ((,c :background ,bg-magenta-subtle :foreground ,fg-main)))
- `(query-replace ((,c :inherit modus-themes-prominent-error)))
+ `(query-replace ((,c :inherit modus-themes-search-replace)))
;;;;; ivy
`(ivy-action ((,c :inherit modus-themes-key-binding)))
`(ivy-confirm-face ((,c :inherit success)))
@@ -2876,7 +2760,7 @@ FG and BG are the main colors."
`(kaocha-runner-warning-face ((,c :inherit warning)))
;;;;; keycast
`(keycast-command ((,c :inherit bold)))
- `(keycast-key ((,c :background ,keybind :foreground ,bg-main)))
+ `(keycast-key ((,c :inherit modus-themes-bold :background ,keybind
:foreground ,bg-main)))
;;;;; ledger-mode
`(ledger-font-auto-xact-face ((,c :inherit font-lock-builtin-face)))
`(ledger-font-account-name-face ((,c :foreground ,name)))
@@ -3033,7 +2917,7 @@ FG and BG are the main colors."
`(markdown-highlighting-face ((,c :inherit secondary-selection)))
`(markdown-inline-code-face ((,c :inherit modus-themes-prose-code)))
`(markdown-italic-face ((,c :inherit italic)))
- `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch
:foreground ,prose-block)))
+ `(markdown-language-keyword-face ((,c :inherit modus-themes-fixed-pitch
:background ,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter)))
`(markdown-line-break-face ((,c :inherit nobreak-space)))
`(markdown-link-face ((,c :inherit link)))
`(markdown-markup-face ((,c :inherit shadow)))
@@ -3046,12 +2930,12 @@ FG and BG are the main colors."
;;;;; markup-faces (`adoc-mode')
`(markup-attribute-face ((,c :inherit (modus-themes-slant
markup-meta-face))))
`(markup-bold-face ((,c :inherit bold)))
- `(markup-code-face ((,c :foreground ,prose-code)))
+ `(markup-code-face ((,c :inherit modus-themes-prose-code)))
`(markup-comment-face ((,c :inherit font-lock-comment-face)))
- `(markup-complex-replacement-face ((,c :foreground ,prose-macro)))
+ `(markup-complex-replacement-face ((,c :inherit modus-themes-prose-macro)))
`(markup-emphasis-face ((,c :inherit markup-italic-face)))
`(markup-error-face ((,c :inherit error)))
- `(markup-gen-face ((,c :foreground ,prose-verbatim)))
+ `(markup-gen-face ((,c :inherit modus-themes-prose-verbatim)))
`(markup-internal-reference-face ((,c :inherit (shadow
modus-themes-slant))))
`(markup-italic-face ((,c :inherit italic)))
`(markup-list-face ((,c :background ,bg-inactive)))
@@ -3073,7 +2957,9 @@ FG and BG are the main colors."
`(markup-title-3-face ((,c :inherit modus-themes-heading-4)))
`(markup-title-4-face ((,c :inherit modus-themes-heading-5)))
`(markup-title-5-face ((,c :inherit modus-themes-heading-6)))
- `(markup-verbatim-face ((,c :inherit modus-themes-fixed-pitch :foreground
,prose-verbatim)))
+ `(markup-verbatim-face ((,c :inherit modus-themes-prose-verbatim)))
+;;;;; mct
+ `(mct-highlight-candidate ((,c :inherit modus-themes-completion-selected)))
;;;;; messages
`(message-cited-text-1 ((,c :foreground ,mail-cite-0)))
`(message-cited-text-2 ((,c :foreground ,mail-cite-1)))
@@ -3087,7 +2973,7 @@ FG and BG are the main colors."
`(message-header-xheader ((,c :inherit message-header-other)))
`(message-header-other ((,c :foreground ,mail-other)))
`(message-mml ((,c :foreground ,mail-part)))
- `(message-separator ((,c :background ,bg-active)))
+ `(message-separator ((,c :background ,bg-inactive :foreground ,fg-main)))
;;;;; minimap
`(minimap-active-region-background ((,c :background ,bg-active)))
`(minimap-current-line-face ((,c :background ,bg-cyan-intense :foreground
,fg-main)))
@@ -3129,7 +3015,7 @@ FG and BG are the main colors."
`(mu4e-contact-face ((,c :inherit message-header-to)))
`(mu4e-context-face ((,c :inherit bold)))
`(mu4e-draft-face ((,c :foreground ,warning)))
- `(mu4e-flagged-face ((,c :foreground ,err)))
+ `(mu4e-flagged-face ((,c :foreground ,keyword)))
`(mu4e-footer-face ((,c :inherit italic :foreground ,fg-alt)))
`(mu4e-forwarded-face ((,c :inherit italic :foreground ,info)))
`(mu4e-header-face ((,c :inherit shadow)))
@@ -3148,6 +3034,7 @@ FG and BG are the main colors."
`(mu4e-replied-face ((,c :foreground ,info)))
`(mu4e-special-header-value-face ((,c :inherit message-header-subject)))
`(mu4e-system-face ((,c :inherit italic)))
+ `(mu4e-thread-fold-face ((,c :foreground ,border)))
`(mu4e-title-face (( )))
`(mu4e-trashed-face ((,c :foreground ,err)))
`(mu4e-unread-face ((,c :inherit bold)))
@@ -3233,7 +3120,7 @@ FG and BG are the main colors."
`(notmuch-message-summary-face ((,c :inherit bold :background
,bg-inactive)))
`(notmuch-search-count ((,c :foreground ,fg-dim)))
`(notmuch-search-date ((,c :foreground ,date-common)))
- `(notmuch-search-flagged-face ((,c :foreground ,err)))
+ `(notmuch-search-flagged-face ((,c :foreground ,keyword)))
`(notmuch-search-matching-authors ((,c :foreground ,mail-recipient)))
`(notmuch-search-non-matching-authors ((,c :inherit shadow)))
`(notmuch-search-subject ((,c :foreground ,fg-main)))
@@ -3241,7 +3128,7 @@ FG and BG are the main colors."
`(notmuch-tag-added ((,c :underline ,info)))
`(notmuch-tag-deleted ((,c :strike-through ,err)))
`(notmuch-tag-face ((,c :foreground ,accent-0)))
- `(notmuch-tag-flagged ((,c :foreground ,err)))
+ `(notmuch-tag-flagged ((,c :foreground ,keyword)))
`(notmuch-tag-unread ((,c :foreground ,accent-1)))
`(notmuch-tree-match-author-face ((,c :inherit
notmuch-search-matching-authors)))
`(notmuch-tree-match-date-face ((,c :inherit notmuch-search-date)))
@@ -3280,7 +3167,7 @@ FG and BG are the main colors."
`(nxml-ref ((,c :inherit (shadow modus-themes-bold))))
`(rng-error ((,c :inherit error)))
;;;;; olivetti
- `(olivetti-fringe ((,c :background ,bg-main)))
+ `(olivetti-fringe ((,c :background ,fringe)))
;;;;; orderless
`(orderless-match-face-0 ((,c :inherit modus-themes-completion-match-0)))
`(orderless-match-face-1 ((,c :inherit modus-themes-completion-match-1)))
@@ -3290,7 +3177,7 @@ FG and BG are the main colors."
`(org-agenda-calendar-daterange ((,c :foreground ,date-range)))
`(org-agenda-calendar-event ((,c :foreground ,date-event)))
`(org-agenda-calendar-sexp ((,c :inherit (modus-themes-slant
org-agenda-calendar-event))))
- `(org-agenda-clocking ((,c :inherit modus-themes-mark-alt)))
+ `(org-agenda-clocking ((,c :inherit bold :background ,bg-active-argument
:foreground ,fg-active-argument)))
`(org-agenda-column-dateline ((,c :background ,bg-inactive)))
`(org-agenda-current-time ((,c :foreground ,date-now)))
`(org-agenda-date ((,c ,@(modus-themes--heading 'agenda-date
date-weekday))))
@@ -3309,10 +3196,10 @@ FG and BG are the main colors."
`(org-agenda-structure-filter ((,c :inherit org-agenda-structure
:foreground ,warning)))
`(org-agenda-structure-secondary ((,c :inherit font-lock-doc-face)))
`(org-archived ((,c :background ,bg-inactive :foreground ,fg-main)))
- `(org-block ((,c ,@(modus-themes--org-block fg-main bg-dim))))
- `(org-block-begin-line ((,c ,@(modus-themes--org-block prose-block
bg-inactive))))
+ `(org-block ((,c :inherit modus-themes-fixed-pitch :background
,bg-prose-block-contents :extend t)))
+ `(org-block-begin-line ((,c :inherit modus-themes-fixed-pitch :background
,bg-prose-block-delimiter :foreground ,fg-prose-block-delimiter :extend t)))
`(org-block-end-line ((,c :inherit org-block-begin-line)))
- `(org-checkbox ((,c :foreground ,warning)))
+ `(org-checkbox ((,c :inherit modus-themes-fixed-pitch :foreground
,warning)))
`(org-checkbox-statistics-done ((,c :inherit org-done)))
`(org-checkbox-statistics-todo ((,c :inherit org-todo)))
`(org-clock-overlay ((,c :inherit secondary-selection)))
@@ -3321,6 +3208,11 @@ FG and BG are the main colors."
`(org-column-title ((,c :inherit (bold default) :underline t :background
,bg-dim)))
`(org-date ((,c :inherit modus-themes-fixed-pitch :foreground
,date-common)))
`(org-date-selected ((,c :foreground ,date-common :inverse-video t)))
+ ;; NOTE 2024-03-17: Normally we do not want to add this padding
+ ;; with the :box, but I do it here because the keys are otherwise
+ ;; very hard to read. The square brackets around them are not
+ ;; colored, which is what is causing the problem.
+ `(org-dispatcher-highlight ((,c :inherit modus-themes-bold :box
(:line-width 2 :color ,bg-hover-secondary) :background ,bg-hover-secondary
:foreground ,fg-main)))
`(org-document-info ((,c :foreground ,prose-metadata-value)))
`(org-document-info-keyword ((,c :inherit modus-themes-fixed-pitch
:foreground ,prose-metadata)))
`(org-document-title ((,c :inherit modus-themes-heading-0)))
@@ -3328,7 +3220,7 @@ FG and BG are the main colors."
`(org-drawer ((,c :inherit modus-themes-fixed-pitch :foreground
,prose-metadata)))
`(org-ellipsis (( ))) ; inherits from the heading's color
`(org-footnote ((,c :inherit link)))
- `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground ,fnname)))
+ `(org-formula ((,c :inherit modus-themes-fixed-pitch :foreground
,prose-table-formula)))
`(org-headline-done ((,c :inherit org-done)))
`(org-headline-todo ((,c :inherit org-todo)))
`(org-hide ((,c :foreground ,bg-main)))
@@ -3370,13 +3262,13 @@ FG and BG are the main colors."
`(org-verse ((,c :inherit org-block)))
`(org-warning ((,c :inherit warning)))
;;;;; org-habit
- `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground
"black"))) ; fg is special case
+ `(org-habit-alert-face ((,c :background ,bg-graph-yellow-0 :foreground
"#000000"))) ; fg is special case
`(org-habit-alert-future-face ((,c :background ,bg-graph-yellow-1)))
- `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground
"black"))) ; fg is special case
+ `(org-habit-clear-face ((,c :background ,bg-graph-blue-0 :foreground
"#000000"))) ; fg is special case
`(org-habit-clear-future-face ((,c :background ,bg-graph-blue-1)))
`(org-habit-overdue-face ((,c :background ,bg-graph-red-0)))
`(org-habit-overdue-future-face ((,c :background ,bg-graph-red-1)))
- `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground
"black"))) ; fg is special case
+ `(org-habit-ready-face ((,c :background ,bg-graph-green-0 :foreground
"#000000"))) ; fg is special case
`(org-habit-ready-future-face ((,c :background ,bg-graph-green-1)))
;;;;; org-journal
`(org-journal-calendar-entry-face ((,c :inherit modus-themes-slant
:foreground ,date-common)))
@@ -3551,10 +3443,10 @@ FG and BG are the main colors."
`(recursion-indicator-general ((,c :foreground ,modeline-err)))
`(recursion-indicator-minibuffer ((,c :foreground ,modeline-info)))
;;;;; regexp-builder (re-builder)
- `(reb-match-0 ((,c :inherit modus-themes-intense-cyan)))
- `(reb-match-1 ((,c :inherit modus-themes-subtle-magenta)))
- `(reb-match-2 ((,c :inherit modus-themes-subtle-green)))
- `(reb-match-3 ((,c :inherit modus-themes-intense-yellow)))
+ `(reb-match-0 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(reb-match-1 ((,c :inherit modus-themes-search-rx-group-1)))
+ `(reb-match-2 ((,c :inherit modus-themes-search-rx-group-2)))
+ `(reb-match-3 ((,c :inherit modus-themes-search-rx-group-3)))
`(reb-regexp-grouping-backslash ((,c :inherit
font-lock-regexp-grouping-backslash)))
`(reb-regexp-grouping-construct ((,c :inherit
font-lock-regexp-grouping-construct)))
;;;;; rg (rg.el)
@@ -3609,7 +3501,7 @@ FG and BG are the main colors."
`(shortdoc-heading ((,c :inherit bold)))
`(shortdoc-section (())) ; remove the default's variable-pitch style
;;;;; show-paren-mode
- `(show-paren-match ((,c :background ,bg-paren-match :foreground ,fg-main
:underline ,underline-paren-match)))
+ `(show-paren-match ((,c :background ,bg-paren-match :foreground
,fg-paren-match :underline ,underline-paren-match)))
`(show-paren-match-expression ((,c :background ,bg-paren-expression)))
`(show-paren-mismatch ((,c :inherit modus-themes-prominent-error)))
;;;;; shr
@@ -3621,6 +3513,7 @@ FG and BG are the main colors."
`(shr-h4 ((,c :inherit modus-themes-heading-4)))
`(shr-h5 ((,c :inherit modus-themes-heading-5)))
`(shr-h6 ((,c :inherit modus-themes-heading-6)))
+ `(shr-mark ((,c :inherit match)))
`(shr-selected-link ((,c :inherit modus-themes-mark-sel)))
;;;;; side-notes
`(side-notes ((,c :background ,bg-dim :foreground ,fg-dim)))
@@ -3803,14 +3696,25 @@ FG and BG are the main colors."
`(transient-amaranth ((,c :inherit bold :foreground ,yellow-warmer)))
;; Placate the compiler for what is a spurious warning. We also
;; have to do this with `eldoc-highlight-function-argument'.
- (list 'transient-argument `((,c :inherit (bold modus-themes-mark-alt))))
+ (list 'transient-argument `((,c :inherit bold :background
,bg-active-argument :foreground ,fg-active-argument)))
`(transient-blue ((,c :inherit bold :foreground ,blue)))
`(transient-disabled-suffix ((,c :inherit modus-themes-mark-del)))
`(transient-enabled-suffix ((,c :inherit modus-themes-subtle-cyan)))
`(transient-heading ((,c :inherit bold :foreground ,fg-main)))
`(transient-inactive-argument ((,c :inherit shadow)))
`(transient-inactive-value ((,c :inherit shadow)))
+ ;; NOTE 2023-12-09 10:30:09 +0200: The new user option
+ ;; `transient-semantic-coloring' is enabled by default. This is
+ ;; not good for us, because we are making it harder for users who
+ ;; need accessible colors to use the transient interfaces. I
+ ;; could set that user option to nil, but I think it is less
+ ;; intrusive to enforce uniformity among the relevant faces.
+ ;; Those who want semantic coloring can modify these faces.
`(transient-key ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-exit ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-noop ((,c :inherit (shadow modus-themes-key-binding))))
+ `(transient-key-return ((,c :inherit modus-themes-key-binding)))
+ `(transient-key-stay ((,c :inherit modus-themes-key-binding)))
`(transient-mismatched-key ((,c :underline t)))
`(transient-nonstandard-key ((,c :underline t)))
`(transient-pink ((,c :inherit bold :foreground ,magenta)))
@@ -3819,7 +3723,7 @@ FG and BG are the main colors."
`(transient-teal ((,c :inherit bold :foreground ,cyan-cooler)))
`(transient-unreachable ((,c :inherit shadow)))
`(transient-unreachable-key ((,c :inherit shadow)))
- `(transient-value ((,c :inherit (bold modus-themes-mark-sel))))
+ `(transient-value ((,c :inherit bold :background ,bg-active-value
:foreground ,fg-active-value)))
;;;;; trashed
`(trashed-deleted ((,c :inherit modus-themes-mark-del)))
`(trashed-directory ((,c :foreground ,accent-0)))
@@ -3918,11 +3822,11 @@ FG and BG are the main colors."
`(visible-mark-forward-face1 ((,c :background ,bg-magenta-intense)))
`(visible-mark-forward-face2 ((,c :background ,bg-green-intense)))
;;;;; visual-regexp
- `(vr/group-0 ((,c :inherit modus-themes-intense-blue)))
- `(vr/group-1 ((,c :inherit modus-themes-intense-magenta)))
- `(vr/group-2 ((,c :inherit modus-themes-intense-green)))
- `(vr/match-0 ((,c :inherit modus-themes-intense-yellow)))
- `(vr/match-1 ((,c :inherit modus-themes-intense-yellow)))
+ `(vr/group-0 ((,c :inherit modus-themes-search-rx-group-0)))
+ `(vr/group-1 ((,c :inherit modus-themes-search-rx-group-1)))
+ `(vr/group-2 ((,c :inherit modus-themes-search-rx-group-2)))
+ `(vr/match-0 ((,c :inherit modus-themes-search-current)))
+ `(vr/match-1 ((,c :inherit modus-themes-search-lazy)))
`(vr/match-separator-face ((,c :inherit bold :background ,bg-active)))
;;;;; vterm
;; NOTE 2023-08-10: `vterm-color-black' and `vterm-color-white'
@@ -4025,7 +3929,7 @@ FG and BG are the main colors."
`(which-func ((,c :inherit bold :foreground ,modeline-info))) ; same as
`breadcrumb-imenu-leaf-face'
;;;;; which-key
`(which-key-command-description-face ((,c :foreground ,fg-main)))
- `(which-key-group-description-face ((,c :foreground ,keyword)))
+ `(which-key-group-description-face ((,c :foreground ,type)))
`(which-key-highlighted-command-face ((,c :foreground ,warning :underline
t)))
`(which-key-key-face ((,c :inherit modus-themes-key-binding)))
`(which-key-local-map-description-face ((,c :foreground ,fg-main)))
@@ -4034,14 +3938,14 @@ FG and BG are the main colors."
`(which-key-special-key-face ((,c :inherit error)))
;;;;; whitespace-mode
`(whitespace-big-indent ((,c :background ,bg-space-err)))
- `(whitespace-empty ((,c :inherit modus-themes-intense-magenta)))
+ `(whitespace-empty ((,c :background ,bg-space)))
`(whitespace-hspace ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-indentation ((,c :background ,bg-space :foreground
,fg-space)))
`(whitespace-line ((,c :background ,bg-space :foreground ,warning)))
`(whitespace-newline ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-space ((,c :background ,bg-space :foreground ,fg-space)))
- `(whitespace-space-after-tab ((,c :inherit modus-themes-subtle-magenta)))
- `(whitespace-space-before-tab ((,c :inherit modus-themes-subtle-cyan)))
+ `(whitespace-space-after-tab ((,c :inherit warning :background ,bg-space)))
+ `(whitespace-space-before-tab ((,c :inherit warning :background
,bg-space)))
`(whitespace-tab ((,c :background ,bg-space :foreground ,fg-space)))
`(whitespace-trailing ((,c :background ,bg-space-err)))
;;;;; window-divider-mode
@@ -4072,14 +3976,27 @@ FG and BG are the main colors."
;;;;; yaml-mode
`(yaml-tab-face ((,c :background ,bg-space-err)))
;;;;; yasnippet
- `(yas-field-highlight-face ((,c :inherit highlight))))
+ `(yas-field-highlight-face ((,c :inherit highlight)))
+;;;;; ztree
+ `(ztreep-arrow-face ((,c :inherit shadow)))
+ `(ztreep-diff-header-face ((,c :inherit modus-themes-heading-0)))
+ `(ztreep-diff-header-small-face ((,c :inherit font-lock-doc-face)))
+ `(ztreep-diff-model-add-face ((,c :foreground ,info)))
+ `(ztreep-diff-model-diff-face ((,c :foreground ,err)))
+ `(ztreep-diff-model-ignored-face ((,c :foreground ,fg-dim :strike-through
t)))
+ `(ztreep-diff-model-normal-face (( )))
+ `(ztreep-expand-sign-face ((,c :inherit shadow)))
+ `(ztreep-header-face ((,c :inherit modus-themes-heading-0)))
+ `(ztreep-leaf-face (( )))
+ `(ztreep-node-count-children-face ((,c :inherit (shadow italic))))
+ `(ztreep-node-face ((,c :foreground ,accent-0))))
"Face specs for use with `modus-themes-theme'.")
(defconst modus-themes-custom-variables
'(
;;;; ansi-colors
`(ansi-color-faces-vector [default bold shadow italic underline success
warning error])
- `(ansi-color-names-vector ["gray35" ,red ,green ,yellow ,blue ,magenta
,cyan "gray65"])
+ `(ansi-color-names-vector ["#595959" ,red ,green ,yellow ,blue ,magenta
,cyan "#a6a6a6"])
;;;; chart
`(chart-face-color-list
'( ,bg-graph-red-0 ,bg-graph-green-0 ,bg-graph-yellow-0 ,bg-graph-blue-0
,bg-graph-magenta-0 ,bg-graph-cyan-0
@@ -4152,29 +4069,35 @@ FG and BG are the main colors."
modus-themes-fg-yellow-intense
modus-themes-fg-magenta-intense
modus-themes-fg-cyan-intense))
-;;;; org-src-block-faces
- (if (or (eq modus-themes-org-blocks 'tinted-background)
- (eq modus-themes-org-blocks 'rainbow))
- `(org-src-block-faces
- `(("emacs-lisp" modus-themes-nuanced-magenta)
- ("elisp" modus-themes-nuanced-magenta)
- ("clojure" modus-themes-nuanced-magenta)
- ("clojurescript" modus-themes-nuanced-magenta)
- ("c" modus-themes-nuanced-blue)
- ("c++" modus-themes-nuanced-blue)
- ("sh" modus-themes-nuanced-green)
- ("shell" modus-themes-nuanced-green)
- ("html" modus-themes-nuanced-yellow)
- ("xml" modus-themes-nuanced-yellow)
- ("css" modus-themes-nuanced-red)
- ("scss" modus-themes-nuanced-red)
- ("python" modus-themes-nuanced-green)
- ("ipython" modus-themes-nuanced-magenta)
- ("r" modus-themes-nuanced-cyan)
- ("yaml" modus-themes-nuanced-cyan)
- ("conf" modus-themes-nuanced-cyan)
- ("docker" modus-themes-nuanced-cyan)))
- `(org-src-block-faces '())))
+;;;; rustic-ansi-faces
+ `(rustic-ansi-faces
+ [,fg-term-black
+ ,fg-term-red
+ ,fg-term-green
+ ,fg-term-yellow
+ ,fg-term-blue
+ ,fg-term-magenta
+ ,fg-term-cyan
+ ,fg-term-white])
+;;;; xterm-color
+ `(xterm-color-names
+ [,fg-term-black
+ ,fg-term-red
+ ,fg-term-green
+ ,fg-term-yellow
+ ,fg-term-blue
+ ,fg-term-magenta
+ ,fg-term-cyan
+ ,fg-term-white])
+ `(xterm-color-names-bright
+ [,fg-term-black-bright
+ ,fg-term-red-bright
+ ,fg-term-green-bright
+ ,fg-term-yellow-bright
+ ,fg-term-blue-bright
+ ,fg-term-magenta-bright
+ ,fg-term-cyan-bright
+ ,fg-term-white-bright]))
"Custom variables for `modus-themes-theme'.")
;;; Theme macros
diff --git a/etc/themes/modus-vivendi-deuteranopia-theme.el
b/etc/themes/modus-vivendi-deuteranopia-theme.el
index 62715e20e51..d721dba09a9 100644
--- a/etc/themes/modus-vivendi-deuteranopia-theme.el
+++ b/etc/themes/modus-vivendi-deuteranopia-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-deuteranopia-theme.el --- Deuteranopia-optimized theme with
a black background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -127,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -211,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -240,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-warmer)
+ (bg-active-value bg-blue-nuanced)
+ (fg-active-value blue-warmer)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -288,7 +294,7 @@ standard)."
(date-event fg-alt)
(date-holiday yellow-warmer)
(date-holiday-other blue)
- (date-now blue-faint)
+ (date-now fg-main)
(date-range fg-alt)
(date-scheduled yellow-cooler)
(date-weekday cyan)
@@ -342,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done blue)
- (prose-macro magenta-cooler)
+ (prose-todo yellow-warmer)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula yellow-warmer)
+
(prose-tag magenta-faint)
- (prose-todo yellow-warmer)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -365,6 +384,17 @@ standard)."
(rainbow-7 blue-faint)
(rainbow-8 magenta-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-blue-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-cyan-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-blue-subtle)
+ (bg-search-rx-group-3 bg-yellow-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -373,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -408,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index 238484206bb..8b822974c15 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-theme.el --- Elegant, highly legible theme with a black
background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -125,12 +125,12 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -209,6 +209,7 @@ which corresponds to a minimum contrast in relative
luminance of
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-cooler)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-cooler)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -340,16 +346,29 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -363,6 +382,17 @@ which corresponds to a minimum contrast in relative
luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -371,10 +401,10 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
@@ -451,7 +481,6 @@ Semantic color mappings have the form (MAPPING-NAME
COLOR-NAME)
with both as symbols. The latter is a named color that already
exists in the palette and is associated with a HEX-VALUE.")
-
(defcustom modus-vivendi-palette-overrides nil
"Overrides for `modus-vivendi-palette'.
diff --git a/etc/themes/modus-vivendi-tinted-theme.el
b/etc/themes/modus-vivendi-tinted-theme.el
index 025257ef01c..5aa44304ee9 100644
--- a/etc/themes/modus-vivendi-tinted-theme.el
+++ b/etc/themes/modus-vivendi-tinted-theme.el
@@ -1,11 +1,11 @@
;;; modus-vivendi-tinted-theme.el --- Elegant, highly legible theme with a
night sky background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
+;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -125,12 +125,18 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#350f14")
- (bg-green-nuanced "#002718")
- (bg-yellow-nuanced "#2c1f00")
- (bg-blue-nuanced "#131c4d")
- (bg-magenta-nuanced "#2f133f")
- (bg-cyan-nuanced "#04253f")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
+
+;;; Uncommon accent backgrounds
+
+ (bg-ochre "#442c2f")
+ (bg-lavender "#38325c")
+ (bg-sage "#0f3d30")
;;; Graphs
@@ -200,15 +206,10 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-diff-context "#1a1f30")
-;;; Uncommon accent backgrounds
-
- (bg-ochre "#442c2f")
- (bg-lavender "#38325c")
- (bg-sage "#0f3d30")
-
;;; Paren match
- (bg-paren-match "#2f7f9f")
+ (bg-paren-match "#5f789f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -217,9 +218,9 @@ which corresponds to a minimum contrast in relative
luminance of
;;;; General mappings
(fringe bg-dim)
- (cursor magenta-warmer)
+ (cursor magenta-intense)
- (keybind blue-cooler)
+ (keybind magenta-cooler)
(name magenta)
(identifier yellow-faint)
@@ -238,6 +239,11 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-yellow-nuanced)
+ (fg-active-argument yellow-cooler)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan-cooler)
+
;;;; Code mappings
(builtin magenta-warmer)
@@ -337,20 +343,32 @@ which corresponds to a minimum contrast in relative
luminance of
(fg-prompt cyan-cooler)
(bg-prompt unspecified)
- (bg-space-err bg-red-intense)
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan-cooler)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan-cooler)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro magenta-cooler)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done green)
- (prose-macro magenta-cooler)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
+ (prose-table-formula magenta-warmer)
+
(prose-tag magenta-faint)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
;;;; Rainbow mappings
@@ -364,17 +382,29 @@ which corresponds to a minimum contrast in relative
luminance of
(rainbow-7 blue-warmer)
(rainbow-8 magenta-warmer)
+;;;; Search mappings
+
+ (bg-search-current bg-yellow-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-red-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-green-intense)
+ (bg-search-rx-group-2 bg-red-subtle)
+ (bg-search-rx-group-3 bg-magenta-subtle)
+
;;;; Space mappings
(bg-space unspecified)
(fg-space border)
+ (bg-space-err bg-red-intense)
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -406,10 +436,10 @@ which corresponds to a minimum contrast in relative
luminance of
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/etc/themes/modus-vivendi-tritanopia-theme.el
b/etc/themes/modus-vivendi-tritanopia-theme.el
index bfd6d63b844..2327a1e9c97 100644
--- a/etc/themes/modus-vivendi-tritanopia-theme.el
+++ b/etc/themes/modus-vivendi-tritanopia-theme.el
@@ -1,11 +1,10 @@
;;; modus-vivendi-tritanopia-theme.el --- Tritanopia-optimized theme with a
black background -*- lexical-binding:t -*-
-;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2019-2024 Free Software Foundation, Inc.
;; Author: Protesilaos Stavrou <info@protesilaos.com>
-;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
-;; URL: https://git.sr.ht/~protesilaos/modus-themes
-;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
+;; Maintainer: Protesilaos Stavrou <info@protesilaos.com>
+;; URL: https://github.com/protesilaos/modus-themes
;; Keywords: faces, theme, accessibility
;; This file is part of GNU Emacs.
@@ -128,12 +127,12 @@ standard)."
(bg-magenta-subtle "#552f5f")
(bg-cyan-subtle "#004065")
- (bg-red-nuanced "#2c0614")
- (bg-green-nuanced "#001904")
- (bg-yellow-nuanced "#221000")
- (bg-blue-nuanced "#0f0e39")
- (bg-magenta-nuanced "#230631")
- (bg-cyan-nuanced "#041529")
+ (bg-red-nuanced "#3a0c14")
+ (bg-green-nuanced "#092f1f")
+ (bg-yellow-nuanced "#381d0f")
+ (bg-blue-nuanced "#12154a")
+ (bg-magenta-nuanced "#2f0c3f")
+ (bg-cyan-nuanced "#042837")
;;; Uncommon accent backgrounds
@@ -212,6 +211,7 @@ standard)."
;;; Paren match
(bg-paren-match "#2f7f9f")
+ (fg-paren-match fg-main)
(bg-paren-expression "#453040")
(underline-paren-match unspecified)
@@ -241,6 +241,11 @@ standard)."
(bg-prominent-note bg-cyan-intense)
(fg-prominent-note fg-main)
+ (bg-active-argument bg-red-nuanced)
+ (fg-active-argument red-warmer)
+ (bg-active-value bg-cyan-nuanced)
+ (fg-active-value cyan)
+
;;;; Code mappings
(builtin magenta)
@@ -343,16 +348,29 @@ standard)."
;;;; Prose mappings
- (prose-block fg-dim)
- (prose-code cyan)
+ (bg-prose-block-delimiter bg-dim)
+ (fg-prose-block-delimiter fg-dim)
+ (bg-prose-block-contents bg-dim)
+
+ (bg-prose-code unspecified)
+ (fg-prose-code cyan)
+
+ (bg-prose-macro unspecified)
+ (fg-prose-macro red-warmer)
+
+ (bg-prose-verbatim unspecified)
+ (fg-prose-verbatim magenta-warmer)
+
(prose-done cyan)
- (prose-macro red-warmer)
+ (prose-todo red)
+
(prose-metadata fg-dim)
(prose-metadata-value fg-alt)
+
(prose-table fg-alt)
- (prose-tag fg-alt)
- (prose-todo red)
- (prose-verbatim magenta-warmer)
+ (prose-table-formula red-cooler)
+
+ (prose-tag magenta-faint)
;;;; Rainbow mappings
@@ -366,6 +384,17 @@ standard)."
(rainbow-7 magenta-faint)
(rainbow-8 red-faint)
+;;;; Search mappings
+
+ (bg-search-current bg-red-intense)
+ (bg-search-lazy bg-cyan-intense)
+ (bg-search-replace bg-magenta-intense)
+
+ (bg-search-rx-group-0 bg-blue-intense)
+ (bg-search-rx-group-1 bg-magenta-intense)
+ (bg-search-rx-group-2 bg-cyan-subtle)
+ (bg-search-rx-group-3 bg-red-subtle)
+
;;;; Space mappings
(bg-space unspecified)
@@ -374,10 +403,10 @@ standard)."
;;;; Terminal mappings
- (bg-term-black "black")
- (fg-term-black "black")
- (bg-term-black-bright "gray35")
- (fg-term-black-bright "gray35")
+ (bg-term-black "#000000")
+ (fg-term-black "#000000")
+ (bg-term-black-bright "#595959")
+ (fg-term-black-bright "#595959")
(bg-term-red red)
(fg-term-red red)
@@ -409,10 +438,10 @@ standard)."
(bg-term-cyan-bright cyan-cooler)
(fg-term-cyan-bright cyan-cooler)
- (bg-term-white "gray65")
- (fg-term-white "gray65")
- (bg-term-white-bright "white")
- (fg-term-white-bright "white")
+ (bg-term-white "#a6a6a6")
+ (fg-term-white "#a6a6a6")
+ (bg-term-white-bright "#ffffff")
+ (fg-term-white-bright "#ffffff")
;;;; Heading mappings
diff --git a/exec/configure.ac b/exec/configure.ac
index 317250332cb..a473a1dc633 100644
--- a/exec/configure.ac
+++ b/exec/configure.ac
@@ -122,6 +122,7 @@ AH_TEMPLATE([SYSCALL_RET_REG], [Define to register holding
value of system calls
AH_TEMPLATE([STACK_POINTER], [Define to register holding the stack pointer.])
AH_TEMPLATE([EXEC_SYSCALL], [Define to number of the `exec' system call.])
AH_TEMPLATE([USER_WORD], [Define to word type used by tracees.])
+AH_TEMPLATE([USER_SWORD], [Define to signed word type used by tracees.])
AH_TEMPLATE([EXEC_64], [Define to 1 if the system utilizes 64-bit ELF.])
AH_TEMPLATE([STACK_GROWS_DOWNWARDS], [Define to 1 if the stack grows
downwards.])
AH_TEMPLATE([ABI_RED_ZONE], [Define to number of reserved bytes past the stack
frame.])
@@ -251,6 +252,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [rsp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([ABI_RED_ZONE], [128])
AC_DEFINE([EXECUTABLE_BASE], [0x555555554000])
@@ -283,6 +285,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [esp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0xaf000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@@ -313,6 +316,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [sp])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x3000000000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])
@@ -344,6 +348,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@@ -368,6 +373,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[uregs[13]]])
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@@ -398,6 +404,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXECUTABLE_BASE], [0x0f000000])
AC_DEFINE([INTERPRETER_BASE], [0x1f000000])
AC_DEFINE([STACK_GROWS_DOWNWARDS], [1])
@@ -427,6 +434,7 @@ AS_CASE([$host], [x86_64-*linux*],
AC_DEFINE([STACK_POINTER], [[gregs[29]]]) # sp
AC_DEFINE([EXEC_SYSCALL], [__NR_execve])
AC_DEFINE([USER_WORD], [uintptr_t])
+ AC_DEFINE([USER_SWORD], [intptr_t])
AC_DEFINE([EXEC_64], [1])
AC_DEFINE([EXECUTABLE_BASE], [0x400000])
AC_DEFINE([INTERPRETER_BASE], [0x3f00000000])
diff --git a/exec/exec.c b/exec/exec.c
index 254a983f25f..cbe22d4f18c 100644
--- a/exec/exec.c
+++ b/exec/exec.c
@@ -865,7 +865,7 @@ insert_args (struct exec_tracee *tracee, USER_REGS_STRUCT
*regs,
result in *IN, and return a pointer to the byte after the
result. REM should be NULL. */
-static char *
+char *
format_pid (char *in, unsigned int pid)
{
unsigned int digits[32], *fill;
diff --git a/exec/exec.h b/exec/exec.h
index ad1b50276c8..3ce06c35311 100644
--- a/exec/exec.h
+++ b/exec/exec.h
@@ -180,6 +180,7 @@ extern int aarch64_set_regs (pid_t, USER_REGS_STRUCT *,
bool);
+extern char *format_pid (char *, unsigned int);
extern USER_WORD user_alloca (struct exec_tracee *, USER_REGS_STRUCT *,
USER_REGS_STRUCT *, USER_WORD);
extern int user_copy (struct exec_tracee *, const unsigned char *,
diff --git a/exec/trace.c b/exec/trace.c
index a7cbda54d68..05d862f5b9f 100644
--- a/exec/trace.c
+++ b/exec/trace.c
@@ -31,6 +31,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>
+#include <fcntl.h>
#include "exec.h"
@@ -894,6 +895,98 @@ handle_exec (struct exec_tracee *tracee, USER_REGS_STRUCT
*regs)
return 3;
}
+
+
+/* Define replacements for required string functions. */
+
+#if !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY
+
+/* Copy SRC to DEST, returning the address of the terminating '\0' in
+ DEST. */
+
+static char *
+rpl_stpcpy (char *dest, const char *src)
+{
+ register char *d;
+ register const char *s;
+
+ d = dest;
+ s = src;
+
+ do
+ *d++ = *s;
+ while (*s++ != '\0');
+
+ return d - 1;
+}
+
+#define stpcpy rpl_stpcpy
+#endif /* !defined HAVE_STPCPY || !defined HAVE_DECL_STPCPY */
+
+
+
+/* Modify BUFFER, of size SIZE, so that it holds the absolute name of
+ the file identified by BUFFER, relative to the current working
+ directory of TRACEE if FD be AT_FDCWD, or the file referenced by FD
+ otherwise.
+
+ Value is 1 if this information is unavailable (of which there are
+ variety of causes), and 0 on success. */
+
+static int
+canon_path (struct exec_tracee *tracee, int fd, char *buffer,
+ ptrdiff_t size)
+{
+ char link[sizeof "/proc//fd/" + 48], *p; /* Or /proc/pid/cwd. */
+ char target[PATH_MAX];
+ ssize_t rc, length;
+
+ if (buffer[0] == '/')
+ /* Absolute file name; return immediately. */
+ return 0;
+ else if (fd == AT_FDCWD)
+ {
+ p = stpcpy (link, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/cwd");
+ }
+ else if (fd < 0)
+ /* Invalid file descriptor. */
+ return 1;
+ else
+ {
+ p = stpcpy (link, "/proc/");
+ p = format_pid (p, tracee->pid);
+ p = stpcpy (p, "/fd/");
+ format_pid (p, fd);
+ }
+
+ /* Read LINK's target, and should it be oversized, punt. */
+ rc = readlink (link, target, PATH_MAX);
+ if (rc < 0 || rc >= PATH_MAX)
+ return 1;
+
+ /* Consider the amount by which BUFFER's existing contents should be
+ displaced. */
+
+ length = strlen (buffer) + 1;
+ if ((length + rc + (target[rc - 1] != '/')) > size)
+ /* Punt if this would overflow. */
+ return 1;
+
+ memmove ((buffer + rc + (target[rc - 1] != '/')),
+ buffer, length);
+
+ /* Copy the new file name into BUFFER. */
+ memcpy (buffer, target, rc);
+
+ /* Insert separator in between if need be. */
+ if (target[rc - 1] != '/')
+ buffer[rc] = '/';
+
+ return 0;
+}
+
/* Handle a `readlink' or `readlinkat' system call.
CALLNO is the system call number, and REGS are the current user
@@ -924,22 +1017,26 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT
*regs,
char buffer[PATH_MAX + 1];
USER_WORD address, return_buffer, size;
size_t length;
+ char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
+ int dirfd;
/* Read the file name. */
#ifdef READLINK_SYSCALL
if (callno == READLINK_SYSCALL)
{
- address = regs->SYSCALL_ARG_REG;
+ dirfd = AT_FDCWD;
+ address = regs->SYSCALL_ARG_REG;
return_buffer = regs->SYSCALL_ARG1_REG;
- size = regs->SYSCALL_ARG2_REG;
+ size = regs->SYSCALL_ARG2_REG;
}
else
#endif /* READLINK_SYSCALL */
{
- address = regs->SYSCALL_ARG1_REG;
+ dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
+ address = regs->SYSCALL_ARG1_REG;
return_buffer = regs->SYSCALL_ARG2_REG;
- size = regs->SYSCALL_ARG3_REG;
+ size = regs->SYSCALL_ARG3_REG;
}
read_memory (tracee, buffer, PATH_MAX, address);
@@ -952,12 +1049,25 @@ handle_readlinkat (USER_WORD callno, USER_REGS_STRUCT
*regs,
return 1;
}
- /* Now check if the caller is looking for /proc/self/exe.
+ /* Expand BUFFER into an absolute file name. TODO:
+ AT_SYMLINK_FOLLOW? */
+
+ if (canon_path (tracee, dirfd, buffer, sizeof buffer))
+ return 0;
+
+ /* Now check if the caller is looking for /proc/self/exe or its
+ equivalent with the PID made explicit.
dirfd can be ignored, as for now only absolute file names are
handled. FIXME. */
- if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file)
+ p = stpcpy (proc_pid_exe, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/exe");
+
+ if ((strcmp (buffer, "/proc/self/exe")
+ && strcmp (buffer, proc_pid_exe))
+ || !tracee->exec_file)
return 0;
/* Copy over tracee->exec_file. Truncate it to PATH_MAX, length, or
@@ -1004,15 +1114,23 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs,
USER_WORD address;
size_t length;
USER_REGS_STRUCT original;
+ char proc_pid_exe[sizeof "/proc//exe" + 24], *p;
+ int dirfd;
/* Read the file name. */
#ifdef OPEN_SYSCALL
if (callno == OPEN_SYSCALL)
- address = regs->SYSCALL_ARG_REG;
+ {
+ dirfd = AT_FDCWD;
+ address = regs->SYSCALL_ARG_REG;
+ }
else
#endif /* OPEN_SYSCALL */
- address = regs->SYSCALL_ARG1_REG;
+ {
+ dirfd = (USER_SWORD) regs->SYSCALL_ARG_REG;
+ address = regs->SYSCALL_ARG1_REG;
+ }
/* Read the file name into the buffer and verify that it is NULL
terminated. */
@@ -1024,12 +1142,25 @@ handle_openat (USER_WORD callno, USER_REGS_STRUCT *regs,
return 1;
}
- /* Now check if the caller is looking for /proc/self/exe.
+ /* Expand BUFFER into an absolute file name. TODO:
+ AT_SYMLINK_FOLLOW? */
+
+ if (canon_path (tracee, dirfd, buffer, sizeof buffer))
+ return 0;
+
+ /* Now check if the caller is looking for /proc/self/exe or its
+ equivalent with the PID made explicit.
dirfd can be ignored, as for now only absolute file names are
handled. FIXME. */
- if (strcmp (buffer, "/proc/self/exe") || !tracee->exec_file)
+ p = stpcpy (proc_pid_exe, "/proc/");
+ p = format_pid (p, tracee->pid);
+ stpcpy (p, "/exe");
+
+ if ((strcmp (buffer, "/proc/self/exe")
+ && strcmp (buffer, proc_pid_exe))
+ || !tracee->exec_file)
return 0;
/* Copy over tracee->exec_file. This doesn't correctly handle the
diff --git a/java/AndroidManifest.xml.in b/java/AndroidManifest.xml.in
index 4d23c752747..563914fb02c 100644
--- a/java/AndroidManifest.xml.in
+++ b/java/AndroidManifest.xml.in
@@ -218,6 +218,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
<activity android:name="org.gnu.emacs.EmacsActivity"
android:launchMode="singleInstance"
+ android:taskAffinity="emacs.primary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale">
@@ -229,7 +230,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsOpenActivity"
- android:taskAffinity="open.dialog"
+ android:taskAffinity="emacs.open_dialog"
android:excludeFromRecents="true"
android:exported="true">
@@ -273,6 +274,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. -->
</activity>
<activity android:name="org.gnu.emacs.EmacsMultitaskActivity"
+ android:taskAffinity="emacs.secondary_frame"
android:windowSoftInputMode="adjustResize"
android:exported="true"
android:configChanges="orientation|screenSize|screenLayout|keyboardHidden|locale|fontScale"/>
diff --git a/java/INSTALL b/java/INSTALL
index 175ff2826b2..f1063b40c25 100644
--- a/java/INSTALL
+++ b/java/INSTALL
@@ -166,25 +166,21 @@ than a compressed package for a newer version of Android.
BUILDING C++ DEPENDENCIES
-With a new version of the NDK, dependencies containing C++ code should
-build without any further configuration. However, older versions
-require that you use the ``make_standalone_toolchain.py'' script in
-the NDK distribution to create a ``standalone toolchain'', and use
-that instead, in order for C++ headers to be found.
-
-See https://developer.android.com/ndk/guides/standalone_toolchain for
-more details; when a ``standalone toolchain'' is specified, the
-configure script will try to determine the location of the C++
-compiler based on the C compiler specified. If that automatic
-detection does not work, you can specify a C++ compiler yourself, like
-so:
-
- ./configure --with-ndk-cxx=/path/to/toolchain/bin/i686-linux-android-g++
-
-Some versions of the NDK have a bug, where GCC fails to locate
-``stddef.h'' after being copied to a standalone toolchain. To work
-around this problem (which normally exhibits itself when building C++
-code), add:
+In normal circumstances, Emacs should automatically detect and configure
+one of the C++ standard libraries part of the NDK when such a library is
+required to build a dependency specified under `--with-ndk-path'.
+
+Nevertheless, this process is not infalliable, and with certain versions
+of the NDK is liable to fail to locate a C++ compiler, requiring that
+you run the `make_standalone_toolchain.py' script in the NDK
+distribution to create a ``standalone toolchain'' and substitute the
+same for the regular compiler toolchain. See
+https://developer.android.com/ndk/guides/standalone_toolchain for
+further details.
+
+Some versions of the NDK that ship GCC 4.9.x exhibit a bug where the
+compiler cannot locate `stddef.h' after being copied to a standalone
+toolchain. To work around this problem, add:
-isystem /path/to/toolchain/include/c++/4.9.x
diff --git a/java/org/gnu/emacs/EmacsDesktopNotification.java
b/java/org/gnu/emacs/EmacsDesktopNotification.java
index d05ed2e6203..72569631a8c 100644
--- a/java/org/gnu/emacs/EmacsDesktopNotification.java
+++ b/java/org/gnu/emacs/EmacsDesktopNotification.java
@@ -83,11 +83,16 @@ public final class EmacsDesktopNotification
notification. */
public final String[] actions, titles;
+ /* Delay in miliseconds after which this notification should be
+ automatically dismissed. */
+ public final long delay;
+
public
EmacsDesktopNotification (String title, String content,
String group, String tag, int icon,
int importance,
- String[] actions, String[] titles)
+ String[] actions, String[] titles,
+ long delay)
{
this.content = content;
this.title = title;
@@ -97,6 +102,7 @@ public final class EmacsDesktopNotification
this.importance = importance;
this.actions = actions;
this.titles = titles;
+ this.delay = delay;
}
@@ -191,6 +197,8 @@ public final class EmacsDesktopNotification
builder.setContentTitle (title);
builder.setContentText (content);
builder.setSmallIcon (icon);
+ builder.setTimeoutAfter (delay);
+
insertActions (context, builder);
notification = builder.build ();
}
@@ -200,35 +208,35 @@ public final class EmacsDesktopNotification
distinct categories, but permit an importance to be
assigned to each individual notification. */
- switch (importance)
- {
- case 2: /* IMPORTANCE_LOW */
- default:
- priority = Notification.PRIORITY_LOW;
- break;
-
- case 3: /* IMPORTANCE_DEFAULT */
- priority = Notification.PRIORITY_DEFAULT;
- break;
-
- case 4: /* IMPORTANCE_HIGH */
- priority = Notification.PRIORITY_HIGH;
- break;
- }
-
builder = new Notification.Builder (context);
builder.setContentTitle (title);
builder.setContentText (content);
builder.setSmallIcon (icon);
- builder.setPriority (priority);
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.JELLY_BEAN)
- insertActions (context, builder);
-
- notification = builder.build ();
-
- if (Build.VERSION.SDK_INT > Build.VERSION_CODES.JELLY_BEAN)
- notification.priority = priority;
+ {
+ switch (importance)
+ {
+ case 2: /* IMPORTANCE_LOW */
+ default:
+ priority = Notification.PRIORITY_LOW;
+ break;
+
+ case 3: /* IMPORTANCE_DEFAULT */
+ priority = Notification.PRIORITY_DEFAULT;
+ break;
+
+ case 4: /* IMPORTANCE_HIGH */
+ priority = Notification.PRIORITY_HIGH;
+ break;
+ }
+
+ builder.setPriority (priority);
+ insertActions (context, builder);
+ notification = builder.build ();
+ }
+ else
+ notification = builder.getNotification ();
}
else
{
diff --git a/java/org/gnu/emacs/EmacsNative.java
b/java/org/gnu/emacs/EmacsNative.java
index 6845f833908..654e94b1a7d 100644
--- a/java/org/gnu/emacs/EmacsNative.java
+++ b/java/org/gnu/emacs/EmacsNative.java
@@ -281,7 +281,7 @@ public final class EmacsNative
public static native int[] getSelection (short window);
- /* Graphics functions used as a replacement for potentially buggy
+ /* Graphics functions used as replacements for potentially buggy
Android APIs. */
public static native void blitRect (Bitmap src, Bitmap dest, int x1,
@@ -289,7 +289,6 @@ public final class EmacsNative
/* Increment the generation ID of the specified BITMAP, forcing its
texture to be re-uploaded to the GPU. */
-
public static native void notifyPixelsChanged (Bitmap bitmap);
@@ -313,6 +312,13 @@ public final class EmacsNative
in the process. */
public static native boolean ftruncate (int fd);
+
+ /* Functions that assist in generating content file names. */
+
+ /* Calculate an 8 digit checksum for the byte array DISPLAYNAME
+ suitable for inclusion in a content file name. */
+ public static native String displayNameHash (byte[] displayName);
+
static
{
/* Older versions of Android cannot link correctly with shared
@@ -323,7 +329,9 @@ public final class EmacsNative
Every time you add a new shared library dependency to Emacs,
please add it here as well. */
- libraryDeps = new String[] { "png_emacs", "selinux_emacs",
+ libraryDeps = new String[] { "c++_shared", "gnustl_shared",
+ "stlport_shared", "gabi++_shared",
+ "png_emacs", "selinux_emacs",
"crypto_emacs", "pcre_emacs",
"packagelistparser_emacs",
"gnutls_emacs", "gmp_emacs",
@@ -331,7 +339,7 @@ public final class EmacsNative
"tasn1_emacs", "hogweed_emacs",
"jansson_emacs", "jpeg_emacs",
"tiff_emacs", "xml2_emacs",
- "icuuc_emacs",
+ "icuuc_emacs", "harfbuzz_emacs",
"tree-sitter_emacs", };
for (String dependency : libraryDeps)
diff --git a/java/org/gnu/emacs/EmacsOpenActivity.java
b/java/org/gnu/emacs/EmacsOpenActivity.java
index 9ae1bf353dd..327a53bc417 100644
--- a/java/org/gnu/emacs/EmacsOpenActivity.java
+++ b/java/org/gnu/emacs/EmacsOpenActivity.java
@@ -252,7 +252,7 @@ public final class EmacsOpenActivity extends Activity
if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.KITKAT)
{
- content = EmacsService.buildContentName (uri);
+ content = EmacsService.buildContentName (uri, getContentResolver ());
return content;
}
@@ -423,6 +423,7 @@ public final class EmacsOpenActivity extends Activity
/* Obtain the intent that started Emacs. */
intent = getIntent ();
action = intent.getAction ();
+ resolver = getContentResolver ();
if (action == null)
{
@@ -534,9 +535,19 @@ public final class EmacsOpenActivity extends Activity
uri = intent.getParcelableExtra (Intent.EXTRA_STREAM);
if ((scheme = uri.getScheme ()) != null
- && scheme.equals ("content"))
+ && scheme.equals ("content")
+ && (Build.VERSION.SDK_INT
+ >= Build.VERSION_CODES.KITKAT))
{
- tem1 = EmacsService.buildContentName (uri);
+ tem1 = EmacsService.buildContentName (uri, resolver);
+ attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
+ .replace ("\"", "\\\"")
+ .replace ("$", "\\$"))
+ + "\")");
+ }
+ else if (scheme != null && scheme.equals ("file"))
+ {
+ tem1 = uri.getPath ();
attachmentString = ("'(\"" + (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
.replace ("$", "\\$"))
@@ -566,9 +577,22 @@ public final class EmacsOpenActivity extends Activity
if (uri != null
&& (scheme = uri.getScheme ()) != null
- && scheme.equals ("content"))
+ && scheme.equals ("content")
+ && (Build.VERSION.SDK_INT
+ >= Build.VERSION_CODES.KITKAT))
+ {
+ tem1
+ = EmacsService.buildContentName (uri, resolver);
+ builder.append ("\"");
+ builder.append (tem1.replace ("\\", "\\\\")
+ .replace ("\"", "\\\"")
+ .replace ("$", "\\$"));
+ builder.append ("\"");
+ }
+ else if (scheme != null
+ && scheme.equals ("file"))
{
- tem1 = EmacsService.buildContentName (uri);
+ tem1 = uri.getPath ();
builder.append ("\"");
builder.append (tem1.replace ("\\", "\\\\")
.replace ("\"", "\\\"")
@@ -602,14 +626,19 @@ public final class EmacsOpenActivity extends Activity
{
fileName = null;
- if (scheme.equals ("content"))
+ if (scheme.equals ("content")
+ /* Retrieving the native file descriptor of a
+ ParcelFileDescriptor requires Honeycomb, and
+ proceeding without this capability is pointless on
+ systems before KitKat, since Emacs doesn't support
+ opening content files on those. */
+ && Build.VERSION.SDK_INT >= Build.VERSION_CODES.HONEYCOMB)
{
/* This is one of the annoying Android ``content''
URIs. Most of the time, there is actually an
underlying file, but it cannot be found without
opening the file and doing readlink on its file
descriptor in /proc/self/fd. */
- resolver = getContentResolver ();
fd = null;
try
diff --git a/java/org/gnu/emacs/EmacsService.java
b/java/org/gnu/emacs/EmacsService.java
index 9bc40d63311..07bfb525be9 100644
--- a/java/org/gnu/emacs/EmacsService.java
+++ b/java/org/gnu/emacs/EmacsService.java
@@ -19,6 +19,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
package org.gnu.emacs;
+import java.io.ByteArrayOutputStream;
import java.io.FileNotFoundException;
import java.io.IOException;
import java.io.UnsupportedEncodingException;
@@ -79,6 +80,7 @@ import android.os.VibrationEffect;
import android.provider.DocumentsContract;
import android.provider.DocumentsContract.Document;
+import android.provider.OpenableColumns;
import android.provider.Settings;
import android.util.Log;
@@ -1033,22 +1035,114 @@ public final class EmacsService extends Service
return false;
}
+ /* Return a 8 character checksum for the string STRING, after encoding
+ as UTF-8 data. */
+
+ public static String
+ getDisplayNameHash (String string)
+ {
+ byte[] encoded;
+ ByteArrayOutputStream stream;
+ int i, ch;
+
+ /* Much of the VFS code expects file names to be encoded as modified
+ UTF-8 data, but Android's JNI implementation produces (while not
+ accepting!) regular UTF-8 sequences for all characters, even
+ non-Emoji ones. With no documentation to this effect, save for
+ two comments nestled in the source code of the Java virtual
+ machine, it is not sound to assume that this behavior will not be
+ revised in future or modified releases of Android, and as such,
+ encode STRING into modified UTF-8 by hand, to protect against
+ future changes in this respect. */
+
+ stream = new ByteArrayOutputStream ();
+
+ for (i = 0; i < string.length (); ++i)
+ {
+ ch = string.charAt (i);
+
+ if (ch != 0 && ch <= 127)
+ stream.write (ch);
+ else if (ch <= 2047)
+ {
+ stream.write (0xc0 | (0x1f & (ch >> 6)));
+ stream.write (0x80 | (0x3f & ch));
+ }
+ else
+ {
+ stream.write (0xe0 | (0x0f & (ch >> 12)));
+ stream.write (0x80 | (0x3f & (ch >> 6)));
+ stream.write (0x80 | (0x3f & ch));
+ }
+ }
+
+ encoded = stream.toByteArray ();
+
+ /* Closing a ByteArrayOutputStream has no effect.
+ encoded.close (); */
+
+ return EmacsNative.displayNameHash (encoded);
+ }
+
/* Build a content file name for URI.
Return a file name within the /contents/by-authority
pseudo-directory that `android_get_content_name' can then
transform back into an encoded URI.
+ If a display name can be requested from URI (using the resolver
+ RESOLVER), append it to this file name.
+
A content name consists of any number of unencoded path segments
separated by `/' characters, possibly followed by a question mark
and an encoded query string. */
public static String
- buildContentName (Uri uri)
+ buildContentName (Uri uri, ContentResolver resolver)
{
StringBuilder builder;
+ String displayName;
+ Cursor cursor;
+ int column;
+
+ displayName = null;
+ cursor = null;
- builder = new StringBuilder ("/content/by-authority/");
+ try
+ {
+ cursor = resolver.query (uri, null, null, null, null);
+
+ if (cursor != null)
+ {
+ cursor.moveToFirst ();
+ column
+ = cursor.getColumnIndexOrThrow (OpenableColumns.DISPLAY_NAME);
+ displayName
+ = cursor.getString (column);
+
+ /* Verify that the display name is valid, i.e. it
+ contains no characters unsuitable for a file name and
+ is nonempty. */
+ if (displayName.isEmpty () || displayName.contains ("/"))
+ displayName = null;
+ }
+ }
+ catch (Exception e)
+ {
+ /* Ignored. */
+ }
+ finally
+ {
+ if (cursor != null)
+ cursor.close ();
+ }
+
+ /* If a display name is available, at this point it should be the
+ value of displayName. */
+
+ builder = new StringBuilder (displayName != null
+ ? "/content/by-authority-named/"
+ : "/content/by-authority/");
builder.append (uri.getAuthority ());
/* First, append each path segment. */
@@ -1065,6 +1159,16 @@ public final class EmacsService extends Service
if (uri.getEncodedQuery () != null)
builder.append ('?').append (uri.getEncodedQuery ());
+ /* Append the display name. */
+
+ if (displayName != null)
+ {
+ builder.append ('/');
+ builder.append (getDisplayNameHash (displayName));
+ builder.append ('/');
+ builder.append (displayName);
+ }
+
return builder.toString ();
}
diff --git a/java/org/gnu/emacs/EmacsWindow.java
b/java/org/gnu/emacs/EmacsWindow.java
index 6e8bdaf7401..2baede1d2d0 100644
--- a/java/org/gnu/emacs/EmacsWindow.java
+++ b/java/org/gnu/emacs/EmacsWindow.java
@@ -23,7 +23,6 @@ import java.lang.IllegalStateException;
import java.util.ArrayList;
import java.util.List;
import java.util.ListIterator;
-import java.util.HashMap;
import java.util.LinkedHashMap;
import java.util.Map;
@@ -31,6 +30,7 @@ import android.app.Activity;
import android.content.ClipData;
import android.content.ClipDescription;
+import android.content.ContentResolver;
import android.content.Context;
import android.graphics.Rect;
@@ -49,6 +49,7 @@ import android.view.View;
import android.view.ViewManager;
import android.view.WindowManager;
+import android.util.SparseArray;
import android.util.Log;
import android.os.Build;
@@ -108,7 +109,7 @@ public final class EmacsWindow extends EmacsHandleObject
/* Map between pointer identifiers and last known position. Used to
compute which pointer changed upon a touch event. */
- private HashMap<Integer, Coordinate> pointerMap;
+ private SparseArray<Coordinate> pointerMap;
/* The window consumer currently attached, if it exists. */
private EmacsWindowAttachmentManager.WindowConsumer attached;
@@ -165,7 +166,7 @@ public final class EmacsWindow extends EmacsHandleObject
super (handle);
rect = new Rect (x, y, x + width, y + height);
- pointerMap = new HashMap<Integer, Coordinate> ();
+ pointerMap = new SparseArray<Coordinate> ();
/* Create the view from the context's UI thread. The window is
unmapped, so the view is GONE. */
@@ -1000,7 +1001,8 @@ public final class EmacsWindow extends EmacsHandleObject
case MotionEvent.ACTION_CANCEL:
/* Primary pointer released with index 0. */
pointerID = event.getPointerId (0);
- coordinate = pointerMap.remove (pointerID);
+ coordinate = pointerMap.get (pointerID);
+ pointerMap.delete (pointerID);
break;
case MotionEvent.ACTION_POINTER_DOWN:
@@ -1019,7 +1021,8 @@ public final class EmacsWindow extends EmacsHandleObject
/* Pointer removed. Remove it from the map. */
pointerIndex = event.getActionIndex ();
pointerID = event.getPointerId (pointerIndex);
- coordinate = pointerMap.remove (pointerID);
+ coordinate = pointerMap.get (pointerID);
+ pointerMap.delete (pointerID);
break;
default:
@@ -1699,10 +1702,11 @@ public final class EmacsWindow extends EmacsHandleObject
ClipData data;
ClipDescription description;
int i, j, x, y, itemCount;
- String type;
+ String type, uriString;
Uri uri;
EmacsActivity activity;
StringBuilder builder;
+ ContentResolver resolver;
x = (int) event.getX ();
y = (int) event.getY ();
@@ -1799,6 +1803,20 @@ public final class EmacsWindow extends EmacsHandleObject
{
if ((activity.requestDragAndDropPermissions (event) == null))
uri = null;
+ else
+ {
+ resolver = activity.getContentResolver ();
+
+ /* Substitute a content file name for the URI, if
+ possible. */
+ uriString = EmacsService.buildContentName (uri, resolver);
+
+ if (uriString != null)
+ {
+ builder.append (uriString).append ("\n");
+ continue;
+ }
+ }
}
if (uri != null)
diff --git a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
index 18bdb6dbf60..aae4e2ee49b 100644
--- a/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
+++ b/java/org/gnu/emacs/EmacsWindowAttachmentManager.java
@@ -124,10 +124,15 @@ public final class EmacsWindowAttachmentManager
intent = new Intent (EmacsService.SERVICE,
EmacsMultitaskActivity.class);
- intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT
- | Intent.FLAG_ACTIVITY_NEW_TASK
+
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_TASK
| Intent.FLAG_ACTIVITY_MULTIPLE_TASK);
+ /* Intent.FLAG_ACTIVITY_NEW_DOCUMENT is lamentably unavailable on
+ older systems than Lolipop. */
+ if (Build.VERSION.SDK_INT >= Build.VERSION_CODES.LOLLIPOP)
+ intent.addFlags (Intent.FLAG_ACTIVITY_NEW_DOCUMENT);
+
if (Build.VERSION.SDK_INT < Build.VERSION_CODES.N)
EmacsService.SERVICE.startActivity (intent);
else
diff --git a/lisp/bind-key.el b/lisp/bind-key.el
index 378ad69b2bc..780314fecbd 100644
--- a/lisp/bind-key.el
+++ b/lisp/bind-key.el
@@ -453,31 +453,28 @@ other modes. See `override-global-mode'."
(macroexp-progn (bind-keys-form args 'override-global-map)))
(defun bind-key--get-binding-description (elem)
- (cond
- ((listp elem)
+ (let (doc)
(cond
- ((memq (car elem) '(lambda function))
- (if (and bind-key-describe-special-forms
- (stringp (nth 2 elem)))
- (nth 2 elem)
- "#<lambda>"))
- ((eq 'closure (car elem))
- (if (and bind-key-describe-special-forms
- (stringp (nth 3 elem)))
- (nth 3 elem)
- "#<closure>"))
- ((eq 'keymap (car elem))
- "#<keymap>")
+ ((symbolp elem)
+ (cond
+ ((and bind-key-describe-special-forms (keymapp elem)
+ ;; FIXME: Is this really ever better than the symbol-name?
+ ;; FIXME: `variable-documentation' describe what's in
+ ;; elem's `symbol-value', whereas `elem' here stands for
+ ;; its `symbol-function'.
+ (stringp (setq doc (get elem 'variable-documentation))))
+ doc)
+ (t elem)))
+ ((and bind-key-describe-special-forms (functionp elem)
+ (stringp (setq doc (documentation elem))))
+ doc) ;;FIXME: Keep only the first line?
+ ;; FIXME: Use `help-fns-function-name'?
+ ((consp elem)
+ (if (symbolp (car elem))
+ (format "#<%s>" (car elem))
+ elem))
(t
- elem)))
- ;; must be a symbol, non-symbol keymap case covered above
- ((and bind-key-describe-special-forms (keymapp elem))
- (let ((doc (get elem 'variable-documentation)))
- (if (stringp doc) doc elem)))
- ((symbolp elem)
- elem)
- (t
- "#<byte-compiled lambda>")))
+ (format "#<%s>" (type-of elem))))))
(defun bind-key--compare-keybindings (l r)
(let* ((regex bind-key-segregation-regexp)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 2c3e7d28301..10c86571804 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1985,7 +1985,7 @@ Gregorian date Sunday, December 31, 1 BC. This function
does not
handle dates in years BC."
;; For an explanation, see the footnote on page 384 of "Calendrical
;; Calculations, Part II: Three Historical Calendars" by
- ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
+ ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen,
;; Software--Practice and Experience, Volume 23, Number 4 (April,
;; 1993), pages 383-404 <https://doi.org/10.1002/spe.4380230404>
;;
<http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.42.6421&rep=rep1&type=pdf>.
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index f2ee94ec8f7..12287299a7f 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1612,7 +1612,7 @@ archive file and the source category is deleted."
(garchive (concat (file-name-sans-extension gfile) ".toda"))
(archived-count (todo-get-count 'archived))
here)
- (with-current-buffer (get-buffer (find-file-noselect tfile))
+ (with-current-buffer (find-file-noselect tfile)
(widen)
(let* ((inhibit-read-only t)
(cbeg (progn
@@ -1638,7 +1638,7 @@ archive file and the source category is deleted."
(todo-count (todo-get-count 'todo cat))
(done-count (todo-get-count 'done cat)))
;; Merge into goal todo category.
- (with-current-buffer (get-buffer (find-file-noselect gfile))
+ (with-current-buffer (find-file-noselect gfile)
(unless (derived-mode-p 'todo-mode) (todo-mode))
(widen)
(goto-char (point-min))
@@ -1677,7 +1677,7 @@ archive file and the source category is deleted."
(mapc (lambda (m) (set-marker m nil))
(list cbeg tbeg dbeg tend cend))))
(when (> archived-count 0)
- (with-current-buffer (get-buffer (find-file-noselect tarchive))
+ (with-current-buffer (find-file-noselect tarchive)
(widen)
(goto-char (point-min))
(let* ((inhibit-read-only t)
@@ -1697,7 +1697,7 @@ archive file and the source category is deleted."
(forward-line)
(buffer-substring-no-properties (point) cend))))
;; Merge into goal archive category, if it exists, else create it.
- (with-current-buffer (get-buffer (find-file-noselect garchive))
+ (with-current-buffer (find-file-noselect garchive)
(let ((gbeg (when (re-search-forward
(concat "^" (regexp-quote
(concat todo-category-beg goal))
diff --git a/lisp/comint.el b/lisp/comint.el
index 655ff30469c..a8fe095e99c 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -3510,7 +3510,7 @@ the completions."
;; Read the next key, to process SPC.
(let (key first)
- (if (with-current-buffer (get-buffer "*Completions*")
+ (if (with-current-buffer "*Completions*"
(setq-local comint-displayed-dynamic-completions
completions)
(setq key (read-key-sequence nil)
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index 8fad51dc116..f004002333b 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1159,14 +1159,15 @@ argument or if the current major mode has no known
group, prompt
for the MODE to customize."
(interactive
(list
- (let ((completion-regexp-list '("-mode\\'"))
- (group (custom-group-of-mode major-mode)))
+ (let ((group (custom-group-of-mode major-mode)))
(if (and group (not current-prefix-arg))
major-mode
(intern
(completing-read (format-prompt "Mode" (and group major-mode))
obarray
- 'custom-group-of-mode
+ (lambda (s)
+ (and (string-match "-mode\\'" (symbol-name s))
+ (custom-group-of-mode s)))
t nil nil (if group (symbol-name major-mode))))))))
(customize-group (custom-group-of-mode mode)))
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 3fe62c8d0da..165296d2242 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -846,6 +846,8 @@ since it could result in memory overflow and make Emacs
crash."
(x-select-enable-clipboard-manager killing boolean "24.1")
;; xsettings.c
(font-use-system-font font-selection boolean "23.2")
+ ;; xwidget.c
+ (xwidget-webkit-disable-javascript xwidget boolean "30.1")
;; haikuterm.c
(haiku-debug-on-fatal-error debug boolean "29.1")
;; haikufns.c
@@ -906,6 +908,8 @@ since it could result in memory overflow and make Emacs
crash."
(symbol-name symbol))
;; Any function from fontset.c will do.
(fboundp 'new-fontset))
+ ((string-match "xwidget-" (symbol-name symbol))
+ (boundp 'xwidget-internal))
(t t))))
(if (not (boundp symbol))
;; If variables are removed from C code, give an error here!
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index eeab995c37d..524a6474cd4 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -42,26 +42,6 @@
(insert-text-button
"(widget)Top" 'type 'help-info 'help-args '("(widget)Top")))
-(defun describe-text-sexp (sexp)
- "Insert a short description of SEXP in the current buffer."
- (let ((pp (condition-case signal
- (pp-to-string sexp)
- (error (prin1-to-string signal)))))
- (when (string-match-p "\n\\'" pp)
- (setq pp (substring pp 0 (1- (length pp)))))
-
- (if (and (not (string-search "\n" pp))
- (<= (length pp) (- (window-width) (current-column))))
- (insert pp)
- (insert-text-button
- "[Show]"
- 'follow-link t
- 'action (lambda (&rest _ignore)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ pp)))
- 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
-
(defun describe-property-list (properties)
"Insert a description of PROPERTIES in the current buffer.
PROPERTIES should be a list of overlay or text properties.
@@ -92,7 +72,9 @@ into help buttons that call `describe-text-category' or
(format "%S" value)
'type 'help-face 'help-args (list value)))
(t
- (describe-text-sexp value))))
+ (require 'pp)
+ (declare-function pp-insert-short-sexp "pp" (sexp &optional width))
+ (pp-insert-short-sexp value))))
(insert "\n")))
;;; Describe-Text Commands.
@@ -522,24 +504,24 @@ The character information includes:
(setcar composition
(concat
" with the surrounding characters \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring from pos) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring from pos))
"\" and \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring (1+ pos) to) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring (1+ pos) to))
"\""))
(setcar composition
(concat
" with the preceding character(s) \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring from pos) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring from pos))
"\"")))
(if (< (1+ pos) to)
(setcar composition
(concat
" with the following character(s) \""
- (mapconcat 'describe-char-padded-string
- (buffer-substring (1+ pos) to) "")
+ (mapconcat #'describe-char-padded-string
+ (buffer-substring (1+ pos) to))
"\""))
(setcar composition nil)))
(setcar (cdr composition)
@@ -568,7 +550,7 @@ The character information includes:
("character"
,(format "%s (displayed as %s) (codepoint %d, #o%o, #x%x)"
char-description
- (apply 'propertize char-description
+ (apply #'propertize char-description
(text-properties-at pos))
char char char))
("charset"
@@ -620,7 +602,7 @@ The character information includes:
(if (consp key-list)
(list "type"
(concat "\""
- (mapconcat 'identity
+ (mapconcat #'identity
key-list "\" or \"")
"\"")
"with"
@@ -721,7 +703,7 @@ The character information includes:
(let ((unicodedata (describe-char-unicode-data char)))
(if unicodedata
(cons (list "Unicode data" "") unicodedata))))))
- (setq max-width (apply 'max (mapcar (lambda (x)
+ (setq max-width (apply #'max (mapcar (lambda (x)
(if (cadr x) (length (car x)) 0))
item-list)))
(set-buffer src-buf)
@@ -736,7 +718,7 @@ The character information includes:
(dolist (clm (cdr elt))
(cond ((eq (car-safe clm) 'insert-text-button)
(insert " ")
- (eval clm))
+ (eval clm t))
((not (zerop (length clm)))
(insert " " clm))))
(insert "\n"))))
@@ -855,7 +837,7 @@ The character information includes:
(insert "\n")
(dolist (elt
(cond ((eq describe-char-unidata-list t)
- (nreverse (mapcar 'car char-code-property-alist)))
+ (nreverse (mapcar #'car char-code-property-alist)))
((< char 32)
;; Temporary fix (2016-05-22): The
;; decomposition item for \n corrupts the
@@ -898,7 +880,7 @@ characters."
(setq width (- width (length (car last)) 1)))
(let ((ellipsis (and (cdr last) "...")))
(setcdr last nil)
- (concat (mapconcat 'identity words " ") ellipsis)))
+ (concat (mapconcat #'identity words " ") ellipsis)))
"")))
(defun describe-char-eldoc--format (ch &optional width)
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 62fdd916e69..753d3054d2f 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -77,12 +77,17 @@ files not writable by you are visited read-only."
(other :tag "non-writable only" if-file-read-only))
:group 'dired-x)
-(defcustom dired-omit-size-limit 100000
- "Maximum size for the \"omitting\" feature.
+(defcustom dired-omit-size-limit 300000
+ "Maximum buffer size for `dired-omit-mode'.
+
+Omitting will be disabled if the directory listing exceeds this size in
+bytes. This variable is ignored when `dired-omit-mode' is called
+interactively.
+
If nil, there is no maximum size."
:type '(choice (const :tag "no maximum" nil) integer)
:group 'dired-x
- :version "29.1")
+ :version "30.1")
(defcustom dired-omit-case-fold 'filesystem
"Determine whether \"omitting\" patterns are case-sensitive.
@@ -506,14 +511,23 @@ status message."
(re-search-forward dired-re-mark nil
t))))
count)))
+(defvar dired-omit--extension-regexp-cache
+ nil
+ "A cache of `regexp-opt' applied to `dired-omit-extensions'.
+
+This is a cons whose car is a list of strings and whose cdr is a
+regexp produced by `regexp-opt'.")
+
(defun dired-omit-regexp ()
+ (unless (equal dired-omit-extensions (car
dired-omit--extension-regexp-cache))
+ (setq dired-omit--extension-regexp-cache
+ (cons dired-omit-extensions (regexp-opt dired-omit-extensions))))
(concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
(if (and dired-omit-files dired-omit-extensions) "\\|" "")
(if dired-omit-extensions
(concat ".";; a non-extension part should exist
- "\\("
- (mapconcat 'regexp-quote dired-omit-extensions "\\|")
- "\\)$")
+ (cdr dired-omit--extension-regexp-cache)
+ "$")
"")))
;; Returns t if any work was done, nil otherwise.
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 22cb18359a3..1fc1ab45b84 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -453,7 +453,10 @@ on FRAME itself.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
-`down-mouse-1' (or similar) event."
+`down-mouse-1' (or similar) event.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging text from Emacs is not supported by this window system"))
(gui-set-selection 'XdndSelection text)
@@ -513,7 +516,10 @@ nil, any drops on FRAME itself will be ignored.
This function might return immediately if no mouse buttons are
currently being held down. It should only be called upon a
-`down-mouse-1' (or similar) event."
+`down-mouse-1' (or similar) event.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)
@@ -580,7 +586,10 @@ FRAME, ACTION and ALLOW-SAME-FRAME mean the same as in
FILES is a list of files that will be dragged. If the drop
target doesn't support dropping multiple files, the first file in
-FILES will be dragged."
+FILES will be dragged.
+
+This function is only supported on X Windows, macOS/GNUstep, and Haiku;
+on all other platforms it will signal an error."
(unless (fboundp 'x-begin-drag)
(error "Dragging files from Emacs is not supported by this window system"))
(dnd-remove-last-dragged-remote-file)
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 32a397f0d5e..ebb22526937 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2042,8 +2042,6 @@ in that CLASS."
function class name)))
(error "ad-remove-advice: `%s' is not advised" function)))
-(declare-function comp-subr-trampoline-install "comp-run")
-
;;;###autoload
(defun ad-add-advice (function advice class position)
"Add a piece of ADVICE to FUNCTION's list of advices in CLASS.
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 2bc47d79536..23b2b68d315 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -945,9 +945,13 @@ a bindat type expression."
(bindat-defmacro sint (bitlen le)
"Signed integer of size BITLEN.
Big-endian if LE is nil and little-endian if not."
+ (unless lexical-binding
+ (error "The `sint' type requires 'lexical-binding'"))
(let ((bl (make-symbol "bitlen"))
(max (make-symbol "max"))
(wrap (make-symbol "wrap")))
+ ;; FIXME: This `let*' around the `struct' results in code which the
+ ;; byte-compiler does not handle efficiently. 🙁
`(let* ((,bl ,bitlen)
(,max (ash 1 (1- ,bl)))
(,wrap (+ ,max ,max)))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 930e273a3be..1241690cb0b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -3118,7 +3118,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to
be of no importance."
;;
(eval-when-compile
(or (compiled-function-p (symbol-function 'byte-optimize-form))
- (assq 'byte-code (symbol-function 'byte-optimize-form))
(let ((byte-optimize nil)
(byte-compile-warnings nil))
(mapc (lambda (x)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 09e890839df..6fb4783d07c 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -5558,23 +5558,14 @@ invoked interactively."
(if (null f)
" <top level>";; shouldn't insert nil then, actually -sk
" <not defined>"))
- ((subrp (setq f (symbol-function f)))
- " <subr>")
- ((symbolp f)
+ ((symbolp (setq f (symbol-function f))) ;; An alias.
(format " ==> %s" f))
- ((byte-code-function-p f)
- "<compiled function>")
((not (consp f))
- "<malformed function>")
+ (format " <%s>" (type-of f)))
((eq 'macro (car f))
- (if (or (compiled-function-p (cdr f))
- ;; FIXME: Can this still happen?
- (assq 'byte-code (cdr (cdr (cdr f)))))
+ (if (compiled-function-p (cdr f))
" <compiled macro>"
" <macro>"))
- ((assq 'byte-code (cdr (cdr f)))
- ;; FIXME: Can this still happen?
- "<compiled lambda>")
((eq 'lambda (car f))
"<function>")
(t "???"))
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 02c11cae573..c22dfb2eb26 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2794,7 +2794,7 @@ function called to create the messages."
": " msg)))
(if (string= checkdoc-diagnostic-buffer "*warn*")
(warn (apply #'concat text))
- (with-current-buffer (get-buffer checkdoc-diagnostic-buffer)
+ (with-current-buffer checkdoc-diagnostic-buffer
(let ((inhibit-read-only t)
(pt (point-max)))
(goto-char pt)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index c8eaca9a77c..437dea2d6a9 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -711,13 +711,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(eval-when-compile (require 'cl-macs)) ;Explicitly, for cl--find-class.
(require 'help-mode)
-;; FIXME: We could go crazy and add another entry so describe-symbol can be
-;; used with the slot names of CL structs (and/or EIEIO objects).
-(add-to-list 'describe-symbol-backends
- `(nil ,#'cl-find-class ,#'cl-describe-type)
- ;; Document the `cons` function before the `cons` type.
- t)
-
(defconst cl--typedef-regexp
(concat "(" (regexp-opt '("defclass" "defstruct" "cl-defstruct"
"cl-deftype" "deftype"))
@@ -727,11 +720,6 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
(add-to-list 'find-function-regexp-alist
'(define-type . cl--typedef-regexp)))
-(define-button-type 'cl-help-type
- :supertype 'help-function-def
- 'help-function #'cl-describe-type
- 'help-echo (purecopy "mouse-2, RET: describe this type"))
-
(define-button-type 'cl-type-definition
:supertype 'help-function-def
'help-echo (purecopy "mouse-2, RET: find type definition"))
@@ -784,7 +772,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(insert (symbol-name type)
(substitute-command-keys " is a type (of kind `"))
(help-insert-xref-button (symbol-name metatype)
- 'cl-help-type metatype)
+ 'help-type metatype)
(insert (substitute-command-keys "')"))
(when location
(insert (substitute-command-keys " in `"))
@@ -803,7 +791,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(setq cur (cl--class-name cur))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
- 'cl-help-type cur)
+ 'help-type cur)
(insert (substitute-command-keys (if pl "', " "'"))))
(insert ".\n")))
@@ -815,7 +803,7 @@ Call `cl--find-class' to get TYPE's propname `cl--class'"
(while (setq cur (pop ch))
(insert (substitute-quotes "`"))
(help-insert-xref-button (symbol-name cur)
- 'cl-help-type cur)
+ 'help-type cur)
(insert (substitute-command-keys (if ch "', " "'"))))
(insert ".\n")))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 234ce9c1681..b53c6782544 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1367,6 +1367,11 @@ These match if the argument is `eql' to VAL."
;;; Dispatch on "normal types".
+(defconst cl--generic--unreachable-types
+ ;; FIXME: Try to make that list empty?
+ '(keyword)
+ "Built-in classes on which we cannot dispatch for technical reasons.")
+
(defun cl--generic-type-specializers (tag &rest _)
(and (symbolp tag)
(let ((class (cl--find-class tag)))
@@ -1374,8 +1379,7 @@ These match if the argument is `eql' to VAL."
(cl--class-allparents class)))))
(cl-generic-define-generalizer cl--generic-typeof-generalizer
- ;; FIXME: We could also change `type-of' to return `null' for nil.
- 10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
+ 10 (lambda (name &rest _) `(cl-type-of ,name))
#'cl--generic-type-specializers)
(cl-defmethod cl-generic-generalizers :extra "typeof" (type)
@@ -1387,6 +1391,8 @@ This currently works for built-in types and types built
on top of records."
(and (symbolp type)
(not (eq type t)) ;; Handled by the `t-generalizer'.
(let ((class (cl--find-class type)))
+ (when (memq type cl--generic--unreachable-types)
+ (error "Dispatch on %S is currently not supported" type))
(memq (type-of class)
'(built-in-class cl-structure-class eieio--class)))
(list cl--generic-typeof-generalizer))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 1a6d61b454e..4d173c23868 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2253,7 +2253,7 @@ Like `cl-flet' but the definitions can refer to previous
ones.
;;;###autoload
(defmacro cl-labels (bindings &rest body)
"Make local (recursive) function definitions.
-+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
+BINDINGS is a list of definitions of the form (FUNC ARGLIST BODY...) where
FUNC is the function name, ARGLIST its arguments, and BODY the
forms of the function body. FUNC is defined in any BODY, as well
as FORM, so you can write recursive and mutually recursive
@@ -3468,45 +3468,12 @@ Of course, we really can't know that for sure, so it's
just a heuristic."
;; Please keep it in sync with `comp-known-predicates'.
(pcase-dolist (`(,type . ,pred)
;; Mostly kept in alphabetical order.
- '((array . arrayp)
- (atom . atom)
- (base-char . characterp)
- (bignum . bignump)
- (boolean . booleanp)
- (bool-vector . bool-vector-p)
- (buffer . bufferp)
- (byte-code-function . byte-code-function-p)
- (character . natnump)
- (char-table . char-table-p)
- (command . commandp)
- (compiled-function . compiled-function-p)
- (hash-table . hash-table-p)
- (cons . consp)
- (fixnum . fixnump)
- (float . floatp)
- (frame . framep)
- (function . functionp)
- (integer . integerp)
- (keyword . keywordp)
- (list . listp)
- (marker . markerp)
- (natnum . natnump)
- (number . numberp)
- (null . null)
- (obarray . obarrayp)
- (overlay . overlayp)
- (process . processp)
- (real . numberp)
- (sequence . sequencep)
- (subr . subrp)
- (string . stringp)
- (symbol . symbolp)
- (symbol-with-pos . symbol-with-pos-p)
- (vector . vectorp)
- (window . windowp)
- ;; FIXME: Do we really want to consider these types?
- (number-or-marker . number-or-marker-p)
- (integer-or-marker . integer-or-marker-p)
+ ;; These aren't defined via `cl--define-built-in-type'.
+ '((base-char . characterp) ;Could be subtype of `fixnum'.
+ (character . natnump) ;Could be subtype of `fixnum'.
+ (command . commandp) ;Subtype of closure & subr.
+ (natnum . natnump) ;Subtype of fixnum & bignum.
+ (real . numberp) ;Not clear where it would fit.
))
(put type 'cl-deftype-satisfies pred))
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index 5743684fa89..35a8d79a1cd 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -260,7 +260,7 @@
(cl-defstruct (cl--class
(:constructor nil)
(:copier nil))
- "Type of descriptors for any kind of structure-like data."
+ "Abstract supertype of all type descriptors."
;; Intended to be shared between defstruct and defclass.
(name nil :type symbol) ;The type name.
(docstring nil :type string)
@@ -306,9 +306,11 @@
(:constructor nil)
(:constructor built-in-class--make (name docstring parents))
(:copier nil))
+ "Type descriptors for built-in types.
+The `slots' (and hence `index-table') are currently unused."
)
-(defmacro cl--define-built-in-type (name parents &optional docstring &rest
_slots)
+(defmacro cl--define-built-in-type (name parents &optional docstring &rest
slots)
;; `slots' is currently unused, but we could make it take
;; a list of "slot like properties" together with the corresponding
;; accessor, and then we could maybe even make `slot-value' work
@@ -317,32 +319,49 @@
(unless (listp parents) (setq parents (list parents)))
(unless (or parents (eq name t))
(error "Missing parents for %S: %S" name parents))
- `(progn
- (put ',name 'cl--class
- (built-in-class--make ',name ,docstring
- (mapcar (lambda (type)
- (let ((class (get type 'cl--class)))
- (unless class
- (error "Unknown type: %S" type))
- class))
- ',parents)))))
+ (let ((predicate (intern-soft (format
+ (if (string-match "-" (symbol-name name))
+ "%s-p" "%sp")
+ name))))
+ (unless (fboundp predicate) (setq predicate nil))
+ (while (keywordp (car slots))
+ (let ((kw (pop slots)) (val (pop slots)))
+ (pcase kw
+ (:predicate (setq predicate val))
+ (_ (error "Unknown keyword arg: %S" kw)))))
+ `(progn
+ ,(if predicate `(put ',name 'cl-deftype-satisfies #',predicate)
+ ;; (message "Missing predicate for: %S" name)
+ nil)
+ (put ',name 'cl--class
+ (built-in-class--make ',name ,docstring
+ (mapcar (lambda (type)
+ (let ((class (get type
'cl--class)))
+ (unless class
+ (error "Unknown type: %S"
type))
+ class))
+ ',parents))))))
;; FIXME: Our type DAG has various quirks:
-;; - `subr' says it's a `compiled-function' but that's not true
-;; for those subrs that are special forms!
;; - Some `keyword's are also `symbol-with-pos' but that's not reflected
;; in the DAG.
;; - An OClosure can be an interpreted function or a `byte-code-function',
;; so the DAG of OClosure types is "orthogonal" to the distinction
;; between interpreted and compiled functions.
-(cl--define-built-in-type t nil "The type of everything.")
-(cl--define-built-in-type atom t "The type of anything but cons cells.")
+(cl--define-built-in-type t nil "Abstract supertype of everything.")
+(cl--define-built-in-type atom t "Abstract supertype of anything but cons
cells."
+ :predicate atom)
(cl--define-built-in-type tree-sitter-compiled-query atom)
(cl--define-built-in-type tree-sitter-node atom)
(cl--define-built-in-type tree-sitter-parser atom)
-(cl--define-built-in-type user-ptr atom)
+(declare-function user-ptrp "data.c")
+(when (fboundp 'user-ptrp)
+ (cl--define-built-in-type user-ptr atom nil
+ ;; FIXME: Shouldn't it be called
+ ;; `user-ptr-p'?
+ :predicate user-ptrp))
(cl--define-built-in-type font-object atom)
(cl--define-built-in-type font-entity atom)
(cl--define-built-in-type font-spec atom)
@@ -355,10 +374,11 @@
(cl--define-built-in-type buffer atom)
(cl--define-built-in-type window atom)
(cl--define-built-in-type process atom)
+(cl--define-built-in-type finalizer atom)
(cl--define-built-in-type window-configuration atom)
(cl--define-built-in-type overlay atom)
(cl--define-built-in-type number-or-marker atom
- "Abstract super type of both `number's and `marker's.")
+ "Abstract supertype of both `number's and `marker's.")
(cl--define-built-in-type symbol atom
"Type of symbols."
;; Example of slots we could document. It would be desirable to
@@ -373,14 +393,14 @@
(cl--define-built-in-type obarray atom)
(cl--define-built-in-type native-comp-unit atom)
-(cl--define-built-in-type sequence t "Abstract super type of sequences.")
+(cl--define-built-in-type sequence t "Abstract supertype of sequences.")
(cl--define-built-in-type list sequence)
-(cl--define-built-in-type array (sequence atom) "Abstract super type of
arrays.")
+(cl--define-built-in-type array (sequence atom) "Abstract supertype of
arrays.")
(cl--define-built-in-type number (number-or-marker)
- "Abstract super type of numbers.")
+ "Abstract supertype of numbers.")
(cl--define-built-in-type float (number))
(cl--define-built-in-type integer-or-marker (number-or-marker)
- "Abstract super type of both `integer's and `marker's.")
+ "Abstract supertype of both `integer's and `marker's.")
(cl--define-built-in-type integer (number integer-or-marker))
(cl--define-built-in-type marker (integer-or-marker))
(cl--define-built-in-type bignum (integer)
@@ -404,26 +424,29 @@ For this build of Emacs it's %dbit."
"Type of special arrays that are indexed by characters.")
(cl--define-built-in-type string (array))
(cl--define-built-in-type null (boolean list) ;FIXME: `atom' comes before
`list'?
- "Type of the nil value.")
+ "Type of the nil value."
+ :predicate null)
(cl--define-built-in-type cons (list)
"Type of cons cells."
;; Example of slots we could document.
(car car) (cdr cdr))
(cl--define-built-in-type function (atom)
- "Abstract super type of function values.")
+ "Abstract supertype of function values.")
(cl--define-built-in-type compiled-function (function)
"Abstract type of functions that have been compiled.")
(cl--define-built-in-type byte-code-function (compiled-function)
"Type of functions that have been byte-compiled.")
-(cl--define-built-in-type subr (compiled-function)
+(cl--define-built-in-type subr (atom)
"Abstract type of functions compiled to machine code.")
(cl--define-built-in-type module-function (function)
"Type of functions provided via the module API.")
(cl--define-built-in-type interpreted-function (function)
"Type of functions that have not been compiled.")
-(cl--define-built-in-type subr-native-elisp (subr)
- "Type of function that have been compiled by the native compiler.")
-(cl--define-built-in-type subr-primitive (subr)
+(cl--define-built-in-type special-form (subr)
+ "Type of the core syntactic elements of the Emacs Lisp language.")
+(cl--define-built-in-type subr-native-elisp (subr compiled-function)
+ "Type of functions that have been compiled by the native compiler.")
+(cl--define-built-in-type primitive-function (subr compiled-function)
"Type of functions hand written in C.")
(unless (cl--class-parents (cl--find-class 'cl-structure-object))
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 4d40c3e0778..bb3ed2c89c1 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -461,7 +461,7 @@ primitives such as `prin1'.")
(defun cl-print--preprocess (object)
(let ((print-number-table (make-hash-table :test 'eq :rehash-size 2.0)))
- (if (fboundp 'print--preprocess)
+ (if (fboundp 'print--preprocess) ;Emacs≥26
;; Use the predefined C version if available.
(print--preprocess object) ;Fill print-number-table!
(let ((cl-print--number-index 0))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 5922a8caf12..cbfb9540f03 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -288,13 +288,10 @@ Return them as multiple value."
(apply #'append
(mapcar #'comp--direct-supertypes typeset)))
for subs = (comp--direct-subtypes sup)
- when (and (length> subs 1) ;;FIXME: Why?
- ;; Every subtype of `sup` is a subtype of
- ;; some element of `typeset`?
- ;; It's tempting to just check (member x typeset),
- ;; but think of the typeset (marker number),
- ;; where `sup' is `integer-or-marker' and `sub'
- ;; is `integer'.
+ when (and (length> subs 1) ;; If there's only one sub do
+ ;; nothing as we want to
+ ;; return the most specific
+ ;; type.
(cl-every (lambda (sub)
(cl-some (lambda (type)
(comp-subtype-p sub type))
@@ -575,7 +572,7 @@ All SRCS constraints must be homogeneously negated or
non-negated."
;; We propagate only values those types are not already
;; into typeset.
when (cl-notany (lambda (x)
- (comp-subtype-p (type-of v) x))
+ (comp-subtype-p (cl-type-of v) x))
(comp-cstr-typeset dst))
collect v)))
@@ -664,7 +661,7 @@ DST is returned."
;; Verify disjoint condition between positive types and
;; negative types coming from values, in case give-up.
- (let ((neg-value-types (nconc (mapcar #'type-of (valset neg))
+ (let ((neg-value-types (nconc (mapcar #'cl-type-of (valset neg))
(when (range neg)
'(integer)))))
(when (cl-some (lambda (x)
@@ -685,7 +682,7 @@ DST is returned."
((cl-some (lambda (x)
(cl-some (lambda (y)
(comp-subtype-p y x))
- (mapcar #'type-of (valset pos))))
+ (mapcar #'cl-type-of (valset pos))))
(typeset neg))
(give-up))
(t
@@ -1108,7 +1105,7 @@ DST is returned."
(cl-loop for v in (valset dst)
unless (symbolp v)
do (push v strip-values)
- (push (type-of v) strip-types))
+ (push (cl-type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))
diff --git a/lisp/emacs-lisp/comp-run.el b/lisp/emacs-lisp/comp-run.el
index 057760322ab..5cc61579030 100644
--- a/lisp/emacs-lisp/comp-run.el
+++ b/lisp/emacs-lisp/comp-run.el
@@ -233,8 +233,8 @@ display a message."
"`comp-files-queue' should be \".el\" files: %s"
source-file)
when (or native-comp-always-compile
- load ; Always compile when the compilation is
- ; commanded for late load.
+ load ; Always compile when the compilation is
+ ; commanded for late load.
;; Skip compilation if `comp-el-to-eln-filename' fails
;; to find a writable directory.
(with-demoted-errors "Async compilation :%S"
@@ -256,6 +256,7 @@ display a message."
load-path
backtrace-line-length
byte-compile-warnings
+ comp-sanitizer-emit
;; package-load-list
;; package-user-dir
;; package-directory-list
@@ -364,13 +365,15 @@ Return the trampoline if found or nil otherwise."
(when (memq subr-name comp-warn-primitives)
(warn "Redefining `%s' might break native compilation of trampolines."
subr-name))
- (unless (or (null native-comp-enable-subr-trampolines)
- (memq subr-name native-comp-never-optimize-functions)
- (gethash subr-name comp-installed-trampolines-h))
- (cl-assert (subr-primitive-p (symbol-function subr-name)))
- (when-let ((trampoline (or (comp-trampoline-search subr-name)
- (comp-trampoline-compile subr-name))))
- (comp--install-trampoline subr-name trampoline))))
+ (let ((subr (symbol-function subr-name)))
+ (unless (or (not (string= subr-name (subr-name subr))) ;; (bug#69573)
+ (null native-comp-enable-subr-trampolines)
+ (memq subr-name native-comp-never-optimize-functions)
+ (gethash subr-name comp-installed-trampolines-h))
+ (cl-assert (subr-primitive-p subr))
+ (when-let ((trampoline (or (comp-trampoline-search subr-name)
+ (comp-trampoline-compile subr-name))))
+ (comp--install-trampoline subr-name trampoline)))))
;;;###autoload
(defun native--compile-async (files &optional recursively load selector)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 7f31c739ee9..ab0ab2bbbb7 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -165,6 +165,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'.
See `comp-ctxt'.")
comp--tco
comp--fwprop
comp--remove-type-hints
+ comp--sanitizer
comp--compute-function-types
comp--final)
"Passes to be executed in order.")
@@ -202,7 +203,7 @@ Useful to hook into pass checkers.")
(consp . cons)
(floatp . float)
(framep . frame)
- (functionp . (or function symbol))
+ (functionp . (or function symbol cons))
(hash-table-p . hash-table)
(integer-or-marker-p . integer-or-marker)
(integerp . integer)
@@ -244,6 +245,7 @@ Useful to hook into pass checkers.")
(defun comp--pred-to-cstr (predicate)
"Given PREDICATE, return the corresponding constraint."
+ ;; FIXME: Unify those two hash tables?
(or (gethash predicate comp-known-predicates-h)
(gethash predicate (comp-cstr-ctxt-pred-type-h comp-ctxt))))
@@ -1786,7 +1788,9 @@ into the C code forwarding the compilation unit."
for insn in (comp-block-insns b)
for (op . args) = insn
if (comp--assign-op-p op)
- do (comp--collect-mvars (cdr args))
+ do (comp--collect-mvars (if (eq op 'setimm)
+ (cl-first args)
+ (cdr args)))
else
do (comp--collect-mvars args))))
@@ -2440,6 +2444,8 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or
post-order if non-nil."
(setf (comp-vec-aref frame slot-n) mvar
(cadr insn) mvar))))
(pcase insn
+ (`(setimm ,(pred targetp) ,_imm)
+ (new-lvalue))
(`(,(pred comp--assign-op-p) ,(pred targetp) . ,_)
(let ((mvar (comp-vec-aref frame slot-n)))
(setf (cddr insn) (cl-nsubst-if mvar #'targetp (cddr insn))))
@@ -2543,7 +2549,7 @@ Return t when one or more block was removed, nil
otherwise."
;; native compiling all Emacs code-base.
"Max number of scanned insn before giving-up.")
-(defun comp--copy-insn (insn)
+(defun comp--copy-insn-rec (insn)
"Deep copy INSN."
;; Adapted from `copy-tree'.
(if (consp insn)
@@ -2560,6 +2566,13 @@ Return t when one or more block was removed, nil
otherwise."
(copy-comp-mvar insn)
insn)))
+(defun comp--copy-insn (insn)
+ "Deep copy INSN."
+ (pcase insn
+ (`(setimm ,mvar ,imm)
+ `(setimm ,(copy-comp-mvar mvar) ,imm))
+ (_ (comp--copy-insn-rec insn))))
+
(defmacro comp--apply-in-env (func &rest args)
"Apply FUNC to ARGS in the current compilation environment."
`(let ((env (cl-loop
@@ -2901,7 +2914,8 @@ Return the list of m-var ids nuked."
for (op arg0 . rest) = insn
if (comp--assign-op-p op)
do (push (comp-mvar-id arg0) l-vals)
- (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals))
+ (unless (eq op 'setimm)
+ (setf r-vals (nconc (comp--collect-mvar-ids rest) r-vals)))
else
do (setf r-vals (nconc (comp--collect-mvar-ids insn) r-vals))))
;; Every l-value appearing that does not appear as r-value has no right to
@@ -3006,6 +3020,65 @@ These are substituted with a normal `set' op."
(comp-ctxt-funcs-h comp-ctxt)))
+;;; Sanitizer pass specific code.
+
+;; This pass aims to verify compile-time value-type predictions during
+;; execution of the code.
+;; The sanitizer pass injects a call to 'helper_sanitizer_assert' before
+;; each conditional branch. 'helper_sanitizer_assert' will verify that
+;; the variable tested by the conditional branch is of the predicted
+;; value type, or signal an error otherwise.
+
+;;; Example:
+
+;; Assume we want to compile 'test.el' and test the function `foo'
+;; defined in it. Then:
+
+;; - Native-compile 'test.el' instrumenting it for sanitizer usage:
+;; (let ((comp-sanitizer-emit t))
+;; (load (native-compile "test.el")))
+
+;; - Run `foo' with the sanitizer active:
+;; (let ((comp-sanitizer-active t))
+;; (foo))
+
+(defvar comp-sanitizer-emit nil
+ "Gates the sanitizer pass.
+This is intended to be used only for development and verification of
+the native compiler.")
+
+(defun comp--sanitizer (_)
+ (when comp-sanitizer-emit
+ (cl-loop
+ for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
+ for comp-func = f
+ unless (comp-func-has-non-local comp-func)
+ do
+ (cl-loop
+ for b being each hash-value of (comp-func-blocks f)
+ do
+ (cl-loop
+ named in-the-basic-block
+ for insns-seq on (comp-block-insns b)
+ do (pcase insns-seq
+ (`((cond-jump ,(and (pred comp-mvar-p) mvar-tested)
+ ,(pred comp-mvar-p) ,_bb1 ,_bb2))
+ (let ((type (comp-cstr-to-type-spec mvar-tested))
+ (insn (car insns-seq)))
+ ;; No need to check if type is t.
+ (unless (eq type t)
+ (comp--add-const-to-relocs type)
+ (setcar
+ insns-seq
+ (comp--call 'helper_sanitizer_assert
+ mvar-tested
+ (make--comp-mvar :constant type)))
+ (setcdr insns-seq (list insn)))
+ ;; (setf (comp-func-ssa-status comp-func) 'dirty)
+ (cl-return-from in-the-basic-block))))))
+ do (comp--log-func comp-func 3))))
+
+
;;; Function types pass specific code.
(defun comp--compute-function-type (_ func)
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 7863df8b6e8..bd458b5aa23 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -153,6 +153,12 @@ where CAUSE can be:
(insert (debugger--buffer-state-content state)))
(goto-char (debugger--buffer-state-pos state)))
+(defvar debugger--last-error nil)
+
+(defun debugger--duplicate-p (args)
+ (pcase args
+ (`(error ,err . ,_) (and (consp err) (eq err debugger--last-error)))))
+
;;;###autoload
(if (null noninteractive)
(setq debugger 'debug))
@@ -177,9 +183,14 @@ first will be printed into the backtrace buffer.
If `inhibit-redisplay' is non-nil when this function is called,
the debugger will not be entered."
(interactive)
- (if inhibit-redisplay
- ;; Don't really try to enter debugger within an eval from redisplay.
+ (if (or inhibit-redisplay
+ (debugger--duplicate-p args))
+ ;; Don't really try to enter debugger within an eval from redisplay
+ ;; or if we already popper into the debugger for this error,
+ ;; which can happen when we have several nested `handler-bind's that
+ ;; want to invoke the debugger.
debugger-value
+ (setq debugger--last-error nil)
(let ((non-interactive-frame
(or noninteractive ;FIXME: Presumably redundant.
;; If we're in the initial-frame (where `message' just
@@ -202,7 +213,7 @@ the debugger will not be entered."
(let (debugger-value
(debugger-previous-state
(if (get-buffer "*Backtrace*")
- (with-current-buffer (get-buffer "*Backtrace*")
+ (with-current-buffer "*Backtrace*"
(debugger--save-buffer-state))))
(debugger-args args)
(debugger-buffer (get-buffer-create "*Backtrace*"))
@@ -320,6 +331,12 @@ the debugger will not be entered."
(backtrace-mode))))
(with-timeout-unsuspend debugger-with-timeout-suspend)
(set-match-data debugger-outer-match-data)))
+ (when (eq 'error (car-safe debugger-args))
+ ;; Remember the error we just debugged, to avoid re-entering
+ ;; the debugger if some higher-up `handler-bind' invokes us
+ ;; again, oblivious that the error was already debugged from
+ ;; a more deeply nested `handler-bind'.
+ (setq debugger--last-error (nth 1 debugger-args)))
(setq debug-on-next-call debugger-step-after-exit)
debugger-value))))
@@ -653,7 +670,7 @@ Complete list of commands:
(princ (debugger-eval-expression exp))
(terpri))
- (with-current-buffer (get-buffer debugger-record-buffer)
+ (with-current-buffer debugger-record-buffer
(message "%s"
(buffer-substring (line-beginning-position 0)
(line-end-position 0)))))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index f2c8af0456c..701a5894a97 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -193,11 +193,15 @@ Use this with caution since it is not debugged."
(defcustom edebug-print-length 50
- "If non-nil, default value of `print-length' for printing results in Edebug."
- :type '(choice integer (const nil)))
+ "Maximum length of list to print before abbreviating, when in Edebug.
+If this is nil, use the value of `print-length' instead."
+ :type '(choice (integer :tag "A number")
+ (const :tag "Use `print-length'" nil)))
(defcustom edebug-print-level 50
- "If non-nil, default value of `print-level' for printing results in Edebug."
- :type '(choice integer (const nil)))
+ "Maximum depth of list nesting to print before abbreviating, when in Edebug.
+If nil, use the value of `print-level' instead."
+ :type '(choice (integer :tag "A number")
+ (const :tag "Use `print-level'" nil)))
(defcustom edebug-print-circle t
"If non-nil, default value of `print-circle' for printing results in Edebug."
:type 'boolean)
@@ -1230,10 +1234,12 @@ purpose by adding an entry to this alist, and setting
;; But the list will just be reversed.
,@(nreverse edebug-def-args))
'nil)
- ;; Make sure `forms' is not nil so we don't accidentally return
- ;; the magic keyword. Mark the closure so we don't throw away
- ;; unused vars (bug#59213).
- #'(lambda () :closure-dont-trim-context ,@(or forms '(nil)))))
+ #'(lambda ()
+ ;; Mark the closure so we don't throw away unused vars (bug#59213).
+ :closure-dont-trim-context
+ ;; Make sure `forms' is not nil so we don't accidentally return
+ ;; the magic keyword.
+ ,@(or forms '(nil)))))
(defvar edebug-form-begin-marker) ; the mark for def being instrumented
@@ -1271,55 +1277,48 @@ Does not unwrap inside vectors, records, structures, or
hash tables."
(pcase sexp
(`(edebug-after ,_before-form ,_after-index ,form)
form)
- (`(lambda ,args (edebug-enter ',_sym ,_arglist
- (function (lambda nil . ,body))))
- `(lambda ,args ,@body))
- (`(closure ,env ,args (edebug-enter ',_sym ,_arglist
- (function (lambda nil . ,body))))
- `(closure ,env ,args ,@body))
- (`(edebug-enter ',_sym ,_args (function (lambda nil . ,body)))
+ (`(edebug-enter ',_sym ,_args
+ #'(lambda nil :closure-dont-trim-context . ,body))
(macroexp-progn body))
(_ sexp)))
+(defconst edebug--unwrap-cache
+ (make-hash-table :test 'eq :weakness 'key)
+ "Hash-table containing the results of unwrapping cons cells.
+These results are reused to avoid redundant work but also to avoid
+infinite loops when the code/environment contains a circular object.")
+
(defun edebug-unwrap* (sexp)
"Return the SEXP recursively unwrapped."
- (let ((ht (make-hash-table :test 'eq)))
- (edebug--unwrap1 sexp ht)))
-
-(defun edebug--unwrap1 (sexp hash-table)
- "Unwrap SEXP using HASH-TABLE of things already unwrapped.
-HASH-TABLE contains the results of unwrapping cons cells within
-SEXP, which are reused to avoid infinite loops when SEXP is or
-contains a circular object."
- (let ((new-sexp (edebug-unwrap sexp)))
- (while (not (eq sexp new-sexp))
- (setq sexp new-sexp
- new-sexp (edebug-unwrap sexp)))
- (if (consp new-sexp)
- (let ((result (gethash new-sexp hash-table nil)))
- (unless result
- (let ((remainder new-sexp)
- current)
- (setq result (cons nil nil)
- current result)
- (while
- (progn
- (puthash remainder current hash-table)
- (setf (car current)
- (edebug--unwrap1 (car remainder) hash-table))
- (setq remainder (cdr remainder))
- (cond
- ((atom remainder)
- (setf (cdr current)
- (edebug--unwrap1 remainder hash-table))
- nil)
- ((gethash remainder hash-table nil)
- (setf (cdr current) (gethash remainder hash-table nil))
- nil)
- (t (setq current
- (setf (cdr current) (cons nil nil)))))))))
- result)
- new-sexp)))
+ (while (not (eq sexp (setq sexp (edebug-unwrap sexp)))))
+ (cond
+ ((consp sexp)
+ (or (gethash sexp edebug--unwrap-cache nil)
+ (let ((remainder sexp)
+ (current (cons nil nil)))
+ (prog1 current
+ (while
+ (progn
+ (puthash remainder current edebug--unwrap-cache)
+ (setf (car current)
+ (edebug-unwrap* (car remainder)))
+ (setq remainder (cdr remainder))
+ (cond
+ ((atom remainder)
+ (setf (cdr current)
+ (edebug-unwrap* remainder))
+ nil)
+ ((gethash remainder edebug--unwrap-cache nil)
+ (setf (cdr current) (gethash remainder edebug--unwrap-cache
nil))
+ nil)
+ (t (setq current
+ (setf (cdr current) (cons nil nil)))))))))))
+ ((byte-code-function-p sexp)
+ (apply #'make-byte-code
+ (aref sexp 0) (aref sexp 1)
+ (vconcat (mapcar #'edebug-unwrap* (aref sexp 2)))
+ (nthcdr 3 (append sexp ()))))
+ (t sexp)))
(defun edebug-defining-form (cursor form-begin form-end speclist)
@@ -4240,13 +4239,13 @@ Remove frames for Edebug's functions and the lambdas in
and after-index fields in both FRAMES and the returned list
of deinstrumented frames, for those frames where the source
code location is known."
- (let (skip-next-lambda def-name before-index after-index results
- (index (length frames)))
+ (let ((index (length frames))
+ skip-next-lambda def-name before-index after-index results)
(dolist (frame (reverse frames))
(let ((new-frame (copy-edebug--frame frame))
(fun (edebug--frame-fun frame))
(args (edebug--frame-args frame)))
- (cl-decf index)
+ (cl-decf index) ;; FIXME: Not used?
(pcase fun
('edebug-enter
(setq skip-next-lambda t
@@ -4256,38 +4255,46 @@ code location is known."
(nth 1 (nth 0 args))
(nth 0 args))
after-index (nth 1 args)))
- ((pred edebug--symbol-not-prefixed-p)
- (edebug--unwrap-frame new-frame)
- (edebug--add-source-info new-frame def-name before-index
after-index)
- (edebug--add-source-info frame def-name before-index after-index)
- (push new-frame results)
- (setq before-index nil
- after-index nil))
- (`(,(or 'lambda 'closure) . ,_)
+ ;; Just skip all our own frames.
+ ((pred edebug--symbol-prefixed-p) nil)
+ (_
+ (when (and skip-next-lambda
+ (not (memq (car-safe fun) '(closure lambda))))
+ (warn "Edebug--strip-instrumentation expected an interpreted
function:\n%S" fun))
(unless skip-next-lambda
(edebug--unwrap-frame new-frame)
- (edebug--add-source-info frame def-name before-index after-index)
(edebug--add-source-info new-frame def-name before-index
after-index)
+ (edebug--add-source-info frame def-name before-index after-index)
(push new-frame results))
- (setq before-index nil
+ (setq before-index nil
after-index nil
skip-next-lambda nil)))))
results))
-(defun edebug--symbol-not-prefixed-p (sym)
- "Return non-nil if SYM is a symbol not prefixed by \"edebug-\"."
+(defun edebug--symbol-prefixed-p (sym)
+ "Return non-nil if SYM is a symbol prefixed by \"edebug-\"."
(and (symbolp sym)
- (not (string-prefix-p "edebug-" (symbol-name sym)))))
+ (string-prefix-p "edebug-" (symbol-name sym))))
(defun edebug--unwrap-frame (frame)
"Remove Edebug's instrumentation from FRAME.
Strip it from the function and any unevaluated arguments."
- (setf (edebug--frame-fun frame) (edebug-unwrap* (edebug--frame-fun frame)))
- (unless (edebug--frame-evald frame)
- (let (results)
- (dolist (arg (edebug--frame-args frame))
- (push (edebug-unwrap* arg) results))
- (setf (edebug--frame-args frame) (nreverse results)))))
+ (cl-callf edebug-unwrap* (edebug--frame-fun frame))
+ ;; We used to try to be careful to apply `edebug-unwrap' only to source
+ ;; expressions and not to values, so we did not apply unwrap to the arguments
+ ;; of the frame if they had already been evaluated.
+ ;; But this was not careful enough since `edebug-unwrap*' gleefully traverses
+ ;; its argument without paying attention to its syntactic structure so it
+ ;; also "mistakenly" descends into the values contained within the "source
+ ;; code". In practice this *very* rarely leads to undesired results.
+ ;; On the contrary, it's often useful to descend into values because they
+ ;; may contain interpreted closures and hence source code where we *do*
+ ;; want to apply `edebug-unwrap'.
+ ;; So based on this experience, we now also apply `edebug-unwrap*' to
+ ;; the already evaluated arguments.
+ ;;(unless (edebug--frame-evald frame)
+ (cl-callf (lambda (xs) (mapcar #'edebug-unwrap* xs))
+ (edebug--frame-args frame)))
(defun edebug--add-source-info (frame def-name before-index after-index)
"Update FRAME with the additional info needed by an edebug--frame.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index a2f7c4172a3..cf8bd749f2a 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -1046,7 +1046,7 @@ method invocation orders of the involved classes."
(defun cl--generic-struct-tag (name &rest _)
;; Use exactly the same code as for `typeof'.
- `(if ,name (type-of ,name) 'null))
+ `(cl-type-of ,name))
(cl-generic-define-generalizer eieio--generic-generalizer
;; Use the exact same tagcode as for cl-struct, so that methods
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index 893f8cd7e7f..bf6be1690e4 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -50,7 +50,7 @@ variable `eieio-default-superclass'."
(if (not root-class) (setq root-class 'eieio-default-superclass))
(cl-check-type root-class class)
(display-buffer (get-buffer-create "*EIEIO OBJECT BROWSE*") t)
- (with-current-buffer (get-buffer "*EIEIO OBJECT BROWSE*")
+ (with-current-buffer "*EIEIO OBJECT BROWSE*"
(erase-buffer)
(goto-char 0)
(eieio-browse-tree root-class "" "")
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 0a20fd96201..591a8750d3c 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -189,7 +189,7 @@ DOC is a string where \"FUNCTION\" and \"OLDFUN\" are
expected.")
if
(cl-assert (eq 'interactive (car if)))
(let ((form (cadr if)))
- (if (macroexp-const-p form)
+ (if (macroexp-const-p form) ;Common case: a string.
if
;; The interactive is expected to be run in the static context
;; that the function captured.
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index 977d5735171..4da8e61aaa7 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -437,7 +437,7 @@ This has 2 uses:
- For compiled code, this is used as a marker which cconv uses to check that
immutable fields are indeed not mutated."
(if (byte-code-function-p oclosure)
- ;; Actually, this should never happen since the `cconv.el' should have
+ ;; Actually, this should never happen since `cconv.el' should have
;; optimized away the call to this function.
oclosure
;; For byte-coded functions, we store the type as a symbol in the docstring
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index fe7b10f569a..ab1731aeb54 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -2941,7 +2941,7 @@ Helper function for `describe-package'."
(insert " "))
(insert "\n"))
(when maintainers
- (unless (proper-list-p maintainers)
+ (when (stringp (car maintainers))
(setq maintainers (list maintainers)))
(package--print-help-section
(if (cdr maintainers) "Maintainers" "Maintainer"))
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 569f70ca604..26c77d6b047 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -193,11 +193,18 @@ it inserts and pretty-prints that arg at point."
(and
(save-excursion
(goto-char beg)
- (if (save-excursion (skip-chars-backward " \t({[',")
- (bolp))
- ;; The sexp was already on its own line.
- nil
- (skip-chars-backward " \t")
+ ;; We skip backward over open parens because cutting
+ ;; the line right after an open paren does not help
+ ;; reduce the indentation depth.
+ ;; Similarly, we prefer to cut before a "." than after
+ ;; it because it reduces the indentation depth.
+ (while (not (zerop (skip-chars-backward " \t({[',.")))
+ (and (memq (char-before) '(?# ?s ?f))
+ (looking-back "#[sf]?" (- (point) 2))
+ (goto-char (match-beginning 0))))
+ (if (bolp)
+ ;; The sexp already starts on its own line.
+ (progn (goto-char beg) nil)
(setq beg (copy-marker beg t))
(if paired (setq paired (copy-marker paired t)))
;; We could try to undo this insertion if it
@@ -346,6 +353,23 @@ after OUT-BUFFER-NAME."
(setq buffer-read-only nil)
(setq-local font-lock-verbose nil)))))
+(defun pp-insert-short-sexp (sexp &optional width)
+ "Insert a short description of SEXP in the current buffer.
+WIDTH is the maximum width to use for it and it defaults to the
+space available between point and the window margin."
+ (let ((printed (format "%S" sexp)))
+ (if (and (not (string-search "\n" printed))
+ (<= (string-width printed)
+ (or width (- (window-width) (current-column)))))
+ (insert printed)
+ (insert-text-button
+ "[Show]"
+ 'follow-link t
+ 'action (lambda (&rest _ignore)
+ ;; FIXME: Why "eval output"?
+ (pp-display-expression sexp "*Pp Eval Output*"))
+ 'help-echo "mouse-2, RET: pretty print value in another buffer"))))
+
;;;###autoload
(defun pp-eval-expression (expression)
"Evaluate EXPRESSION and pretty-print its value.
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 0a47cca0231..c5307f70d08 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -825,7 +825,7 @@ If SUBEXP is non-nil mark only the corresponding
sub-expressions."
(defun reb-restart-font-lock ()
"Restart `font-lock-mode' to fit current regexp format."
- (with-current-buffer (get-buffer reb-buffer)
+ (with-current-buffer reb-buffer
(let ((font-lock-is-on font-lock-mode))
(font-lock-mode -1)
(kill-local-variable 'font-lock-set-defaults)
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 20077db9e60..a20cff16982 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -362,8 +362,7 @@ the result.
The result is a sequence of the same type as SEQUENCE."
(seq-concatenate
- (let ((type (type-of sequence)))
- (if (eq type 'cons) 'list type))
+ (if (listp sequence) 'list (type-of sequence))
(seq-subseq sequence 0 n)
(seq-subseq sequence (1+ n))))
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index cbb5618ffce..a1e49b50510 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -1781,7 +1781,7 @@ With prefix numeric argument ARG, do it that many times."
(interactive)
(save-excursion
(goto-char (pos-bol))
- (when-let* ((re (rx bol "(" (group (+ (not (in " "))))))
+ (when-let* ((re (rx bol "(" (group (+ (not (in " )"))))))
(string
(and (or (looking-at re)
(re-search-backward re nil t))
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 02020552e7f..d8e5136c666 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -283,8 +283,16 @@ If it can't be found, return nil and don't move point."
(goto-char (prop-match-beginning match))
(end-of-line)))
-(defun vtable-update-object (table object old-object)
- "Replace OLD-OBJECT in TABLE with OBJECT."
+(defun vtable-update-object (table object &optional old-object)
+ "Update OBJECT's representation in TABLE.
+If OLD-OBJECT is non-nil, replace OLD-OBJECT with OBJECT and display it.
+In either case, if the existing object is not found in the table (being
+compared with `equal'), signal an error. Note a limitation: if TABLE's
+buffer is not in a visible window, or if its window has changed width
+since it was updated, updating the TABLE is not possible, and an error
+is signaled."
+ (unless old-object
+ (setq old-object object))
(let* ((objects (vtable-objects table))
(inhibit-read-only t))
;; First replace the object in the object storage.
@@ -300,26 +308,31 @@ If it can't be found, return nil and don't move point."
(error "Can't find the old object"))
(setcar (cdr objects) object))
;; Then update the cache...
- (let* ((line-number (seq-position old-object (car (vtable--cache table))))
- (line (elt (car (vtable--cache table)) line-number)))
- (unless line
- (error "Can't find cached object"))
- (setcar line object)
- (setcdr line (vtable--compute-cached-line table object))
- ;; ... and redisplay the line in question.
- (save-excursion
- (vtable-goto-object old-object)
- (let ((keymap (get-text-property (point) 'keymap))
- (start (point)))
- (delete-line)
- (vtable--insert-line table line line-number
- (nth 1 (vtable--cache table))
- (vtable--spacer table))
- (add-text-properties start (point) (list 'keymap keymap
- 'vtable table))))
- ;; We may have inserted a non-numerical value into a previously
- ;; all-numerical table, so recompute.
- (vtable--recompute-numerical table (cdr line)))))
+ ;; FIXME: If the table's buffer has no visible window, or if its
+ ;; width has changed since the table was updated, the cache key will
+ ;; not match and the object can't be updated. (Bug #69837).
+ (if-let ((line-number (seq-position (car (vtable--cache table)) old-object
+ (lambda (a b)
+ (equal (car a) b))))
+ (line (elt (car (vtable--cache table)) line-number)))
+ (progn
+ (setcar line object)
+ (setcdr line (vtable--compute-cached-line table object))
+ ;; ... and redisplay the line in question.
+ (save-excursion
+ (vtable-goto-object old-object)
+ (let ((keymap (get-text-property (point) 'keymap))
+ (start (point)))
+ (delete-line)
+ (vtable--insert-line table line line-number
+ (nth 1 (vtable--cache table))
+ (vtable--spacer table))
+ (add-text-properties start (point) (list 'keymap keymap
+ 'vtable table))))
+ ;; We may have inserted a non-numerical value into a previously
+ ;; all-numerical table, so recompute.
+ (vtable--recompute-numerical table (cdr line)))
+ (error "Can't find cached object in vtable"))))
(defun vtable-remove-object (table object)
"Remove OBJECT from TABLE.
@@ -741,7 +754,7 @@ If NEXT, do the next column."
(seq-do-indexed
(lambda (elem index)
(when (and (vtable-column--numerical (elt columns index))
- (not (numberp elem)))
+ (not (numberp (car elem))))
(setq recompute t)))
line)
(when recompute
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 522973a0156..b8e16df755b 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -619,7 +619,7 @@ It lists the current state of `erc-dcc-list' in an easy to
read manner."
(buffer-live-p (get-buffer (plist-get elt :file)))
(plist-member elt :size))
(let ((byte-count (with-current-buffer
- (get-buffer (plist-get elt :file))
+ (plist-get elt :file)
(+ (buffer-size) 0.0
erc-dcc-byte-count))))
(format " (%d%%)"
diff --git a/lisp/erc/erc-desktop-notifications.el
b/lisp/erc/erc-desktop-notifications.el
index 2e905097f97..9bb89fbfc81 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -54,6 +54,9 @@
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
+(declare-function haiku-notifications-notify "haikuselect.c")
+(declare-function android-notifications-notify "androidselect.c")
+
(defun erc-notifications-notify (nick msg &optional privp)
"Notify that NICK send some MSG, where PRIVP should be non-nil for PRIVMSGs.
This will replace the last notification sent with this function."
@@ -64,14 +67,19 @@ This will replace the last notification sent with this
function."
(let* ((channel (if privp (erc-get-buffer nick) (current-buffer)))
(title (format "%s in %s" (xml-escape-string nick t) channel))
(body (xml-escape-string (erc-controls-strip msg) t)))
- (notifications-notify :bus erc-notifications-bus
- :title title
- :body body
- :replaces-id
erc-notifications-last-notification
- :app-icon erc-notifications-icon
- :actions '("default" "Switch to buffer")
- :on-action (lambda (&rest _)
- (pop-to-buffer channel)))))))
+ (funcall (cond ((featurep 'android)
+ #'android-notifications-notify)
+ ((featurep 'haiku)
+ #'haiku-notifications-notify)
+ (t #'notifications-notify))
+ :bus erc-notifications-bus
+ :title title
+ :body body
+ :replaces-id erc-notifications-last-notification
+ :app-icon erc-notifications-icon
+ :actions '("default" "Switch to buffer")
+ :on-action (lambda (&rest _)
+ (pop-to-buffer channel)))))))
(defun erc-notifications-PRIVMSG (_proc parsed)
(let ((nick (car (erc-parse-user (erc-response.sender parsed))))
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index da14f5bd728..fe44c3bdfcb 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -625,6 +625,48 @@ Do nothing if the variable `erc-command-indicator' is nil."
erc--msg-props))))
(erc--refresh-prompt))))
+;;;###autoload
+(defun erc-load-irc-script-lines (lines &optional force noexpand)
+ "Process a list of LINES as prompt input submissions.
+If optional NOEXPAND is non-nil, do not expand script-specific
+substitution sequences via `erc-process-script-line' and instead
+process LINES as literal prompt input. With FORCE, bypass flood
+protection."
+ ;; The various erc-cmd-CMDs were designed to return non-nil when
+ ;; their command line should be echoed. But at some point, these
+ ;; handlers began displaying their own output, which naturally
+ ;; appeared *above* the echoed command. This tries to intercept
+ ;; these insertions, deferring them until the command has returned
+ ;; and its command line has been printed.
+ (cl-assert (eq 'erc-mode major-mode))
+ (let ((args (and erc-script-args
+ (if (string-match "^ " erc-script-args)
+ (substring erc-script-args 1)
+ erc-script-args))))
+ (with-silent-modifications
+ (dolist (line lines)
+ (erc-log (concat "erc-load-script: CMD: " line))
+ (unless (string-match (rx bot (* (syntax whitespace)) eot) line)
+ (unless noexpand
+ (setq line (erc-process-script-line line args)))
+ (let ((erc--current-line-input-split (erc--make-input-split line))
+ calls insertp)
+ (add-function :around (local 'erc--send-message-nested-function)
+ (lambda (&rest args) (push args calls))
+ '((name . erc-script-lines-fn) (depth . -80)))
+ (add-function :around (local 'erc--send-action-function)
+ (lambda (&rest args) (push args calls))
+ '((name . erc-script-lines-fn) (depth . -80)))
+ (setq insertp
+ (unwind-protect (erc-process-input-line line force)
+ (remove-function (local 'erc--send-action-function)
+ 'erc-script-lines-fn)
+ (remove-function (local 'erc--send-message-nested-function)
+ 'erc-script-lines-fn)))
+ (when (and insertp erc-script-echo)
+ (erc--command-indicator-display line)
+ (dolist (call calls)
+ (apply (car call) (cdr call))))))))))
;;; IRC control character processing.
(defgroup erc-control-characters nil
@@ -673,14 +715,6 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
"ERC underline face."
:group 'erc-faces)
-(defface erc-control-default-fg '((t :inherit default))
- "ERC foreground face for the \"default\" color code."
- :group 'erc-faces)
-
-(defface erc-control-default-bg '((t :inherit default))
- "ERC background face for the \"default\" color code."
- :group 'erc-faces)
-
;; FIXME rename these to something like `erc-control-color-N-fg',
;; and deprecate the old names via `define-obsolete-face-alias'.
(defface fg:erc-color-face0 '((t :foreground "White"))
@@ -812,7 +846,7 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
(intern (concat "bg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :background (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-fg))))
+ (t (erc-log (format " Wrong color: %s" n)) nil))))
(defun erc-get-fg-color-face (n)
"Fetches the right face for foreground color N (0-15)."
@@ -828,7 +862,7 @@ The value `erc-interpret-controls-p' must also be t for
this to work."
(intern (concat "fg:erc-color-face" (number-to-string n))))
((< 15 n 99)
(list :foreground (aref erc--controls-additional-colors (- n 16))))
- (t (erc-log (format " Wrong color: %s" n)) 'erc-control-default-bg))))
+ (t (erc-log (format " Wrong color: %s" n)) nil))))
;;;###autoload(autoload 'erc-irccontrols-mode "erc-goodies" nil t)
(define-erc-module irccontrols nil
@@ -883,7 +917,7 @@ See `erc-interpret-controls-p' and
`erc-interpret-mirc-color' for options."
(setq s (replace-match "" nil nil s 1))
(cond ((and erc-interpret-mirc-color (or fg-color
bg-color))
(setq fg fg-color)
- (setq bg bg-color))
+ (when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")
@@ -944,7 +978,7 @@ Also see `erc-interpret-controls-p' and
`erc-interpret-mirc-color'."
(replace-match "" nil nil nil 1)
(cond ((and erc-interpret-mirc-color (or fg-color bg-color))
(setq fg fg-color)
- (setq bg bg-color))
+ (when bg-color (setq bg bg-color)))
((string= control "\C-b")
(setq boldp (not boldp)))
((string= control "\C-]")
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 44f92c5a7e2..bcb9b4aafef 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -623,6 +623,7 @@ printed just after each line's text (no alignment)."
((guard erc-stamp--display-margin-mode)
(let ((s (propertize (substring-no-properties string)
'invisible erc-stamp--invisible-property)))
+ (insert " ")
(put-text-property 0 (length string) 'display
`((margin right-margin) ,s)
string)))
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 3cc9bd54228..0750463a4e7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -4004,17 +4004,19 @@ erc-cmd-FOO, this returns a string /FOO."
command-name)))
(defun erc-process-input-line (line &optional force no-command)
- "Translate LINE to an RFC1459 command and send it based.
-Returns non-nil if the command is actually sent to the server, and nil
-otherwise.
-
-If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>',
-it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't
-start with /<COMMAND>) then it is sent as a message.
-
-An optional FORCE argument forces sending the line when flood
-protection is in effect. The optional NO-COMMAND argument prohibits
-this function from interpreting the line as a command."
+ "Dispatch a slash-command or chat-input handler from user-input LINE.
+If simplistic validation fails, print an error and return nil.
+Otherwise, defer to an appropriate handler. For \"slash\" commands,
+like \"/JOIN\", expect a handler, like `erc-cmd-JOIN', to return non-nil
+if LINE is fit for echoing as a command line when executing scripts.
+For normal chat input, expect a handler to return non-nil if a message
+was successfully processed as an outgoing \"PRIVMSG\". If LINE is a
+slash command, and ERC can't find a corresponding handler of the form
+`erc-cmd-<COMMAND>', pass LINE to `erc-cmd-default', treating it as a
+catch-all handler. Otherwise, for normal chat input, pass LINE and the
+boolean argument FORCE to `erc-send-input-line-function'. With a
+non-nil NO-COMMAND, always treat LINE as normal chat input rather than a
+slash command."
(let ((command-list (erc-extract-command-from-line line)))
(if (and command-list
(not no-command))
@@ -8512,7 +8514,8 @@ and so on."
((string-match "^%[Ss]$" esc) server)
((string-match "^%[Nn]$" esc) nick)
((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
- (t (erc-log (format "BUG in erc-process-script-line: bad
escape sequence: %S\n" esc))
+ (t (erc-log (format "Bad escape sequence in %s: %S\n"
+ 'erc-process-script-line esc))
(message "BUG IN ERC: esc=%S" esc)
"")))
(setq line tail)
@@ -8531,37 +8534,6 @@ and so on."
(buffer-string))))
(erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
-(defun erc-load-irc-script-lines (lines &optional force noexpand)
- "Load IRC script LINES (a list of strings).
-
-If optional NOEXPAND is non-nil, do not expand script-specific
-sequences, process the lines verbatim. Use this for multiline
-user input."
- (let* ((cb (current-buffer))
- (s "")
- (sp (or (and (bound-and-true-p erc-command-indicator-mode)
- (fboundp 'erc-command-indicator)
- (erc-command-indicator))
- (erc-prompt)))
- (args (and (boundp 'erc-script-args) erc-script-args)))
- (if (and args (string-match "^ " args))
- (setq args (substring args 1)))
- ;; prepare the prompt string for echo
- (erc-put-text-property 0 (length sp)
- 'font-lock-face 'erc-command-indicator-face sp)
- (while lines
- (setq s (car lines))
- (erc-log (concat "erc-load-script: CMD: " s))
- (unless (string-match "^\\s-*$" s)
- (let ((line (if noexpand s (erc-process-script-line s args))))
- (if (and (erc-process-input-line line force)
- erc-script-echo)
- (progn
- (erc-put-text-property 0 (length line)
- 'font-lock-face 'erc-input-face line)
- (erc-display-line (concat sp line) cb)))))
- (setq lines (cdr lines)))))
-
;; authentication
(defun erc--unfun (maybe-fn)
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 23028576f45..751f13cc715 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -789,7 +789,7 @@ available..."
(ignore-errors
(occur (car args))))
(if (get-buffer "*Occur*")
- (with-current-buffer (get-buffer "*Occur*")
+ (with-current-buffer "*Occur*"
(setq string (buffer-string))
(kill-buffer (current-buffer)))))
(if string (insert string))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 5383f743878..b2b681b7c44 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -1065,6 +1065,9 @@ If a given RFC isn't in these then `ffap-rfc-path' is
offered."
;; (La)TeX: don't allow braces
(latex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
(tex-mode "--:\\\\$+<>@-Z_[:alpha:]~*?" "<@" "@>;.,!:")
+ ;; XML: don't allow angle brackets
+ (xml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
+ (nxml-mode "--:\\\\${}+@-Z_[:alpha:]~*?#" "{<@" "@>;.,!:}")
)
"Alist of (MODE CHARS BEG END), where MODE is a symbol.
This is possibly a major-mode name, or one of the symbols
diff --git a/lisp/files.el b/lisp/files.el
index 3ca4f047144..766ed573392 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3425,7 +3425,7 @@ set the major mode only if that would change it. In
other words
we don't actually set it to the same mode the buffer already has."
;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
(let ((try-locals (not (inhibit-local-variables-p)))
- end done mode modes)
+ end modes)
;; Once we drop the deprecated feature where mode: is also allowed to
;; specify minor-modes (ie, there can be more than one "mode:"), we can
;; remove this section and just let (hack-local-variables t) handle it.
@@ -3456,100 +3456,96 @@ we don't actually set it to the same mode the buffer
already has."
(push (intern (concat (downcase (buffer-substring (point) end))
"-mode"))
modes))))
- ;; If we found modes to use, invoke them now, outside the save-excursion.
- (if modes
- (catch 'nop
- (dolist (mode (nreverse modes))
- (if (not (functionp mode))
- (message "Ignoring unknown mode `%s'" mode)
- (setq done t)
- (or (set-auto-mode-0 mode keep-mode-if-same)
- ;; continuing would call minor modes again, toggling them off
- (throw 'nop nil))))))
- ;; Check for auto-mode-alist entry in dir-locals.
- (unless done
- (with-demoted-errors "Directory-local variables error: %s"
- ;; Note this is a no-op if enable-local-variables is nil.
- (let* ((mode-alist (cdr (hack-dir-local--get-variables
- (lambda (key) (eq key 'auto-mode-alist))))))
- (setq done (set-auto-mode--apply-alist mode-alist
- keep-mode-if-same t)))))
- (and (not done)
- (setq mode (hack-local-variables t (not try-locals)))
- (not (memq mode modes)) ; already tried and failed
- (if (not (functionp mode))
- (message "Ignoring unknown mode `%s'" mode)
- (setq done t)
- (set-auto-mode-0 mode keep-mode-if-same)))
- ;; If we didn't, look for an interpreter specified in the first line.
- ;; As a special case, allow for things like "#!/bin/env perl", which
- ;; finds the interpreter anywhere in $PATH.
- (and (not done)
- (setq mode (save-excursion
- (goto-char (point-min))
- (if (looking-at auto-mode-interpreter-regexp)
- (match-string 2))))
- ;; Map interpreter name to a mode, signaling we're done at the
- ;; same time.
- (setq done (assoc-default
- (file-name-nondirectory mode)
- (mapcar (lambda (e)
- (cons
- (format "\\`%s\\'" (car e))
- (cdr e)))
- interpreter-mode-alist)
- #'string-match-p))
- ;; If we found an interpreter mode to use, invoke it now.
- (set-auto-mode-0 done keep-mode-if-same))
- ;; Next try matching the buffer beginning against magic-mode-alist.
- (unless done
- (if (setq done (save-excursion
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region (point-min)
- (min (point-max)
- (+ (point-min)
magic-mode-regexp-match-limit)))
- (assoc-default
- nil magic-mode-alist
- (lambda (re _dummy)
- (cond
- ((functionp re)
- (funcall re))
- ((stringp re)
- (let ((case-fold-search nil))
- (looking-at re)))
- (t
- (error
- "Problem in magic-mode-alist with element %s"
- re))))))))
- (set-auto-mode-0 done keep-mode-if-same)))
- ;; Next compare the filename against the entries in auto-mode-alist.
- (unless done
- (setq done (set-auto-mode--apply-alist auto-mode-alist
- keep-mode-if-same nil)))
- ;; Next try matching the buffer beginning against
magic-fallback-mode-alist.
- (unless done
- (if (setq done (save-excursion
- (goto-char (point-min))
- (save-restriction
- (narrow-to-region (point-min)
- (min (point-max)
- (+ (point-min)
magic-mode-regexp-match-limit)))
- (assoc-default nil magic-fallback-mode-alist
- (lambda (re _dummy)
- (cond
- ((functionp re)
- (funcall re))
- ((stringp re)
- (let ((case-fold-search nil))
- (looking-at re)))
- (t
- (error
- "Problem with
magic-fallback-mode-alist element: %s"
- re))))))))
- (set-auto-mode-0 done keep-mode-if-same)))
- (unless done
- (set-buffer-major-mode (current-buffer)))))
+ (or
+ ;; If we found modes to use, invoke them now, outside the save-excursion.
+ ;; Presume `modes' holds a major mode followed by minor modes.
+ (let ((done ()))
+ (dolist (mode (nreverse modes))
+ (if (eq done :keep)
+ ;; `keep-mode-if-same' is set and the (major) mode
+ ;; was already set. Refrain from calling the following
+ ;; minor modes since they have already been set.
+ ;; It was especially important in the past when calling
+ ;; minor modes without an arg would toggle them, but it's
+ ;; still preferable to avoid re-enabling them,
+ nil
+ (let ((res (set-auto-mode-0 mode keep-mode-if-same)))
+ (setq done (or res done)))))
+ done)
+ ;; Check for auto-mode-alist entry in dir-locals.
+ (with-demoted-errors "Directory-local variables error: %s"
+ ;; Note this is a no-op if enable-local-variables is nil.
+ (let* ((mode-alist (cdr (hack-dir-local--get-variables
+ (lambda (key) (eq key 'auto-mode-alist))))))
+ (set-auto-mode--apply-alist mode-alist keep-mode-if-same t)))
+ (let ((mode (hack-local-variables t (not try-locals))))
+ (unless (memq mode modes) ; already tried and failed
+ (set-auto-mode-0 mode keep-mode-if-same)))
+ ;; If we didn't, look for an interpreter specified in the first line.
+ ;; As a special case, allow for things like "#!/bin/env perl", which
+ ;; finds the interpreter anywhere in $PATH.
+ (when-let
+ ((interp (save-excursion
+ (goto-char (point-min))
+ (if (looking-at auto-mode-interpreter-regexp)
+ (match-string 2))))
+ ;; Map interpreter name to a mode, signaling we're done at the
+ ;; same time.
+ (mode (assoc-default
+ (file-name-nondirectory interp)
+ (mapcar (lambda (e)
+ (cons
+ (format "\\`%s\\'" (car e))
+ (cdr e)))
+ interpreter-mode-alist)
+ #'string-match-p)))
+ ;; If we found an interpreter mode to use, invoke it now.
+ (set-auto-mode-0 mode keep-mode-if-same))
+ ;; Next try matching the buffer beginning against magic-mode-alist.
+ (let ((mode (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point-min)
+ (min (point-max)
+ (+ (point-min)
magic-mode-regexp-match-limit)))
+ (assoc-default
+ nil magic-mode-alist
+ (lambda (re _dummy)
+ (cond
+ ((functionp re)
+ (funcall re))
+ ((stringp re)
+ (let ((case-fold-search nil))
+ (looking-at re)))
+ (t
+ (error
+ "Problem in magic-mode-alist with element %s"
+ re)))))))))
+ (set-auto-mode-0 mode keep-mode-if-same))
+ ;; Next compare the filename against the entries in auto-mode-alist.
+ (set-auto-mode--apply-alist auto-mode-alist
+ keep-mode-if-same nil)
+ ;; Next try matching the buffer beginning against
magic-fallback-mode-alist.
+ (let ((mode (save-excursion
+ (goto-char (point-min))
+ (save-restriction
+ (narrow-to-region (point-min)
+ (min (point-max)
+ (+ (point-min)
magic-mode-regexp-match-limit)))
+ (assoc-default nil magic-fallback-mode-alist
+ (lambda (re _dummy)
+ (cond
+ ((functionp re)
+ (funcall re))
+ ((stringp re)
+ (let ((case-fold-search nil))
+ (looking-at re)))
+ (t
+ (error
+ "Problem with
magic-fallback-mode-alist element: %s"
+ re)))))))))
+ (set-auto-mode-0 mode keep-mode-if-same))
+ (set-buffer-major-mode (current-buffer)))))
(defvar-local set-auto-mode--last nil
"Remember the mode we have set via `set-auto-mode-0'.")
@@ -3583,18 +3579,29 @@ and it is meant to be modified by packages rather than
users.")
"Apply MODE and return it.
If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
any aliases and compared to current major mode. If they are the
-same, do nothing and return nil."
- (unless (and keep-mode-if-same
- (or (eq (indirect-function mode)
- (indirect-function major-mode))
- (and set-auto-mode--last
- (eq mode (car set-auto-mode--last))
- (eq major-mode (cdr set-auto-mode--last)))))
- (when mode
- (funcall (major-mode-remap mode))
- (unless (eq mode major-mode)
- (setq set-auto-mode--last (cons mode major-mode)))
- mode)))
+same, do nothing and return `:keep'.
+Return nil if MODE could not be applied."
+ (when mode
+ (if (and keep-mode-if-same
+ (or (eq (indirect-function mode)
+ (indirect-function major-mode))
+ (and set-auto-mode--last
+ (eq mode (car set-auto-mode--last))
+ (eq major-mode (cdr set-auto-mode--last)))))
+ :keep
+ (let ((modefun (major-mode-remap mode)))
+ (if (not (functionp modefun))
+ (progn
+ (message "Ignoring unknown mode `%s'%s" mode
+ (if (eq mode modefun) ""
+ (format " (remapped to `%S')" modefun)))
+ nil)
+ (funcall modefun)
+ (unless (or (eq mode major-mode) ;`set-auto-mode--last' is overkill.
+ ;; `modefun' is something like a minor mode.
+ (local-variable-p 'set-auto-mode--last))
+ (setq set-auto-mode--last (cons mode major-mode)))
+ mode)))))
(defvar file-auto-mode-skip "^\\(#!\\|'\\\\\"\\)"
"Regexp of lines to skip when looking for file-local settings.
@@ -4201,8 +4208,9 @@ major-mode."
(not (string-match
"-minor\\'"
(setq val2 (downcase (symbol-name val)))))
- ;; Allow several mode: elements.
- (push (intern (concat val2 "-mode")) result))
+ (let ((mode (intern (concat val2 "-mode"))))
+ (when (fboundp (major-mode-remap mode))
+ (setq result mode))))
(cond ((eq var 'coding))
((eq var 'lexical-binding)
(unless hack-local-variables--warned-lexical
@@ -4233,10 +4241,7 @@ major-mode."
val)
result))))))
(forward-line 1)))))))
- (if (eq handle-mode t)
- ;; Return the final mode: setting that's defined.
- (car (seq-filter #'fboundp result))
- result)))
+ result))
(defun hack-local-variables-apply ()
"Apply the elements of `file-local-variables-alist'.
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index cf34017b994..73f9fccd793 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -38,7 +38,7 @@ For instance:
(?l . \"ls\")))
Each %-spec may contain optional flag, width, and precision
-modifiers, as follows:
+specifiers, as follows:
%<flags><width><precision>character
@@ -51,7 +51,7 @@ The following flags are allowed:
* ^: Convert to upper case.
* _: Convert to lower case.
-The width and truncation modifiers behave like the corresponding
+The width and precision specifiers behave like the corresponding
ones in `format' when applied to %s.
For example, \"%<010b\" means \"substitute into the output the
@@ -145,7 +145,7 @@ is returned, where each format spec is its own element."
"Return STR formatted according to FLAGS, WIDTH, and TRUNC.
FLAGS is a list of keywords as returned by
`format-spec--parse-flags'. WIDTH and TRUNC are either nil or
-string widths corresponding to `format-spec' modifiers."
+string widths corresponding to `format-spec' specifiers."
(let (diff str-width)
;; Truncate original string first, like `format' does.
(when trunc
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index d562d052d82..71bfaa639fa 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -4638,7 +4638,7 @@ and the second element is the address."
"Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
(let ((buffer (gnus-summary-buffer-name group)))
(if (gnus-buffer-live-p buffer)
- (with-current-buffer (get-buffer buffer)
+ (with-current-buffer buffer
(gnus-summary-add-mark article mark))
(gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
(list article)))))
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index f34f5ea0e26..e4c3d2c0381 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -75,35 +75,55 @@ not get notifications."
(when group-article
(let ((group (cadr group-article))
(article (nth 2 group-article)))
- (cond ((string= key "read")
+ (cond ((or (equal key "read")
+ (equal key "default"))
(gnus-fetch-group group (list article))
(select-frame-set-input-focus (selected-frame)))
- ((string= key "mark-read")
+ ((equal key "mark-read")
(gnus-update-read-articles
group
(delq article (gnus-list-of-unread-articles group)))
;; gnus-group-refresh-group
- (gnus-group-update-group group)))))))
+ (gnus-group-update-group group))))))
+ ;; Notifications are removed unless otherwise specified once they (or
+ ;; an action of theirs) are selected
+ (assoc-delete-all id gnus-notifications-id-to-msg))
+
+(defun gnus-notifications-close (id _reason)
+ "Remove ID from the alist of notification identifiers to messages.
+REASON is ignored."
+ (assoc-delete-all id gnus-notifications-id-to-msg))
(defun gnus-notifications-notify (from subject photo-file)
"Send a notification about a new mail.
Return a notification id if any, or t on success."
- (if (fboundp 'notifications-notify)
+ (if (featurep 'android)
(gnus-funcall-no-warning
- 'notifications-notify
+ 'android-notifications-notify
:title from
:body subject
:actions '("read" "Read" "mark-read" "Mark As Read")
:on-action 'gnus-notifications-action
- :app-icon (gnus-funcall-no-warning
- 'image-search-load-path "gnus/gnus.png")
- :image-path photo-file
- :app-name "Gnus"
- :category "email.arrived"
+ :on-close 'gnus-notifications-close
+ :group "Email arrivals"
:timeout gnus-notifications-timeout)
- (message "New message from %s: %s" from subject)
- ;; Don't return an id
- t))
+ (if (fboundp 'notifications-notify)
+ (gnus-funcall-no-warning
+ 'notifications-notify
+ :title from
+ :body subject
+ :actions '("read" "Read" "mark-read" "Mark As Read")
+ :on-action 'gnus-notifications-action
+ :on-close 'gnus-notifications-close
+ :app-icon (gnus-funcall-no-warning
+ 'image-search-load-path "gnus/gnus.png")
+ :image-path photo-file
+ :app-name "Gnus"
+ :category "email.arrived"
+ :timeout gnus-notifications-timeout)
+ (message "New message from %s: %s" from subject)
+ ;; Don't return an id
+ t)))
(declare-function gravatar-retrieve-synchronously "gravatar.el"
(mail-address))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 15d87f9925c..a291893e9a2 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -1061,10 +1061,10 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
(concat
"an autoloaded " (if (commandp def)
"interactive "))
- (if (commandp def) "an interactive " "a "))))
-
- ;; Print what kind of function-like object FUNCTION is.
- (princ (cond ((or (stringp def) (vectorp def))
+ (if (commandp def) "an interactive " "a ")))
+ ;; Print what kind of function-like object FUNCTION is.
+ (description
+ (cond ((or (stringp def) (vectorp def))
"a keyboard macro")
((and (symbolp function)
(get function 'reader-construct))
@@ -1073,12 +1073,6 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
;; aliases before functions.
(aliased
(format-message "an alias for `%s'" real-def))
- ((subr-native-elisp-p def)
- (concat beg "native-compiled Lisp function"))
- ((subrp def)
- (concat beg (if (eq 'unevalled (cdr (subr-arity def)))
- "special form"
- "built-in function")))
((autoloadp def)
(format "an autoloaded %s"
(cond
@@ -1092,12 +1086,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
;; need to check macros before functions.
(macrop function))
(concat beg "Lisp macro"))
- ((byte-code-function-p def)
- (concat beg "byte-compiled Lisp function"))
- ((module-function-p def)
- (concat beg "module function"))
- ((memq (car-safe def) '(lambda closure))
- (concat beg "Lisp function"))
+ ((atom def)
+ (let ((type (or (oclosure-type def) (cl-type-of def))))
+ (concat beg (format "%s"
+ (make-text-button
+ (symbol-name type) nil
+ 'type 'help-type
+ 'help-args (list type))))))
((keymapp def)
(let ((is-full nil)
(elts (cdr-safe def)))
@@ -1107,7 +1102,9 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED
REAL-DEF)."
elts nil))
(setq elts (cdr-safe elts)))
(concat beg (if is-full "keymap" "sparse keymap"))))
- (t "")))
+ (t ""))))
+ (with-current-buffer standard-output
+ (insert description))
(if (and aliased (not (fboundp real-def)))
(princ ",\nwhich is not defined.")
@@ -2448,6 +2445,81 @@ one of them returns non-nil."
(setq buffer-undo-list nil)
(texinfo-mode)))
+(defconst help-fns--function-numbers
+ (make-hash-table :test 'equal :weakness 'value))
+(defconst help-fns--function-names (make-hash-table :weakness 'key))
+
+(defun help-fns--display-function (function)
+ (cond
+ ((subr-primitive-p function)
+ (describe-function function))
+ ((and (compiled-function-p function)
+ (not (and (fboundp 'kmacro-p) (kmacro-p function))))
+ (disassemble function))
+ (t
+ ;; FIXME: Use cl-print!
+ (pp-display-expression function "*Help Source*" (consp function)))))
+
+;;;###autoload
+(defun help-fns-function-name (function)
+ "Return a short buttonized string representing FUNCTION.
+The string is propertized with a button; clicking on that
+provides further details about FUNCTION.
+FUNCTION can be a function, a built-in, a keyboard macro,
+or a compile function.
+This function is intended to be used to display various
+callable symbols in buffers in a way that allows the user
+to find out more details about the symbols."
+ ;; FIXME: For kmacros, should we print the key-sequence?
+ (cond
+ ((symbolp function)
+ (let ((name (if (eq (intern-soft (symbol-name function)) function)
+ (symbol-name function)
+ (concat "#:" (symbol-name function)))))
+ (if (not (fboundp function))
+ name
+ (make-text-button name nil
+ 'type 'help-function
+ 'help-args (list function)))))
+ ((gethash function help-fns--function-names))
+ ((subrp function)
+ (let ((name (subr-name function)))
+ ;; FIXME: For native-elisp-functions, should we use `help-function'
+ ;; or `disassemble'?
+ (format "#<%s %s>"
+ (cl-type-of function)
+ (make-text-button name nil
+ 'type 'help-function
+ ;; Let's hope the subr hasn't been redefined!
+ 'help-args (list (intern name))))))
+ (t
+ (let ((type (or (oclosure-type function)
+ (if (consp function)
+ (car function) (cl-type-of function))))
+ (hash (sxhash-eq function))
+ ;; Use 3 digits minimum.
+ (mask #xfff)
+ name)
+ (while
+ (let* ((hex (format (concat "%0"
+ (number-to-string (1+ (/ (logb mask) 4)))
+ "X")
+ (logand mask hash)))
+ ;; FIXME: For kmacros, we don't want to `disassemble'!
+ (button (buttonize
+ hex #'help-fns--display-function function
+ ;; FIXME: Shouldn't `buttonize' add
+ ;; the "mouse-2, RET:" prefix?
+ "mouse-2, RET: Display the function's body")))
+ (setq name (format "#<%s %s>" type button))
+ (and (< mask (abs hash)) ; We can add more digits.
+ (gethash name help-fns--function-numbers)))
+ ;; Add a digit.
+ (setq mask (+ (ash mask 4) #x0f)))
+ (puthash name function help-fns--function-numbers)
+ (puthash function name help-fns--function-names)
+ name))))
+
(provide 'help-fns)
;;; help-fns.el ends here
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index cea8b379ec0..8a16e85a329 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -92,141 +92,146 @@ and then returns."
`(defun ,fname ()
"Help command."
(interactive)
- (let ((line-prompt
- (substitute-command-keys ,help-line))
- (help-buffer-under-preparation t))
- (when three-step-help
- (message "%s" line-prompt))
- (let* ((help-screen ,help-text)
- ;; We bind overriding-local-map for very small
- ;; sections, *excluding* where we switch buffers
- ;; and where we execute the chosen help command.
- (local-map (make-sparse-keymap))
- (new-minor-mode-map-alist minor-mode-map-alist)
- (prev-frame (selected-frame))
- config new-frame key char)
- (when (string-match "%THIS-KEY%" help-screen)
- (setq help-screen
- (replace-match (help--key-description-fontified
- (substring (this-command-keys) 0 -1))
- t t help-screen)))
- (unwind-protect
- (let ((minor-mode-map-alist nil))
- (setcdr local-map ,helped-map)
- (define-key local-map [t] 'undefined)
- ;; Make the scroll bar keep working normally.
- (define-key local-map [vertical-scroll-bar]
- (lookup-key global-map [vertical-scroll-bar]))
- (if three-step-help
- (progn
- (setq key (let ((overriding-local-map local-map))
- (read-key-sequence nil)))
- ;; Make the HELP key translate to C-h.
- (if (lookup-key function-key-map key)
- (setq key (lookup-key function-key-map key)))
- (setq char (aref key 0)))
- (setq char ??))
- (when (or (eq char ??) (eq char help-char)
- (memq char help-event-list))
- (setq config (current-window-configuration))
- (pop-to-buffer (or ,buffer-name " *Metahelp*") nil t)
- (and (fboundp 'make-frame)
- (not (eq (window-frame)
- prev-frame))
- (setq new-frame (window-frame)
- config nil))
- (setq buffer-read-only nil)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (substitute-command-keys help-screen)))
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- (help-mode)
- (variable-pitch-mode)
- (setq new-minor-mode-map-alist minor-mode-map-alist))
- (goto-char (point-min))
- (while (or (memq char (append help-event-list
- (cons help-char '( ?? ?\C-v ?\s
?\177 ?\M-v ?\S-\s
- deletechar
backspace vertical-scroll-bar
- home end
next prior up down))))
- (eq (car-safe char) 'switch-frame)
- (equal key "\M-v"))
- (condition-case nil
- (cond
- ((eq (car-safe char) 'switch-frame)
- (handle-switch-frame char))
- ((memq char '(?\C-v ?\s next end))
- (scroll-up))
- ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar
backspace prior home))
- (equal key "\M-v"))
- (scroll-down))
- ((memq char '(down))
- (scroll-up 1))
- ((memq char '(up))
- (scroll-down 1)))
- (error nil))
- (let ((cursor-in-echo-area t)
- (overriding-local-map local-map))
- (frame-toggle-on-screen-keyboard (selected-frame) nil)
- (setq key (read-key-sequence
- (format "Type one of listed options%s: "
- (if (pos-visible-in-window-p
- (point-max))
- ""
- (concat ", or "
-
(help--key-description-fontified (kbd "<PageDown>"))
- "/"
-
(help--key-description-fontified (kbd "<PageUp>"))
- "/"
-
(help--key-description-fontified (kbd "SPC"))
- "/"
-
(help--key-description-fontified (kbd "DEL"))
- " to scroll")))
- nil nil nil nil
- ;; Disable ``text conversion''. OS
- ;; input methods might otherwise chose
- ;; to insert user input directly into
- ;; a buffer.
- t)
- char (aref key 0)))
-
- ;; If this is a scroll bar command, just run it.
- (when (eq char 'vertical-scroll-bar)
- (command-execute (lookup-key local-map key) nil key))))
- ;; We don't need the prompt any more.
- (message "")
- ;; Mouse clicks are not part of the help feature,
- ;; so reexecute them in the standard environment.
- (if (listp char)
- (setq unread-command-events
- (cons char unread-command-events)
- config nil)
- (let ((defn (lookup-key local-map key)))
- (if defn
- (progn
- (when config
- (set-window-configuration config)
- (setq config nil))
- ;; Temporarily rebind `minor-mode-map-alist'
- ;; to `new-minor-mode-map-alist' (Bug#10454).
- (let ((minor-mode-map-alist new-minor-mode-map-alist))
- ;; `defn' must make sure that its frame is
- ;; selected, so we won't iconify it below.
- (call-interactively defn))
- (when new-frame
- ;; Do not iconify the selected frame.
- (unless (eq new-frame (selected-frame))
- (iconify-frame new-frame))
- (setq new-frame nil)))
- (unless (equal (key-description key) "C-g")
- (message (substitute-command-keys
- (format "No help command is bound to `\\`%s''"
- (key-description key))))
- (ding))))))
- (when config
- (set-window-configuration config))
- (when new-frame
- (iconify-frame new-frame))
- (setq minor-mode-map-alist new-minor-mode-map-alist))))))
+ (help--help-screen ,help-line ,help-text ,helped-map ,buffer-name)))
+
+
+;;;###autoload
+(defun help--help-screen (help-line help-text helped-map buffer-name)
+ (let ((line-prompt
+ (substitute-command-keys help-line))
+ (help-buffer-under-preparation t))
+ (when three-step-help
+ (message "%s" line-prompt))
+ (let* ((help-screen help-text)
+ ;; We bind overriding-local-map for very small
+ ;; sections, *excluding* where we switch buffers
+ ;; and where we execute the chosen help command.
+ (local-map (make-sparse-keymap))
+ (new-minor-mode-map-alist minor-mode-map-alist)
+ (prev-frame (selected-frame))
+ config new-frame key char)
+ (when (string-match "%THIS-KEY%" help-screen)
+ (setq help-screen
+ (replace-match (help--key-description-fontified
+ (substring (this-command-keys) 0 -1))
+ t t help-screen)))
+ (unwind-protect
+ (let ((minor-mode-map-alist nil))
+ (setcdr local-map helped-map)
+ (define-key local-map [t] #'undefined)
+ ;; Make the scroll bar keep working normally.
+ (define-key local-map [vertical-scroll-bar]
+ (lookup-key global-map [vertical-scroll-bar]))
+ (if three-step-help
+ (progn
+ (setq key (let ((overriding-local-map local-map))
+ (read-key-sequence nil)))
+ ;; Make the HELP key translate to C-h.
+ (if (lookup-key function-key-map key)
+ (setq key (lookup-key function-key-map key)))
+ (setq char (aref key 0)))
+ (setq char ??))
+ (when (or (eq char ??) (eq char help-char)
+ (memq char help-event-list))
+ (setq config (current-window-configuration))
+ (pop-to-buffer (or buffer-name " *Metahelp*") nil t)
+ (and (fboundp 'make-frame)
+ (not (eq (window-frame)
+ prev-frame))
+ (setq new-frame (window-frame)
+ config nil))
+ (setq buffer-read-only nil)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert (substitute-command-keys help-screen)))
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ (help-mode)
+ (variable-pitch-mode)
+ (setq new-minor-mode-map-alist minor-mode-map-alist))
+ (goto-char (point-min))
+ (while (or (memq char (append help-event-list
+ (cons help-char '( ?? ?\C-v ?\s
?\177 ?\M-v ?\S-\s
+ deletechar
backspace vertical-scroll-bar
+ home end next
prior up down))))
+ (eq (car-safe char) 'switch-frame)
+ (equal key "\M-v"))
+ (condition-case nil
+ (cond
+ ((eq (car-safe char) 'switch-frame)
+ (handle-switch-frame char))
+ ((memq char '(?\C-v ?\s next end))
+ (scroll-up))
+ ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar backspace
prior home))
+ (equal key "\M-v"))
+ (scroll-down))
+ ((memq char '(down))
+ (scroll-up 1))
+ ((memq char '(up))
+ (scroll-down 1)))
+ (error nil))
+ (let ((cursor-in-echo-area t)
+ (overriding-local-map local-map))
+ (frame-toggle-on-screen-keyboard (selected-frame) nil)
+ (setq key (read-key-sequence
+ (format "Type one of listed options%s: "
+ (if (pos-visible-in-window-p
+ (point-max))
+ ""
+ (concat ", or "
+
(help--key-description-fontified (kbd "<PageDown>"))
+ "/"
+
(help--key-description-fontified (kbd "<PageUp>"))
+ "/"
+
(help--key-description-fontified (kbd "SPC"))
+ "/"
+
(help--key-description-fontified (kbd "DEL"))
+ " to scroll")))
+ nil nil nil nil
+ ;; Disable ``text conversion''. OS
+ ;; input methods might otherwise chose
+ ;; to insert user input directly into
+ ;; a buffer.
+ t)
+ char (aref key 0)))
+
+ ;; If this is a scroll bar command, just run it.
+ (when (eq char 'vertical-scroll-bar)
+ (command-execute (lookup-key local-map key) nil key))))
+ ;; We don't need the prompt any more.
+ (message "")
+ ;; Mouse clicks are not part of the help feature,
+ ;; so reexecute them in the standard environment.
+ (if (listp char)
+ (setq unread-command-events
+ (cons char unread-command-events)
+ config nil)
+ (let ((defn (lookup-key local-map key)))
+ (if defn
+ (progn
+ (when config
+ (set-window-configuration config)
+ (setq config nil))
+ ;; Temporarily rebind `minor-mode-map-alist'
+ ;; to `new-minor-mode-map-alist' (Bug#10454).
+ (let ((minor-mode-map-alist new-minor-mode-map-alist))
+ ;; `defn' must make sure that its frame is
+ ;; selected, so we won't iconify it below.
+ (call-interactively defn))
+ (when new-frame
+ ;; Do not iconify the selected frame.
+ (unless (eq new-frame (selected-frame))
+ (iconify-frame new-frame))
+ (setq new-frame nil)))
+ (unless (equal (key-description key) "C-g")
+ (message (substitute-command-keys
+ (format "No help command is bound to `\\`%s''"
+ (key-description key))))
+ (ding))))))
+ (when config
+ (set-window-configuration config))
+ (when new-frame
+ (iconify-frame new-frame))
+ (setq minor-mode-map-alist new-minor-mode-map-alist)))))
(provide 'help-macro)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index f9ec8a5cc2b..48433d899ab 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -177,6 +177,11 @@ The format is (FUNCTION ARGS...).")
'help-function 'describe-variable
'help-echo (purecopy "mouse-2, RET: describe this variable"))
+(define-button-type 'help-type
+ :supertype 'help-xref
+ 'help-function #'cl-describe-type
+ 'help-echo (purecopy "mouse-2, RET: describe this type"))
+
(define-button-type 'help-face
:supertype 'help-xref
'help-function 'describe-face
@@ -545,6 +550,9 @@ it does not already exist."
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
,#'describe-variable)
+ ;; FIXME: We could go crazy and add another entry so describe-symbol can be
+ ;; used with the slot names of CL structs (and/or EIEIO objects).
+ ("type" ,#'cl-find-class ,#'cl-describe-type)
("face" ,#'facep ,(lambda (s _b _f) (describe-face s))))
"List of providers of information about symbols.
Each element has the form (NAME TESTFUN DESCFUN) where:
diff --git a/lisp/help.el b/lisp/help.el
index eaada89cf0a..d3b0301add3 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -301,6 +301,8 @@ Do not call this in the scope of `with-help-window'."
(let ((first-message
(cond ((or
pop-up-frames
+ ;; FIXME: `special-display-p' is obsolete since
+ ;; the vars on which it depends are obsolete!
(special-display-p (buffer-name standard-output)))
(setq help-return-method (cons (selected-window) t))
;; If the help output buffer is a special display buffer,
@@ -382,9 +384,9 @@ Do not call this in the scope of `with-help-window'."
(propertize title 'face 'help-for-help-header)
"\n\n"
(help--for-help-make-commands commands))))
- sections ""))
+ sections))
-(defalias 'help 'help-for-help)
+(defalias 'help #'help-for-help)
(make-help-screen help-for-help
(purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or
?")
(concat
@@ -876,7 +878,7 @@ If INSERT (the prefix arg) is non-nil, insert the message
in the buffer."
(format "%s (translated from %s)" string otherstring))))))
(defun help--binding-undefined-p (defn)
- (or (null defn) (integerp defn) (equal defn 'undefined)))
+ (or (null defn) (integerp defn) (equal defn #'undefined)))
(defun help--analyze-key (key untranslated &optional buffer)
"Get information about KEY its corresponding UNTRANSLATED events.
@@ -924,7 +926,9 @@ in the selected window."
(let ((key-desc (help-key-description key untranslated)))
(if (help--binding-undefined-p defn)
(format "%s%s is undefined" key-desc mouse-msg)
- (format "%s%s runs the command %S" key-desc mouse-msg defn)))
+ (format "%s%s runs the command %s" key-desc mouse-msg
+ (if (symbolp defn) (prin1-to-string defn)
+ (help-fns-function-name defn)))))
defn event mouse-msg)))
(defun help--filter-info-list (info-list i)
@@ -1221,7 +1225,7 @@ appeared on the mode-line."
(defun describe-minor-mode-completion-table-for-symbol ()
;; In order to list up all minor modes, minor-mode-list
;; is used here instead of minor-mode-alist.
- (delq nil (mapcar 'symbol-name minor-mode-list)))
+ (delq nil (mapcar #'symbol-name minor-mode-list)))
(defun describe-minor-mode-from-symbol (symbol)
"Display documentation of a minor mode given as a symbol, SYMBOL."
@@ -1663,34 +1667,14 @@ Return nil if the key sequence is too long."
(t value))))
(defun help--describe-command (definition &optional translation)
- (cond ((symbolp definition)
- (if (and (fboundp definition)
- help-buffer-under-preparation)
- (insert-text-button (symbol-name definition)
- 'type 'help-function
- 'help-args (list definition))
- (insert (symbol-name definition)))
- (insert "\n"))
- ((or (stringp definition) (vectorp definition))
+ (cond ((or (stringp definition) (vectorp definition))
(if translation
(insert (key-description definition nil) "\n")
+ ;; These should be rare nowadays, replaced by `kmacro's.
(insert "Keyboard Macro\n")))
((keymapp definition)
(insert "Prefix Command\n"))
- ((byte-code-function-p definition)
- (insert (format "[%s]\n"
- (buttonize "byte-code" #'disassemble definition))))
- ((and (consp definition)
- (memq (car definition) '(closure lambda)))
- (insert (format "[%s]\n"
- (buttonize
- (symbol-name (car definition))
- (lambda (_)
- (pp-display-expression
- definition "*Help Source*" t))
- nil "View definition"))))
- (t
- (insert "??\n"))))
+ (t (insert (help-fns-function-name definition) "\n"))))
(define-obsolete-function-alias 'help--describe-translation
#'help--describe-command "29.1")
@@ -2030,8 +2014,8 @@ and some others."
(if temp-buffer-resize-mode
;; `help-make-xrefs' may add a `back' button and thus increase the
;; text size, so `resize-temp-buffer-window' must be run *after* it.
- (add-hook 'temp-buffer-show-hook 'resize-temp-buffer-window 'append)
- (remove-hook 'temp-buffer-show-hook 'resize-temp-buffer-window)))
+ (add-hook 'temp-buffer-show-hook #'resize-temp-buffer-window 'append)
+ (remove-hook 'temp-buffer-show-hook #'resize-temp-buffer-window)))
(defvar resize-temp-buffer-window-inhibit nil
"Non-nil means `resize-temp-buffer-window' should not resize.")
@@ -2275,7 +2259,7 @@ The `temp-buffer-window-setup-hook' hook is called."
;; Don't print to *Help*; that would clobber Help history.
(defun help-form-show ()
"Display the output of a non-nil `help-form'."
- (let ((msg (eval help-form)))
+ (let ((msg (eval help-form t)))
(if (stringp msg)
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
@@ -2446,7 +2430,7 @@ the same names as used in the original source code, when
possible."
(t arg)))
arglist)))
-(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
+(define-obsolete-function-alias 'help-make-usage #'help--make-usage "25.1")
(defun help--make-usage-docstring (fn arglist)
(let ((print-escape-newlines t))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 355685e70fd..fa64f1ac03e 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -654,8 +654,9 @@ Key bindings:
(unless (display-images-p)
(error "Display does not support images"))
- (major-mode-suspend)
- (setq major-mode 'image-mode)
+ (unless (eq major-mode 'image-mode)
+ (major-mode-suspend)
+ (setq major-mode 'image-mode))
(setq image-transform-resize image-auto-resize)
;; Bail out early if we have no image data.
diff --git a/lisp/image.el b/lisp/image.el
index c13fea6c45c..55340ea03dc 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -560,6 +560,16 @@ Images should not be larger than specified by
`max-image-size'."
('t t)
('nil nil)
(func (funcall func image)))))))
+ ;; Add original map from map.
+ (when (and (plist-get props :map)
+ (not (plist-get props :original-map)))
+ (setq image (nconc image (list :original-map
+ (image--compute-original-map image)))))
+ ;; Add map from original map.
+ (when (and (plist-get props :original-map)
+ (not (plist-get props :map)))
+ (setq image (nconc image (list :map
+ (image--compute-map image)))))
image)))
(defun image--default-smoothing (image)
@@ -1208,7 +1218,10 @@ has no effect."
If N is 3, then the image size will be increased by 30%. More
generally, the image size is multiplied by 1 plus N divided by 10.
N defaults to 2, which increases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(1+ (/ (prefix-numeric-value n) 10.0))
@@ -1220,7 +1233,7 @@ POSITION can be a buffer position or a marker, and
defaults to point."
(defun image--delayed-change-size (size position)
;; Wait for a bit of idle-time before actually performing the change,
;; so as to batch together sequences of closely consecutive size changes.
- ;; `image--change-size' just changes one value in a plist. The actual
+ ;; `image--change-size' just changes two values in a plist. The actual
;; image resizing happens later during redisplay. So if those
;; consecutive calls happen without any redisplay between them,
;; the costly operation of image resizing should happen only once.
@@ -1231,7 +1244,10 @@ POSITION can be a buffer position or a marker, and
defaults to point."
If N is 3, then the image size will be decreased by 30%. More
generally, the image size is multiplied by 1 minus N divided by 10.
N defaults to 2, which decreases the image size by 20%.
-POSITION can be a buffer position or a marker, and defaults to point."
+POSITION can be a buffer position or a marker, and defaults to point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "P")
(image--delayed-change-size (if n
(- 1 (/ (prefix-numeric-value n) 10.0))
@@ -1243,7 +1259,10 @@ POSITION can be a buffer position or a marker, and
defaults to point."
(defun image-mouse-increase-size (&optional event)
"Increase the image size using the mouse-gesture EVENT.
This increases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-increase-size'."
+EVENT, if any, by the default factor used by `image-increase-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1253,7 +1272,10 @@ EVENT, if any, by the default factor used by
`image-increase-size'."
(defun image-mouse-decrease-size (&optional event)
"Decrease the image size using the mouse-gesture EVENT.
This decreases the size of the image at the position specified by
-EVENT, if any, by the default factor used by `image-decrease-size'."
+EVENT, if any, by the default factor used by `image-decrease-size'.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive "e")
(when (listp event)
(save-window-excursion
@@ -1304,7 +1326,9 @@ POSITION can be a buffer position or a marker, and
defaults to point."
(new-image (image--image-without-parameters image))
(scale (image--current-scaling image new-image)))
(setcdr image (cdr new-image))
- (plist-put (cdr image) :scale (* scale factor))))
+ (plist-put (cdr image) :scale (* scale factor))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image--image-without-parameters (image)
(cons (pop image)
@@ -1331,7 +1355,10 @@ POSITION can be a buffer position or a marker, and
defaults to point."
If nil, ANGLE defaults to 90. Interactively, rotate the image 90
degrees clockwise with no prefix argument, and counter-clockwise
with a prefix argument. Note that most image types support
-rotations by only multiples of 90 degrees."
+rotations by only multiples of 90 degrees.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive (and current-prefix-arg '(-90)))
(let ((image (image--get-imagemagick-and-warn)))
(setf (image-property image :rotation)
@@ -1339,7 +1366,9 @@ rotations by only multiples of 90 degrees."
(or angle 90))
;; We don't want to exceed 360 degrees rotation,
;; because it's not seen as valid in Exif data.
- 360))))
+ 360)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image))))
(set-transient-map image--repeat-map nil nil
"Use %k for further adjustments"))
@@ -1360,23 +1389,191 @@ changing the displayed image size does not affect the
saved image."
(read-file-name "Write image to file: ")))))
(defun image-flip-horizontally ()
- "Horizontally flip the image under point."
+ "Horizontally flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-flush image)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(defun image-flip-vertically ()
- "Vertically flip the image under point."
+ "Vertically flip the image under point.
+
+When user option `image-recompute-map-p' is non-nil, the image's `:map'
+is recomputed to fit the newly transformed image."
(interactive)
(let ((image (image--get-image)))
(image-rotate 180)
(setf (image-property image :flip)
- (not (image-property image :flip)))))
+ (not (image-property image :flip)))
+ (when (and (image-property image :original-map) image-recompute-map-p)
+ (setf (image-property image :map) (image--compute-map image)))))
(define-obsolete-function-alias 'image-refresh #'image-flush "29.1")
+;;; Map transformation
+
+(defcustom image-recompute-map-p t
+ "Recompute image map when scaling, rotating, or flipping an image."
+ :type 'boolean
+ :version "30.1")
+
+(defun image--compute-map (image)
+ "Compute map for IMAGE suitable to be used as its :map property.
+Return a copy of :original-image transformed based on IMAGE's :scale,
+:rotation, and :flip. When IMAGE's :original-map is nil, return nil.
+When :rotation is not a multiple of 90, return copy of :original-map."
+ (pcase-let* ((original-map (image-property image :original-map))
+ (map (copy-tree original-map t))
+ (scale (or (image-property image :scale) 1))
+ (rotation (or (image-property image :rotation) 0))
+ (flip (image-property image :flip))
+ ((and size `(,width . ,height)) (image-size image t)))
+ (when (and ; Handle only 90-degree rotations
+ (zerop (mod rotation 1))
+ (zerop (% (truncate rotation) 90)))
+ ;; SIZE fits MAP after transformations. Scale MAP before
+ ;; flip and rotate operations, since both need MAP to fit SIZE.
+ (image--scale-map map scale)
+ ;; In rendered images, rotation is always applied before flip.
+ (image--rotate-map
+ map rotation (if (or (= 90 rotation) (= 270 rotation))
+ ;; If rotated ±90°, swap width and height.
+ (cons height width)
+ size))
+ ;; After rotation, there's no need to swap width and height.
+ (image--flip-map map flip size))
+ map))
+
+(defun image--compute-original-map (image)
+ "Return original map for IMAGE.
+If IMAGE lacks :map property, return nil.
+When :rotation is not a multiple of 90, return copy of :map."
+ (when (image-property image :map)
+ (let* ((image-copy (copy-tree image t))
+ (map (image-property image-copy :map))
+ (scale (or (image-property image-copy :scale) 1))
+ (rotation (or (image-property image-copy :rotation) 0))
+ (flip (image-property image-copy :flip))
+ (size (image-size image-copy t)))
+ (when (and ; Handle only 90-degree rotations
+ (zerop (mod rotation 1))
+ (zerop (% (truncate rotation) 90)))
+ ;; In rendered images, rotation is always applied before flip.
+ ;; To undo the transformation, flip before rotating.
+ ;; SIZE fits MAP before it is transformed back to ORIGINAL-MAP.
+ ;; Therefore, scale MAP after flip and rotate operations, since
+ ;; both need MAP to fit SIZE.
+ (image--flip-map map flip size)
+ (image--rotate-map map (- rotation) size)
+ (image--scale-map map (/ 1.0 scale)))
+ map)))
+
+(defun image--scale-map (map scale)
+ "Scale MAP according to SCALE.
+Destructively modifies and returns MAP."
+ (unless (= 1 scale)
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (setf (caar coords) (round (* (caar coords) scale)))
+ (setf (cdar coords) (round (* (cdar coords) scale)))
+ (setf (cadr coords) (round (* (cadr coords) scale)))
+ (setf (cddr coords) (round (* (cddr coords) scale))))
+ ('circle
+ (setf (caar coords) (round (* (caar coords) scale)))
+ (setf (cdar coords) (round (* (cdar coords) scale)))
+ (setcdr coords (round (* (cdr coords) scale))))
+ ('poly
+ (dotimes (i (length coords))
+ (aset coords i
+ (round (* (aref coords i) scale))))))))
+ map)
+
+(defun image--rotate-map (map rotation size)
+ "Rotate MAP according to ROTATION and SIZE.
+Destructively modifies and returns MAP."
+ (unless (zerop rotation)
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (let ( x0 y0 ; New upper left corner
+ x1 y1) ; New bottom right corner
+ (pcase (truncate (mod rotation 360)) ; Set new corners to...
+ (90 ; ...old bottom left and upper right
+ (setq x0 (caar coords) y0 (cddr coords)
+ x1 (cadr coords) y1 (cdar coords)))
+ (180 ; ...old bottom right and upper left
+ (setq x0 (cadr coords) y0 (cddr coords)
+ x1 (caar coords) y1 (cdar coords)))
+ (270 ; ...old upper right and bottom left
+ (setq x0 (cadr coords) y0 (cdar coords)
+ x1 (caar coords) y1 (cddr coords))))
+ (setcar coords (image--rotate-coord x0 y0 rotation size))
+ (setcdr coords (image--rotate-coord x1 y1 rotation size))))
+ ('circle
+ (setcar coords (image--rotate-coord
+ (caar coords) (cdar coords) rotation size)))
+ ('poly
+ (dotimes (i (length coords))
+ (when (= 0 (% i 2))
+ (pcase-let ((`(,x . ,y)
+ (image--rotate-coord
+ (aref coords i) (aref coords (1+ i)) rotation
size)))
+ (aset coords i x)
+ (aset coords (1+ i) y))))))))
+ map)
+
+(defun image--rotate-coord (x y angle size)
+ "Rotate coordinates X and Y by ANGLE in image of SIZE.
+ANGLE must be a multiple of 90. Returns a cons cell of rounded
+coordinates (X1 Y1)."
+ (pcase-let* ((radian (* (/ angle 180.0) float-pi))
+ (`(,width . ,height) size)
+ ;; y is positive, but we are in the bottom-right quadrant
+ (y (- y))
+ ;; Rotate clockwise
+ (x1 (+ (* (sin radian) y) (* (cos radian) x)))
+ (y1 (- (* (cos radian) y) (* (sin radian) x)))
+ ;; Translate image back into bottom-right quadrant
+ (`(,x1 . ,y1)
+ (pcase (truncate (mod angle 360))
+ (90 ; Translate right by height
+ (cons (+ x1 height) y1))
+ (180 ; Translate right by width and down by height
+ (cons (+ x1 width) (- y1 height)))
+ (270 ; Translate down by width
+ (cons x1 (- y1 width)))))
+ ;; Invert y1 to make both x1 and y1 positive
+ (y1 (- y1)))
+ (cons (round x1) (round y1))))
+
+(defun image--flip-map (map flip size)
+ "Horizontally flip MAP according to FLIP and SIZE.
+Destructively modifies and returns MAP."
+ (when flip
+ (pcase-dolist (`(,`(,type . ,coords) ,_id ,_plist) map)
+ (pcase-exhaustive type
+ ('rect
+ (let ((x0 (- (car size) (cadr coords)))
+ (y0 (cdar coords))
+ (x1 (- (car size) (caar coords)))
+ (y1 (cddr coords)))
+ (setcar coords (cons x0 y0))
+ (setcdr coords (cons x1 y1))))
+ ('circle
+ (setf (caar coords) (- (car size) (caar coords))))
+ ('poly
+ (dotimes (i (length coords))
+ (when (= 0 (% i 2))
+ (aset coords i (- (car size) (aref coords i)))))))))
+ map)
+
(provide 'image)
;;; image.el ends here
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 6b4c83112e3..e80c42f523a 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -350,9 +350,10 @@ This also sets the following values:
if CODING-SYSTEM is ASCII-compatible"
(check-coding-system coding-system)
(setq-default buffer-file-coding-system coding-system)
-
- (if (eq system-type 'darwin)
- ;; The file-name coding system on Darwin systems is always utf-8.
+ (if (or (eq system-type 'darwin)
+ (eq system-type 'android))
+ ;; The file-name coding system on Darwin and Android systems is
+ ;; always UTF-8.
(setq default-file-name-coding-system 'utf-8-unix)
(if (and (or (not coding-system)
(coding-system-get coding-system 'ascii-compatible-p)))
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 14fe0447008..5037d8c5b2b 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,7 +4,7 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
-;; Version: 1.0.24
+;; Version: 1.0.25
;; Package-Requires: ((emacs "25.2"))
;; This is a GNU ELPA :core package. Avoid functionality that is not
@@ -760,10 +760,11 @@ With optional CLEANUP, kill any associated buffers."
(setq message
(plist-put message :jsonrpc-json
(buffer-string)))
- (process-put proc 'jsonrpc-mqueue
- (nconc (process-get proc
-
'jsonrpc-mqueue)
- (list message)))))
+ ;; Put new messages at the front of the queue,
+ ;; this is correct as the order is reversed
+ ;; before putting the timers on `timer-list'.
+ (push message
+ (process-get proc 'jsonrpc-mqueue))))
(goto-char message-end)
(let ((inhibit-read-only t))
(delete-region (point-min) (point)))
@@ -782,11 +783,20 @@ With optional CLEANUP, kill any associated buffers."
;; non-locally (typically the reply to a request), so do
;; this all this processing in top-level loops timer.
(cl-loop
+ ;; `timer-activate' orders timers by time, which is an
+ ;; very expensive operation when jsonrpc-mqueue is large,
+ ;; therefore the time object is reused for each timer
+ ;; created.
+ with time = (current-time)
for msg = (pop (process-get proc 'jsonrpc-mqueue)) while msg
- do (run-at-time 0 nil
- (lambda (m) (with-temp-buffer
- (jsonrpc-connection-receive conn m)))
- msg)))))))
+ do (let ((timer (timer-create)))
+ (timer-set-time timer time)
+ (timer-set-function timer
+ (lambda (conn msg)
+ (with-temp-buffer
+ (jsonrpc-connection-receive conn msg)))
+ (list conn msg))
+ (timer-activate timer))))))))
(defun jsonrpc--remove (conn id &optional deferred-spec)
"Cancel CONN's continuations for ID, including its timer, if it exists.
diff --git a/lisp/keymap.el b/lisp/keymap.el
index d2544e30ce0..b2b475c7d71 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -260,7 +260,7 @@ returned by \\[describe-key] (`describe-key')."
(setq word (concat (match-string 1 word)
(match-string 3 word)))
(not (string-match
- "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
+
"\\<\\(NUL\\|RET\\|LFD\\|TAB\\|ESC\\|SPC\\|DEL\\)$"
word))))
(setq key (list (intern word))))
((or (equal word "REM") (string-match "^;;" word))
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 5b290899ff5..320fabb54cf 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1838,6 +1838,9 @@ mail status in mode line"))
(bindings--define-key menu [project-open-file] '(menu-item "Open File..."
project-find-file :help "Open an existing file that belongs to current
project"))
menu))
+(defvar menu-bar-project-item
+ `(menu-item "Project" ,menu-bar-project-menu))
+
(defun menu-bar-read-mail ()
"Read mail using `read-mail-command'."
(interactive)
@@ -1925,7 +1928,7 @@ mail status in mode line"))
:help "Start language server suitable for this buffer's
major-mode"))
(bindings--define-key menu [project]
- `(menu-item "Project" ,menu-bar-project-menu))
+ menu-bar-project-item)
(bindings--define-key menu [ede]
'(menu-item "Project Support (EDE)"
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 099fa1599d5..0a844c538b4 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3163,18 +3163,30 @@ and `RET' accepts the input typed into the minibuffer."
:type 'boolean
:version "30.1")
+(defvar minibuffer-visible-completions--always-bind nil
+ "If non-nil, force the `minibuffer-visible-completions' bindings on.")
+
+(defun minibuffer-visible-completions--filter (cmd)
+ "Return CMD if `minibuffer-visible-completions' bindings should be active."
+ (if minibuffer-visible-completions--always-bind
+ cmd
+ (when-let ((window (get-buffer-window "*Completions*" 0)))
+ (when (and (eq (buffer-local-value 'completion-reference-buffer
+ (window-buffer window))
+ (window-buffer (active-minibuffer-window)))
+ (if (eq cmd #'minibuffer-choose-completion-or-exit)
+ (with-current-buffer (window-buffer window)
+ (get-text-property (point) 'completion--string))
+ t))
+ cmd))))
+
(defun minibuffer-visible-completions-bind (binding)
"Use BINDING when completions are visible.
Return an item that is enabled only when a window
displaying the *Completions* buffer exists."
`(menu-item
"" ,binding
- :filter ,(lambda (cmd)
- (when-let ((window (get-buffer-window "*Completions*" 0)))
- (when (eq (buffer-local-value 'completion-reference-buffer
- (window-buffer window))
- (window-buffer (active-minibuffer-window)))
- cmd)))))
+ :filter ,#'minibuffer-visible-completions--filter))
(defvar-keymap minibuffer-visible-completions-map
:doc "Local keymap for minibuffer input with visible completions."
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 26835437c08..cef88dede8a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -393,6 +393,7 @@ and should return the same menu with changes such as added
new menu items."
(function-item context-menu-local)
(function-item context-menu-minor)
(function-item context-menu-buffers)
+ (function-item context-menu-project)
(function-item context-menu-vc)
(function-item context-menu-ffap)
(function-item hi-lock-context-menu)
@@ -533,6 +534,12 @@ Some context functions add menu items below the separator."
(mouse-buffer-menu-keymap))
menu)
+(defun context-menu-project (menu _click)
+ "Populate MENU with project commands."
+ (define-key-after menu [separator-project] menu-bar-separator)
+ (define-key-after menu [project-menu] menu-bar-project-item)
+ menu)
+
(defun context-menu-vc (menu _click)
"Populate MENU with Version Control commands."
(define-key-after menu [separator-vc] menu-bar-separator)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 2936bc8f099..39ea964d47a 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -275,6 +275,27 @@ parameter, and should return the (possibly) transformed
URL."
:type '(repeat function)
:version "29.1")
+(defcustom eww-readable-urls nil
+ "A list of regexps matching URLs to display in readable mode by default.
+EWW will display matching URLs using `eww-readable' (which see).
+
+Each element can be one of the following forms: a regular expression in
+string form or a cons cell of the form (REGEXP . READABILITY). If
+READABILITY is non-nil, this behaves the same as the string form;
+otherwise, URLs matching REGEXP will never be displayed in readable mode
+by default."
+ :type '(repeat (choice (string :tag "Readable URL")
+ (cons :tag "URL and Readability"
+ (string :tag "URL")
+ (radio (const :tag "Readable" t)
+ (const :tag "Non-readable" nil)))))
+ :version "30.1")
+
+(defcustom eww-readable-adds-to-history t
+ "If non-nil, calling `eww-readable' adds a new entry to the history."
+ :type 'boolean
+ :version "30.1")
+
(defface eww-form-submit
'((((type x w32 ns haiku pgtk android) (class color)) ; Like default
mode line
:box (:line-width 2 :style released-button)
@@ -464,11 +485,11 @@ For more information, see Info node `(eww) Top'."
(defun eww-retrieve (url callback cbargs)
(cond
((null eww-retrieve-command)
- (url-retrieve url #'eww-render cbargs))
+ (url-retrieve url callback cbargs))
((eq eww-retrieve-command 'sync)
(let ((data-buffer (url-retrieve-synchronously url)))
(with-current-buffer data-buffer
- (apply #'eww-render nil cbargs))))
+ (apply callback nil cbargs))))
(t
(let ((buffer (generate-new-buffer " *eww retrieve*"))
(error-buffer (generate-new-buffer " *eww error*")))
@@ -673,9 +694,9 @@ The renaming scheme is performed in accordance with
(insert (format "<a href=%S>Direct link to the document</a>"
url))
(goto-char (point-min))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((eww-html-p (car content-type))
- (eww-display-html charset url nil point buffer encode))
+ (eww-display-html (or encode charset) url nil point buffer))
((equal (car content-type) "application/pdf")
(eww-display-pdf))
((string-match-p "\\`image/" (car content-type))
@@ -726,34 +747,40 @@ The renaming scheme is performed in accordance with
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
-(defun eww-display-html (charset url &optional document point buffer encode)
+(defun eww--parse-html-region (start end &optional coding-system)
+ "Parse the HTML between START and END, returning the DOM as an S-expression.
+Use CODING-SYSTEM to decode the region; if nil, decode as UTF-8.
+
+This replaces the region with the preprocessed HTML."
+ (setq coding-system (or coding-system 'utf-8))
+ (with-restriction start end
+ (condition-case nil
+ (decode-coding-region (point-min) (point-max) coding-system)
+ (coding-system-error nil))
+ ;; Remove CRLF and replace NUL with � before parsing.
+ (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
+ (replace-match (if (match-beginning 1) "" "�") t t))
+ (eww--preprocess-html (point-min) (point-max))
+ (libxml-parse-html-region (point-min) (point-max))))
+
+(defsubst eww-document-base (url dom)
+ `(base ((href . ,url)) ,dom))
+
+(defun eww-display-document (document &optional point buffer)
(unless (fboundp 'libxml-parse-html-region)
(error "This function requires Emacs to be compiled with libxml2"))
+ (setq buffer (or buffer (current-buffer)))
(unless (buffer-live-p buffer)
(error "Buffer %s doesn't exist" buffer))
;; There should be a better way to abort loading images
;; asynchronously.
(setq url-queue nil)
- (let ((document
- (or document
- (list
- 'base (list (cons 'href url))
- (progn
- (setq encode (or encode charset 'utf-8))
- (condition-case nil
- (decode-coding-region (point) (point-max) encode)
- (coding-system-error nil))
- (save-excursion
- ;; Remove CRLF and replace NUL with � before parsing.
- (while (re-search-forward "\\(\r$\\)\\|\0" nil t)
- (replace-match (if (match-beginning 1) "" "�") t t)))
- (eww--preprocess-html (point) (point-max))
- (libxml-parse-html-region (point) (point-max))))))
- (source (and (null document)
- (buffer-substring (point) (point-max)))))
+ (let ((url (when (eq (car document) 'base)
+ (alist-get 'href (cadr document)))))
+ (unless url
+ (error "Document is missing base URL"))
(with-current-buffer buffer
(setq bidi-paragraph-direction nil)
- (plist-put eww-data :source source)
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
@@ -794,6 +821,20 @@ The renaming scheme is performed in accordance with
(forward-line 1)))))
(eww-size-text-inputs))))
+(defun eww-display-html (charset url &optional document point buffer)
+ (let ((source (buffer-substring (point) (point-max))))
+ (with-current-buffer buffer
+ (plist-put eww-data :source source)))
+ (unless document
+ (let ((dom (eww--parse-html-region (point) (point-max) charset)))
+ (when (eww-default-readable-p url)
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom))
+ (with-current-buffer buffer
+ (plist-put eww-data :readable t)))
+ (setq document (eww-document-base url dom))))
+ (eww-display-document document point buffer))
+
(defun eww-handle-link (dom)
(let* ((rel (dom-attr dom 'rel))
(href (dom-attr dom 'href))
@@ -1055,30 +1096,47 @@ The renaming scheme is performed in accordance with
"automatic"
bidi-paragraph-direction)))
-(defun eww-readable ()
- "View the main \"readable\" parts of the current web page.
+(defun eww-readable (&optional arg)
+ "Toggle display of only the main \"readable\" parts of the current web page.
This command uses heuristics to find the parts of the web page that
-contains the main textual portion, leaving out navigation menus and
-the like."
- (interactive nil eww-mode)
+contain the main textual portion, leaving out navigation menus and the
+like.
+
+If called interactively, toggle the display of the readable parts. If
+the prefix argument is positive, display the readable parts, and if it
+is zero or negative, display the full page.
+
+If called from Lisp, toggle the display of the readable parts if ARG is
+`toggle'. Display the readable parts if ARG is nil, omitted, or is a
+positive number. Display the full page if ARG is a negative number.
+
+When `eww-readable-adds-to-history' is non-nil, calling this function
+adds a new entry to `eww-history'."
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 'toggle))
+ eww-mode)
(let* ((old-data eww-data)
- (dom (with-temp-buffer
+ (make-readable (cond
+ ((eq arg 'toggle)
+ (not (plist-get old-data :readable)))
+ ((and (numberp arg) (< arg 1))
+ nil)
+ (t t)))
+ (dom (with-temp-buffer
(insert (plist-get old-data :source))
- (condition-case nil
- (decode-coding-region (point-min) (point-max) 'utf-8)
- (coding-system-error nil))
- (eww--preprocess-html (point-min) (point-max))
- (libxml-parse-html-region (point-min) (point-max))))
+ (eww--parse-html-region (point-min) (point-max))))
(base (plist-get eww-data :url)))
- (eww-score-readability dom)
- (eww-save-history)
- (eww--before-browse)
- (eww-display-html nil nil
- (list 'base (list (cons 'href base))
- (eww-highest-readability dom))
- nil (current-buffer))
- (dolist (elem '(:source :url :title :next :previous :up :peer))
- (plist-put eww-data elem (plist-get old-data elem)))
+ (when make-readable
+ (eww-score-readability dom)
+ (setq dom (eww-highest-readability dom)))
+ (when eww-readable-adds-to-history
+ (eww-save-history)
+ (eww--before-browse)
+ (dolist (elem '(:source :url :title :next :previous :up :peer))
+ (plist-put eww-data elem (plist-get old-data elem))))
+ (eww-display-document (eww-document-base base dom))
+ (plist-put eww-data :readable make-readable)
(eww--after-page-change)))
(defun eww-score-readability (node)
@@ -1121,6 +1179,19 @@ the like."
(setq result highest))))
result))
+(defun eww-default-readable-p (url)
+ "Return non-nil if URL should be displayed in readable mode by default.
+This consults the entries in `eww-readable-urls' (which see)."
+ (catch 'found
+ (let (result)
+ (dolist (regexp eww-readable-urls)
+ (if (consp regexp)
+ (setq result (cdr regexp)
+ regexp (car regexp))
+ (setq result t))
+ (when (string-match regexp url)
+ (throw 'found result))))))
+
(defvar-keymap eww-mode-map
"g" #'eww-reload ;FIXME: revert-buffer-function instead!
"G" #'eww
@@ -1398,8 +1469,7 @@ just re-display the HTML already fetched."
(if local
(if (null (plist-get eww-data :dom))
(error "No current HTML data")
- (eww-display-html 'utf-8 url (plist-get eww-data :dom)
- (point) (current-buffer)))
+ (eww-display-document (plist-get eww-data :dom) (point)))
(let ((parsed (url-generic-parse-url url)))
(if (equal (url-type parsed) "file")
;; Use Tramp instead of url.el for files (since url.el
@@ -2267,7 +2337,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(when (and (not first)
(not (eobp)))
(forward-line 1))
@@ -2286,7 +2356,7 @@ If ERROR-OUT, signal user-error if there are no
bookmarks."
(setq first t)
(eww-read-bookmarks t)
(eww-bookmark-prepare))
- (with-current-buffer (get-buffer "*eww bookmarks*")
+ (with-current-buffer "*eww bookmarks*"
(if first
(goto-char (point-max))
(beginning-of-line))
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index e23fc6104d2..09df5f5a9bb 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -784,8 +784,9 @@ size, and full-buffer size."
(or shr-current-font 'shr-text)))))))))
(defun shr-fill-lines (start end)
- (if (or (not shr-fill-text) (<= shr-internal-width 0))
- nil
+ "Indent and fill text from START to END.
+When `shr-fill-text' is nil, only indent."
+ (unless (<= shr-internal-width 0)
(save-restriction
(narrow-to-region start end)
(goto-char start)
@@ -807,6 +808,8 @@ size, and full-buffer size."
(forward-char 1))))
(defun shr-fill-line ()
+ "Indent and fill the current line.
+When `shr-fill-text' is nil, only indent."
(let ((shr-indentation (or (get-text-property (point) 'shr-indentation)
shr-indentation))
(continuation (get-text-property
@@ -821,9 +824,11 @@ size, and full-buffer size."
`,(shr-face-background face))))
(setq start (point))
(setq shr-indentation (or continuation shr-indentation))
- ;; If we have an indentation that's wider than the width we're
- ;; trying to fill to, then just give up and don't do any filling.
- (when (< shr-indentation shr-internal-width)
+ ;; Fill the current line, unless `shr-fill-text' is unset, or we
+ ;; have an indentation that's wider than the width we're trying to
+ ;; fill to.
+ (when (and shr-fill-text
+ (< shr-indentation shr-internal-width))
(shr-vertical-motion shr-internal-width)
(when (looking-at " $")
(delete-region (point) (line-end-position)))
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index fddc6e21bcc..a6ba556e7ae 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -354,7 +354,7 @@ Used to bracket operations which move point in the
sieve-buffer."
(let ((script (buffer-string))
(script-name (file-name-sans-extension (buffer-name)))
err)
- (with-current-buffer (get-buffer sieve-buffer)
+ (with-current-buffer sieve-buffer
(setq err (sieve-manage-putscript
(or name sieve-buffer-script-name script-name)
script sieve-manage-buffer))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index a545a8e7273..d3af7a009ec 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -281,7 +281,7 @@ non-nil."
;; Remove all buffers with a remote default-directory which fit the hook.
(dolist (name (tramp-list-remote-buffers))
(and (buffer-live-p (get-buffer name))
- (with-current-buffer (get-buffer name)
+ (with-current-buffer name
(run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook))
(kill-buffer name))))
diff --git a/lisp/obsolete/quickurl.el b/lisp/obsolete/quickurl.el
index 7393bebdce1..7da51a8a4a8 100644
--- a/lisp/obsolete/quickurl.el
+++ b/lisp/obsolete/quickurl.el
@@ -447,7 +447,7 @@ The key bindings for `quickurl-list-mode' are:
(defun quickurl-list-populate-buffer ()
"Populate the `quickurl-list' buffer."
- (with-current-buffer (get-buffer quickurl-list-buffer-name)
+ (with-current-buffer quickurl-list-buffer-name
(let* ((sizes (or (cl-loop for url in quickurl-urls
collect (length (quickurl-url-description url)))
(list 20)))
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index d335aab7499..f834f05cb6d 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -93,7 +93,7 @@
(mapcar #'org-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
- (with-current-buffer (get-buffer "*Calculator*")
+ (with-current-buffer "*Calculator*"
(prog1
(calc-eval (calc-top 1))
(calc-pop 1)))))
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index f8195a053bc..06249ed48fa 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -3883,7 +3883,7 @@ generating a new one."
;; buffer found
(get-buffer org-agenda-buffer-name)
;; C-u parameter is same as last call
- (with-current-buffer (get-buffer org-agenda-buffer-name)
+ (with-current-buffer org-agenda-buffer-name
(and
(equal current-prefix-arg
org-agenda-last-prefix-arg)
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 196c5f159cd..0b34712a50c 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1140,7 +1140,7 @@ Typing SPC flushes the help buffer."
(let (event)
(prog1
(catch 'done
- (while (with-current-buffer (get-buffer "*Completions*")
+ (while (with-current-buffer "*Completions*"
(setq event (read-event)))
(cond
((eq event ?\s)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 80f84037a63..4e02cd1d890 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -38,8 +38,7 @@
(defcustom profiler-sampling-interval 1000000
"Default sampling interval in nanoseconds."
- :type 'natnum
- :group 'profiler)
+ :type 'natnum)
;;; Utilities
@@ -68,7 +67,7 @@
collect c into s
do (cl-decf i)
finally return
- (apply 'string (if (eq (car s) ?,) (cdr s) s)))
+ (apply #'string (if (eq (car s) ?,) (cdr s) s)))
(profiler-ensure-string number)))
(defun profiler-format (fmt &rest args)
@@ -76,7 +75,7 @@
for arg in args
for str = (cond
((consp subfmt)
- (apply 'profiler-format subfmt arg))
+ (apply #'profiler-format subfmt arg))
((stringp subfmt)
(format subfmt arg))
((and (symbolp subfmt)
@@ -91,7 +90,8 @@
if (< width len)
collect (progn (put-text-property (max 0 (- width 2)) len
'invisible 'profiler str)
- str) into frags
+ str)
+ into frags
else
collect
(let ((padding (make-string (max 0 (- width len)) ?\s)))
@@ -100,32 +100,11 @@
(right (concat padding str))))
into frags
finally return (apply #'concat frags)))
-
-
-;;; Entries
-
-(defun profiler-format-entry (entry)
- "Format ENTRY in human readable string.
-ENTRY would be a function name of a function itself."
- (cond ((memq (car-safe entry) '(closure lambda))
- (format "#<lambda %#x>" (sxhash entry)))
- ((byte-code-function-p entry)
- (format "#<compiled %#x>" (sxhash entry)))
- ((or (subrp entry) (symbolp entry) (stringp entry))
- (format "%s" entry))
- (t
- (format "#<unknown %#x>" (sxhash entry)))))
-
-(defun profiler-fixup-entry (entry)
- (if (symbolp entry)
- entry
- (profiler-format-entry entry)))
-
;;; Backtraces
(defun profiler-fixup-backtrace (backtrace)
- (apply 'vector (mapcar 'profiler-fixup-entry backtrace)))
+ (apply #'vector (mapcar #'help-fns-function-name backtrace)))
;;; Logs
@@ -434,18 +413,15 @@ Optional argument MODE means only check for the specified
mode (cpu or mem)."
(defcustom profiler-report-closed-mark "+"
"An indicator of closed calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-open-mark "-"
"An indicator of open calltrees."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defcustom profiler-report-leaf-mark " "
"An indicator of calltree leaves."
- :type 'string
- :group 'profiler)
+ :type 'string)
(defvar profiler-report-cpu-line-format
'((17 right ((12 right)
@@ -474,17 +450,18 @@ Do not touch this variable directly.")
(let ((string (cond
((eq entry t)
"Others")
- ((and (symbolp entry)
- (fboundp entry))
- (propertize (symbol-name entry)
- 'face 'link
- 'follow-link "\r"
- 'mouse-face 'highlight
- 'help-echo "\
+ (t (propertize (help-fns-function-name entry)
+ ;; Override the `button-map' which
+ ;; otherwise adds RET, mouse-1, and TAB
+ ;; bindings we don't want. :-(
+ 'keymap '(make-sparse-keymap)
+ 'follow-link "\r"
+ ;; FIXME: The help-echo code gets confused
+ ;; by the `follow-link' property and rewrites
+ ;; `mouse-2' to `mouse-1' :-(
+ 'help-echo "\
mouse-2: jump to definition\n\
-RET: expand or collapse"))
- (t
- (profiler-format-entry entry)))))
+RET: expand or collapse")))))
(propertize string 'profiler-entry entry)))
(defun profiler-report-make-name-part (tree)
@@ -719,10 +696,13 @@ point."
(current-buffer))
(and event (setq event (event-end event))
(posn-set-point event))
- (let ((tree (profiler-report-calltree-at-point)))
- (when tree
- (let ((entry (profiler-calltree-entry tree)))
- (find-function entry))))))
+ (save-excursion
+ (forward-line 0)
+ (let ((eol (pos-eol)))
+ (forward-button 1)
+ (if (> (point) eol)
+ (error "No entry found")
+ (push-button))))))
(defun profiler-report-describe-entry ()
"Describe entry at point."
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 29ff521253b..977a3d72cb7 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -493,7 +493,7 @@ and set it if applicable."
;; the values of the From, To, and Cc headers.
(let (header-values)
(with-current-buffer
- (get-buffer gnus-original-article-buffer)
+ gnus-original-article-buffer
(save-excursion
(goto-char (point-min))
;; The Newsgroup is omitted because we already matched
diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el
index 0095d83e302..e48bcc64f14 100644
--- a/lisp/progmodes/c-ts-common.el
+++ b/lisp/progmodes/c-ts-common.el
@@ -332,7 +332,7 @@ Assumes the anchor is (point-min), i.e., the 0th column.
This function basically counts the number of block nodes (i.e.,
brackets) (see `c-ts-common-indent-type-regexp-alist')
between NODE and the root node (not counting NODE itself), and
-multiply that by `c-ts-common-indent-offset'.
+multiplies that by `c-ts-common-indent-offset'.
To support GNU style, on each block level, this function also
checks whether the opening bracket { is on its own line, if so,
diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el
index a2e7f6fba2e..3a89f0f494b 100644
--- a/lisp/progmodes/c-ts-mode.el
+++ b/lisp/progmodes/c-ts-mode.el
@@ -97,7 +97,7 @@
"Toggle the comment style between block and line comments.
Optional numeric ARG, if supplied, switches to block comment
style when positive, to line comment style when negative, and
-just toggles it when zero or left out."
+just toggles it when zero or omitted."
(interactive "P")
(let ((prevstate-line (string= comment-start "// ")))
(when (or (not arg)
@@ -147,9 +147,9 @@ symbol."
"Style used for indentation.
The selected style could be one of GNU, K&R, LINUX or BSD. If
-one of the supplied styles doesn't suffice, a function could be
-set instead. This function is expected to return a list that
-follows the form of `treesit-simple-indent-rules'."
+one of the supplied styles doesn't suffice, the value could be
+a function instead. This function is expected to return a list
+that follows the form of `treesit-simple-indent-rules'."
:version "29.1"
:type '(choice (symbol :tag "Gnu" gnu)
(symbol :tag "K&R" k&r)
@@ -202,8 +202,8 @@ To set the default indent style globally, use
(if (derived-mode-p 'c-ts-mode) 'c 'cpp))))))
(defcustom c-ts-mode-emacs-sources-support t
- "Whether to enable Emacs source-specific features.
-This enables detection of definitions of Lisp function using
+ "Whether to enable Emacs source-specific C features.
+This enables detection of definitions of Lisp functions via
the DEFUN macro.
This needs to be set before enabling `c-ts-mode'; if you change
the value after enabling `c-ts-mode', toggle the mode off and on
@@ -243,7 +243,7 @@ again."
< and > are usually punctuation, e.g., in ->. But when used for
templates, they should be considered pairs.
-This function checks for < and > in the changed RANGES and apply
+This function checks for < and > in the changed RANGES and applies
appropriate text property to alter the syntax of template
delimiters < and >'s."
(goto-char beg)
@@ -284,9 +284,9 @@ is actually the parent of point at the moment of
indentation."
"Return the start of the previous named sibling of NODE.
This anchor handles the special case where the previous sibling
-is a labeled_statement, in that case, return the child of the
+is a labeled_statement; in that case, return the child of the
labeled statement instead. (Actually, recursively go down until
-the node isn't a labeled_statement.) Eg,
+the node isn't a labeled_statement.) E.g.,
label:
int x = 1;
@@ -295,10 +295,11 @@ label:
The anchor of \"int y = 2;\" should be \"int x = 1;\" rather than
the labeled_statement.
-Return nil if a) there is no prev-sibling, or 2) prev-sibling
+Return nil if a) there is no prev-sibling, or b) prev-sibling
doesn't have a child.
-PARENT and BOL are like other anchor functions."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(when-let ((prev-sibling
(or (treesit-node-prev-sibling node t)
(treesit-node-prev-sibling
@@ -336,7 +337,7 @@ PARENT and BOL are like other anchor functions."
(defun c-ts-mode--standalone-parent-skip-preproc (_n parent &rest _)
"Like the standalone-parent anchor but skips preproc nodes.
-PARENT is the same as other anchor functions."
+PARENT is the parent of the current node."
(save-excursion
(treesit-node-start
(treesit-parent-until
@@ -353,13 +354,15 @@ PARENT is the same as other anchor functions."
(defun c-ts-mode--standalone-grandparent (_node parent bol &rest args)
"Like the standalone-parent anchor but pass it the grandparent.
-PARENT, BOL, ARGS are the same as other anchor functions."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(apply (alist-get 'standalone-parent treesit-simple-indent-presets)
parent (treesit-node-parent parent) bol args))
(defun c-ts-mode--else-heuristic (node parent bol &rest _)
"Heuristic matcher for when \"else\" is followed by a closing bracket.
-NODE, PARENT, and BOL are the same as in other matchers."
+PARENT is NODE's parent, BOL is the beginning of non-whitespace
+characters of the current line."
(and (null node)
(save-excursion
(forward-line -1)
@@ -757,7 +760,7 @@ MODE is either `c' or `cpp'."
(defun c-ts-mode--declarator-identifier (node &optional qualified)
"Return the identifier of the declarator node NODE.
-If QUALIFIED is non-nil, include the names space part of the
+If QUALIFIED is non-nil, include the namespace part of the
identifier and return a qualified_identifier."
(pcase (treesit-node-type node)
;; Recurse.
@@ -782,7 +785,7 @@ identifier and return a qualified_identifier."
node)))
(defun c-ts-mode--fontify-declarator (node override start end &rest _args)
- "Fontify a declarator (whatever under the \"declarator\" field).
+ "Fontify a declarator (whatever is under the \"declarator\" field).
For NODE, OVERRIDE, START, END, and ARGS, see
`treesit-font-lock-rules'."
(let* ((identifier (c-ts-mode--declarator-identifier node))
@@ -817,7 +820,7 @@ For NODE, OVERRIDE, START, END, and ARGS, see
(defun c-ts-mode--fontify-variable (node override start end &rest _)
"Fontify an identifier node if it is a variable.
-Don't fontify if it is a function identifier. For NODE,
+Don't fontify it if it is a function identifier. For NODE,
OVERRIDE, START, END, and ARGS, see `treesit-font-lock-rules'."
(when (not (equal (treesit-node-type
(treesit-node-parent node))
@@ -911,7 +914,8 @@ Return nil if NODE is not a defun node or doesn't have a
name."
t))
((or "struct_specifier" "enum_specifier"
"union_specifier" "class_specifier"
- "namespace_definition")
+ "namespace_definition"
+ "preproc_def" "preproc_function_def")
(treesit-node-child-by-field-name node "name"))
;; DEFUNs in Emacs sources.
("expression_statement"
@@ -937,7 +941,7 @@ Return nil if NODE is not a defun node or doesn't have a
name."
(defun c-ts-mode--defun-valid-p (node)
"Return non-nil if NODE is a valid defun node.
-Ie, NODE is not nested."
+That is, NODE is not nested."
(let ((top-level-p (lambda (node)
(not (treesit-node-top-level
node (rx (or "function_definition"
@@ -976,8 +980,7 @@ Basically, if NODE is a class, return non-nil; if NODE is a
function but is under a class, return non-nil; if NODE is a
top-level function, return nil.
-This is for the Class subindex in
-`treesit-simple-imenu-settings'."
+This is for the Class subindex in `treesit-simple-imenu-settings'."
(pcase (treesit-node-type node)
;; The Class subindex only has class_specifier and
;; function_definition.
@@ -988,7 +991,7 @@ This is for the Class subindex in
(defun c-ts-mode--defun-skipper ()
"Custom defun skipper for `c-ts-mode' and friends.
-Structs in C ends with a semicolon, but the semicolon is not
+Structs in C end with a semicolon, but the semicolon is not
considered part of the struct node, so point would stop before
the semicolon. This function skips the semicolon."
(when (looking-at (rx (* (or " " "\t")) ";"))
@@ -1008,7 +1011,7 @@ the semicolon. This function skips the semicolon."
(list node parent bol)))
(defun c-ts-mode--emacs-defun-p (node)
- "Return non-nil if NODE is a Lisp function defined using DEFUN.
+ "Return non-nil if NODE is a Lisp function defined via DEFUN.
This function detects Lisp primitives defined in Emacs source
files using the DEFUN macro."
(and (equal (treesit-node-type node) "expression_statement")
@@ -1029,15 +1032,15 @@ files using the DEFUN macro."
"Return the defun node at point.
In addition to regular C functions, this function recognizes
-definitions of Lisp primitrives in Emacs source files using DEFUN,
-if `c-ts-mode-emacs-sources-support' is non-nil.
+definitions of Lisp primitrives in Emacs source files defined
+via DEFUN, if `c-ts-mode-emacs-sources-support' is non-nil.
Note that DEFUN is parsed by tree-sitter as two separate
nodes, one for the declaration and one for the body; this
function returns the declaration node.
If RANGE is non-nil, return (BEG . END) where BEG end END
-encloses the whole defun. This is for when the entire defun
+enclose the whole defun. This is for when the entire defun
is required, not just the declaration part for DEFUN."
(when-let* ((node (treesit-defun-at-point))
(defun-range (cons (treesit-node-start node)
@@ -1066,7 +1069,7 @@ is required, not just the declaration part for DEFUN."
"Return the name of the current defun.
This is used for `add-log-current-defun-function'.
In addition to regular C functions, this function also recognizes
-Emacs primitives defined using DEFUN in Emacs sources,
+Emacs primitives defined via DEFUN in Emacs sources,
if `c-ts-mode-emacs-sources-support' is non-nil."
(or (treesit-add-log-current-defun)
(c-ts-mode--defun-name (c-ts-mode--emacs-defun-at-point))))
@@ -1144,7 +1147,7 @@ For BOL see `treesit-simple-indent-rules'."
(defun c-ts-mode--reverse-ranges (ranges beg end)
"Reverse RANGES and return the new ranges between BEG and END.
-Positions that were included RANGES are not in the returned
+Positions that were included in RANGES are not in the returned
ranges, and vice versa.
Return nil if RANGES is nil. This way, passing the returned
@@ -1205,7 +1208,9 @@ BEG and END are described in `treesit-range-rules'."
"enum_specifier"
"union_specifier"
"class_specifier"
- "namespace_definition")
+ "namespace_definition"
+ "preproc_def"
+ "preproc_function_def")
(and c-ts-mode-emacs-sources-support
'(;; DEFUN.
"expression_statement"
@@ -1284,7 +1289,7 @@ BEG and END are described in `treesit-range-rules'."
This mode is independent from the classic cc-mode.el based
`c-mode', so configuration variables of that mode, like
-`c-basic-offset', doesn't affect this mode.
+`c-basic-offset', don't affect this mode.
To use tree-sitter C/C++ modes by default, evaluate
@@ -1293,7 +1298,7 @@ To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
-in your configuration."
+in your init files."
:group 'c
:after-hook (c-ts-mode-set-modeline)
@@ -1345,7 +1350,7 @@ To use tree-sitter C/C++ modes by default, evaluate
(add-to-list \\='major-mode-remap-alist
\\='(c-or-c++-mode . c-or-c++-ts-mode))
-in your configuration.
+in your init files.
Since this mode uses a parser, unbalanced brackets might cause
some breakage in indentation/fontification. Therefore, it's
@@ -1440,7 +1445,7 @@ matching on file name insufficient for detecting major
mode that
should be used.
This function attempts to use file contents to determine whether
-the code is C or C++ and based on that chooses whether to enable
+the code is C or C++, and based on that chooses whether to enable
`c-ts-mode' or `c++-ts-mode'."
(declare (obsolete c-or-c++-mode "30.1"))
(interactive)
diff --git a/lisp/progmodes/csharp-mode.el b/lisp/progmodes/csharp-mode.el
index 18114d08528..9782eb443f2 100644
--- a/lisp/progmodes/csharp-mode.el
+++ b/lisp/progmodes/csharp-mode.el
@@ -495,9 +495,12 @@ compilation and evaluation time conflicts."
(unless (eq (char-after) ?{)
(ignore-errors (backward-up-list 1 t t)))
(save-excursion
- ;; 'new' should be part of the line
+ ;; 'new' should be part of the line, but should not trigger if
+ ;; statement has already ended, like for 'var x = new X();'.
+ ;; Also, deal with the possible end of line obscured by a
+ ;; trailing comment.
(goto-char (c-point 'iopl))
- (looking-at ".*new.*")))
+ (looking-at "^[^//]*new[^//]*;$")))
;; Line should not already be terminated
(save-excursion
(goto-char (c-point 'eopl))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index afe3281361d..7d2f1a55165 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -238,7 +238,8 @@ automatically)."
(vimrc-mode . ("vim-language-server" "--stdio"))
((python-mode python-ts-mode)
. ,(eglot-alternatives
- '("pylsp" "pyls" ("pyright-langserver" "--stdio")
+ '("pylsp" "pyls" ("basedpyright-langserver" "--stdio")
+ ("pyright-langserver" "--stdio")
"jedi-language-server" "ruff-lsp")))
((js-json-mode json-mode json-ts-mode)
. ,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
@@ -294,6 +295,8 @@ automatically)."
(nickel-mode . ("nls"))
((nushell-mode nushell-ts-mode) . ("nu" "--lsp"))
(gdscript-mode . ("localhost" 6008))
+ (fennel-mode . ("fennel-ls"))
+ (move-mode . ("move-analyzer"))
((fortran-mode f90-mode) . ("fortls"))
(futhark-mode . ("futhark" "lsp"))
((lua-mode lua-ts-mode) . ,(eglot-alternatives
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index 217b2ab6691..7bed69a738b 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -631,7 +631,7 @@ Needs additional info stored in global
`idlwave-completion-help-info'."
Those words in `idlwave-completion-help-links' have links. The
`idlwave-help-link' face is used for this."
(if idlwave-highlight-help-links-in-completion
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(save-excursion
(let* ((case-fold-search t)
(props (list 'face 'idlwave-help-link))
diff --git a/lisp/progmodes/lua-ts-mode.el b/lisp/progmodes/lua-ts-mode.el
index 25fd7792f42..407ef230c32 100644
--- a/lisp/progmodes/lua-ts-mode.el
+++ b/lisp/progmodes/lua-ts-mode.el
@@ -60,66 +60,56 @@
:options '(flymake-mode
hs-minor-mode
outline-minor-mode)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-indent-offset 4
"Number of spaces for each indentation step in `lua-ts-mode'."
:type 'natnum
:safe 'natnump
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-luacheck-program "luacheck"
"Location of the Luacheck program."
:type '(choice (const :tag "None" nil) string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-buffer "*Lua*"
"Name of the inferior Lua buffer."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-program "lua"
"Program to run in the inferior Lua process."
:type '(choice (const :tag "None" nil) string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-options '("-i")
"Command line options for the inferior Lua process."
:type '(repeat string)
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-startfile nil
"File to load into the inferior Lua process at startup."
:type '(choice (const :tag "None" nil) (file :must-match t))
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-prompt ">"
"Prompt used by the inferior Lua process."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-prompt-continue ">>"
"Continuation prompt used by the inferior Lua process."
:type 'string
:safe 'stringp
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-inferior-history nil
"File used to save command history of the inferior Lua process."
:type '(choice (const :tag "None" nil) file)
:safe 'string-or-null-p
- :group 'lua-ts
:version "30.1")
(defcustom lua-ts-indent-continuation-lines t
@@ -141,7 +131,6 @@ the statement:
end"
:type 'boolean
:safe 'booleanp
- :group 'lua-ts
:version "30.1")
(defvar lua-ts--builtins
@@ -628,7 +617,7 @@ Calls REPORT-FN directly."
nil t)))
(select-window (display-buffer lua-ts-inferior-buffer
'((display-buffer-reuse-window
- display-buffer-pop-up-frame)
+ display-buffer-pop-up-window)
(reusable-frames . t))))
(get-buffer-process (current-buffer)))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 9622b1b6768..ac18aceadcf 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -602,7 +602,7 @@ See `project-vc-extra-root-markers' for the marker value
format.")
(goto-char (point-min))
;; Kind of a hack to distinguish a submodule from
;; other cases of .git files pointing elsewhere.
- (looking-at "gitdir: [./]+/\\.git/modules/"))
+ (looking-at "gitdir: .+/\\.git/\\(worktrees/.*\\)?modules/"))
t)
(t nil))))
@@ -808,8 +808,10 @@ DIRS must contain directory names."
(with-temp-buffer
(setq default-directory dir)
(let ((enable-local-variables :all))
- (hack-dir-local-variables-non-file-buffer))
- (symbol-value var)))
+ (hack-dir-local-variables))
+ ;; Don't use `hack-local-variables-apply' to avoid setting modes.
+ (alist-get var file-local-variables-alist
+ (symbol-value var))))
(cl-defmethod project-buffers ((project (head vc)))
(let* ((root (expand-file-name (file-name-as-directory (project-root
project))))
@@ -2140,12 +2142,10 @@ is part of the default mode line beginning with Emacs
30."
:group 'project
:version "30.1")
-(defvar project-menu-entry
- `(menu-item "Project" ,(bound-and-true-p menu-bar-project-menu)))
-
(defvar project-mode-line-map
(let ((map (make-sparse-keymap)))
- (define-key map [mode-line down-mouse-1] project-menu-entry)
+ (define-key map [mode-line down-mouse-1]
+ (bound-and-true-p menu-bar-project-item))
map))
(defvar project-mode-line-face nil
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 1016655cb62..8279617b6e7 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3601,6 +3601,7 @@ The coding cookie regexp is specified in PEP 263.")
(python-shell-send-string-no-output
python-shell-eval-file-setup-code))
(with-current-buffer (current-buffer)
(let ((inhibit-quit nil))
+ (python-shell-readline-detect)
(run-hooks 'python-shell-first-prompt-hook))))))
output)
@@ -4361,7 +4362,23 @@ When a match is found, native completion is disabled."
(defvar python-shell-readline-completer-delims nil
"Word delimiters used by the readline completer.
-It is automatically set by Python shell.")
+It is automatically set by Python shell. An empty string means no
+characters are considered delimiters and the readline completion
+considers the entire line of input. A value of nil means the Python
+shell has no readline support.")
+
+(defun python-shell-readline-detect ()
+ "Detect the readline support for Python shell completion."
+ (let* ((process (python-shell-get-process))
+ (output (python-shell-send-string-no-output "
+try:
+ import readline
+ print(readline.get_completer_delims())
+except:
+ print('No readline support')" process)))
+ (setq-local python-shell-readline-completer-delims
+ (unless (string-search "No readline support" output)
+ (string-trim-right output)))))
(defvar python-shell-completion-native-redirect-buffer
" *Python completions redirect*"
@@ -4501,10 +4518,6 @@ def __PYTHON_EL_native_completion_setup():
__PYTHON_EL_native_completion_setup()" process)))
(when (string-match-p "python\\.el: native completion setup loaded"
output)
- (setq-local python-shell-readline-completer-delims
- (string-trim-right
- (python-shell-send-string-no-output
- "import readline;
print(readline.get_completer_delims())")))
(python-shell-completion-native-try))))
(defun python-shell-completion-native-turn-off (&optional msg)
@@ -4533,7 +4546,8 @@ With argument MSG show activation/deactivation message."
(cond
((python-shell-completion-native-interpreter-disabled-p)
(python-shell-completion-native-turn-off msg))
- ((python-shell-completion-native-setup)
+ ((and python-shell-readline-completer-delims
+ (python-shell-completion-native-setup))
(when msg
(message "Shell native completion is enabled.")))
(t
@@ -4705,7 +4719,8 @@ using that one instead of current buffer's process."
(with-current-buffer (process-buffer process)
(if python-shell-completion-native-enable
(string= python-shell-readline-completer-delims "")
- (string-match-p "ipython[23]?\\'"
python-shell-interpreter)))))
+ (or (string-match-p "ipython[23]?\\'"
python-shell-interpreter)
+ (equal python-shell-readline-completer-delims ""))))))
(start
(if (< (point) line-start)
(point)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 7af78f2229a..a83bad0e8ed 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -5803,7 +5803,7 @@ FILENAME to find directory to run in, or defaults to
`buffer-file-name'."
(dir (file-name-directory (or filename buffer-file-name)))
(cmd (concat "cd " dir "; " command)))
(with-output-to-temp-buffer "*Verilog-Preprocessed*"
- (with-current-buffer (get-buffer "*Verilog-Preprocessed*")
+ (with-current-buffer "*Verilog-Preprocessed*"
(insert (concat "// " cmd "\n"))
(call-process shell-file-name nil t nil shell-command-switch cmd)
(verilog-mode)
diff --git a/lisp/replace.el b/lisp/replace.el
index 49e7c85c487..01a892bbba7 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -1931,7 +1931,7 @@ See also `multi-occur'."
(lambda (boo)
(buffer-name (if (overlayp boo) (overlay-buffer boo)
boo)))
active-bufs))
- (with-current-buffer (get-buffer buf-name)
+ (with-current-buffer buf-name
(rename-uniquely)))
;; Now find or create the output buffer.
diff --git a/lisp/simple.el b/lisp/simple.el
index f127290231b..0645f18cc78 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -10298,6 +10298,8 @@ Called from `temp-buffer-show-hook'."
:version "22.1"
:group 'completion)
+(defvar minibuffer-visible-completions--always-bind)
+
;; This function goes in completion-setup-hook, so that it is called
;; after the text of the completion list buffer is written.
(defun completion-setup-function ()
@@ -10338,15 +10340,16 @@ Called from `temp-buffer-show-hook'."
(if minibuffer-visible-completions
(let ((helps
(with-current-buffer (window-buffer
(active-minibuffer-window))
- (list
- (substitute-command-keys
- (if (display-mouse-p)
- "Click or type
\\[minibuffer-choose-completion-or-exit] on a completion to select it.\n"
- "Type \\[minibuffer-choose-completion-or-exit] on a
completion to select it.\n"))
- (substitute-command-keys
- "Type \\[minibuffer-next-completion],
\\[minibuffer-previous-completion], \
+ (let ((minibuffer-visible-completions--always-bind t))
+ (list
+ (substitute-command-keys
+ (if (display-mouse-p)
+ "Click or type
\\[minibuffer-choose-completion-or-exit] on a completion to select it.\n"
+ "Type \\[minibuffer-choose-completion-or-exit] on a
completion to select it.\n"))
+ (substitute-command-keys
+ "Type \\[minibuffer-next-completion],
\\[minibuffer-previous-completion], \
\\[minibuffer-next-line-completion], \\[minibuffer-previous-line-completion] \
-to move point between completions.\n\n")))))
+to move point between completions.\n\n"))))))
(dolist (help helps)
(insert help)))
(insert (substitute-command-keys
diff --git a/lisp/sqlite.el b/lisp/sqlite.el
index 46e35ac18d8..efc5997fb5c 100644
--- a/lisp/sqlite.el
+++ b/lisp/sqlite.el
@@ -32,7 +32,8 @@
If BODY completes normally, commit the changes and return
the value of BODY.
If BODY signals an error, or transaction commit fails, roll
-back the transaction changes."
+back the transaction changes before allowing the signal to
+propagate."
(declare (indent 1) (debug (form body)))
(let ((db-var (gensym))
(func-var (gensym))
@@ -48,8 +49,8 @@ back the transaction changes."
(setq ,res-var (funcall ,func-var))
(setq ,commit-var (sqlite-commit ,db-var))
,res-var)
- (or ,commit-var (sqlite-rollback ,db-var))))
- (funcall ,func-var))))
+ (or ,commit-var (sqlite-rollback ,db-var)))
+ (funcall ,func-var)))))
(provide 'sqlite)
diff --git a/lisp/subr.el b/lisp/subr.el
index 5ccaf17e73c..e80812233b6 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -312,11 +312,20 @@ value of last one, or nil if there are none."
cond '(empty-body unless) t)))
(defsubst subr-primitive-p (object)
- "Return t if OBJECT is a built-in primitive function."
+ "Return t if OBJECT is a built-in primitive written in C.
+Such objects can be functions or special forms."
(declare (side-effect-free error-free))
(and (subrp object)
(not (subr-native-elisp-p object))))
+(defsubst primitive-function-p (object)
+ "Return t if OBJECT is a built-in primitive function.
+This excludes special forms, since they are not functions."
+ (declare (side-effect-free error-free))
+ (and (subrp object)
+ (not (or (subr-native-elisp-p object)
+ (eq (cdr (subr-arity object)) 'unevalled)))))
+
(defsubst xor (cond1 cond2)
"Return the boolean exclusive-or of COND1 and COND2.
If only one of the arguments is non-nil, return it; otherwise
@@ -4494,8 +4503,7 @@ Otherwise, return nil."
(defun special-form-p (object)
"Non-nil if and only if OBJECT is a special form."
(declare (side-effect-free error-free))
- (if (and (symbolp object) (fboundp object))
- (setq object (indirect-function object)))
+ (if (symbolp object) (setq object (indirect-function object)))
(and (subrp object) (eq (cdr (subr-arity object)) 'unevalled)))
(defun plistp (object)
@@ -4517,7 +4525,8 @@ Otherwise, return nil."
Does not distinguish between functions implemented in machine code
or byte-code."
(declare (side-effect-free error-free))
- (or (subrp object) (byte-code-function-p object)))
+ (or (and (subrp object) (not (eq 'unevalled (cdr (subr-arity object)))))
+ (byte-code-function-p object)))
(defun field-at-pos (pos)
"Return the field at position POS, taking stickiness etc into account."
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 61efa332e0b..fa22500a04e 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -1393,6 +1393,55 @@ and the newly selected tab."
:group 'tab-bar
:version "30.1")
+(defcustom tab-bar-select-restore-windows #'tab-bar-select-restore-windows
+ "Function called when selecting a tab to handle windows whose buffer was
killed.
+When a tab-bar tab displays a window whose buffer was killed since
+this tab was last selected, this function determines what to do with
+that window. By default, either a random buffer is displayed instead of
+the killed buffer, or the window gets deleted. However, with the help
+of `window-restore-killed-buffer-windows' it's possible to handle such
+situations better by displaying an information about the killed buffer."
+ :type '(choice (const :tag "No special handling" nil)
+ (const :tag "Show placeholder buffers"
+ tab-bar-select-restore-windows)
+ (function :tag "Function"))
+ :group 'tab-bar
+ :version "30.1")
+
+(defun tab-bar-select-restore-windows (_frame windows _type)
+ "Display a placeholder buffer in the window whose buffer was killed.
+A button in the window allows to restore the killed buffer,
+if it was visiting a file."
+ (dolist (quad windows)
+ (when (window-live-p (nth 0 quad))
+ (let* ((window (nth 0 quad))
+ (old-buffer (nth 1 quad))
+ (file (when (bufferp old-buffer)
+ (buffer-file-name old-buffer)))
+ (name (or file
+ (and (bufferp old-buffer)
+ (fboundp 'buffer-last-name)
+ (buffer-last-name old-buffer))
+ old-buffer))
+ (new-buffer (generate-new-buffer
+ (format "*Old buffer %s*" name))))
+ (with-current-buffer new-buffer
+ (set-auto-mode)
+ (insert (format-message "This window displayed the %s `%s'.\n"
+ (if file "file" "buffer")
+ name))
+ (when file
+ (insert-button
+ "[Restore]" 'action
+ (lambda (_button)
+ (set-window-buffer window (find-file-noselect file))
+ (set-window-start window (nth 2 quad) t)
+ (set-window-point window (nth 3 quad))))
+ (insert "\n"))
+ (goto-char (point-min))
+ (setq buffer-read-only t)
+ (set-window-buffer window new-buffer))))))
+
(defvar tab-bar-minibuffer-restore-tab nil
"Tab number for `tab-bar-minibuffer-restore-tab'.")
@@ -1438,7 +1487,10 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(let* ((from-tab (tab-bar--tab))
(to-tab (nth to-index tabs))
(wc (alist-get 'wc to-tab))
- (ws (alist-get 'ws to-tab)))
+ (ws (alist-get 'ws to-tab))
+ (window-restore-killed-buffer-windows
+ (or tab-bar-select-restore-windows
+ window-restore-killed-buffer-windows)))
;; During the same session, use window-configuration to switch
;; tabs, because window-configurations are more reliable
diff --git a/lisp/term.el b/lisp/term.el
index 2ce0c2b5e79..c15f6cf2e9f 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -658,7 +658,8 @@ executed once, when the buffer is created."
["Forward Output Group" term-next-prompt t]
["Kill Current Output Group" term-kill-output t]))
map)
- "Keymap for Term mode.")
+ "Keymap for \"line mode\" in Term mode. For custom keybindings purposes
+please note there is also `term-raw-map'")
(defvar term-escape-char nil
"Escape character for char sub-mode of term mode.
@@ -961,7 +962,9 @@ underlying shell."
(dotimes (key 21)
(keymap-set map (format "<f%d>" key) #'term-send-function-key)))
map)
- "Keyboard map for sending characters directly to the inferior process.")
+ "Keyboard map for sending characters directly to the inferior process.
+For custom keybindings purposes please note there is also
+`term-mode-map'")
(easy-menu-define term-terminal-menu
(list term-mode-map term-raw-map term-pager-break-map)
@@ -1122,6 +1125,10 @@ particular subprocesses. This can be done by setting
the hooks
and the variable `term-prompt-regexp' to the appropriate regular
expression.
+If you define custom keybindings, make sure to assign them to the
+correct keymap (or to both): use `term-raw-map' in raw mode and
+`term-mode-map' in line mode.
+
Commands in raw mode:
\\{term-raw-map}
@@ -4342,7 +4349,7 @@ Typing SPC flushes the help buffer."
(display-completion-list (sort completions 'string-lessp)))
(message "Hit space to flush")
(let (key first)
- (if (with-current-buffer (get-buffer "*Completions*")
+ (if (with-current-buffer "*Completions*"
(setq key (read-key-sequence nil)
first (aref key 0))
(and (consp first)
diff --git a/lisp/term/android-win.el b/lisp/term/android-win.el
index 1d10402b15d..6512ef81ff7 100644
--- a/lisp/term/android-win.el
+++ b/lisp/term/android-win.el
@@ -282,11 +282,12 @@ If it reflects the motion of an item above a frame, call
`dnd-handle-movement' to move the cursor or scroll the window
under the item pursuant to the pertinent user options.
-If it reflects dropped text, insert such text within window at
-the location of the drop.
+If it holds dropped text, insert such text within window at the
+location of the drop.
-If it reflects a list of URIs, then open each URI, converting
-content:// URIs into the special file names which represent them."
+If it holds a list of URIs, or file names, then open each URI or
+file name, converting content:// URIs into the special file
+names which represent them."
(interactive "e")
(let ((message (caddr event))
(posn (event-start event)))
@@ -304,18 +305,22 @@ content:// URIs into the special file names which
represent them."
(new-uri-list nil)
(dnd-unescape-file-uris t))
(dolist (uri uri-list)
- (ignore-errors
- (let ((url (url-generic-parse-url uri)))
- (when (equal (url-type url) "content")
- ;; Replace URI with a matching /content file
- ;; name.
- (setq uri (format "file:/content/by-authority/%s%s"
- (url-host url)
- (url-filename url))
- ;; And guarantee that this file URI is not
- ;; subject to URI decoding, for it must be
- ;; transformed back into a content URI.
- dnd-unescape-file-uris nil))))
+ ;; If the URI is a preprepared file name, insert it directly.
+ (if (string-match-p "^/content/by-authority\\(-named\\)?/" uri)
+ (setq uri (concat "file:" uri)
+ dnd-unescape-file-uris nil)
+ (ignore-errors
+ (let ((url (url-generic-parse-url uri)))
+ (when (equal (url-type url) "content")
+ ;; Replace URI with a matching /content file
+ ;; name.
+ (setq uri (format "file:/content/by-authority/%s%s"
+ (url-host url)
+ (url-filename url))
+ ;; And guarantee that this file URI is not
+ ;; subject to URI decoding, for it must be
+ ;; transformed back into a content URI.
+ dnd-unescape-file-uris nil)))))
(push uri new-uri-list))
(dnd-handle-multiple-urls (posn-window posn)
new-uri-list
@@ -524,5 +529,94 @@ accessible to other programs."
(android-browse-url-internal url send))
+;; Coding systems used by androidvfs.c.
+
+(define-ccl-program android-encode-jni
+ `(2 ((loop
+ (read r0)
+ (if (r0 < #x1) ; 0x0 is encoded specially in JNI environments.
+ ((write #xc0)
+ (write #x80))
+ ((if (r0 < #x80) ; ASCII
+ ((write r0))
+ (if (r0 < #x800) ; \u0080 - \u07ff
+ ((write ((r0 >> 6) | #xC0))
+ (write ((r0 & #x3F) | #x80)))
+ ;; \u0800 - \uFFFF
+ (if (r0 < #x10000)
+ ((write ((r0 >> 12) | #xE0))
+ (write (((r0 >> 6) & #x3F) | #x80))
+ (write ((r0 & #x3F) | #x80)))
+ ;; Supplementary characters must be converted into
+ ;; surrogate pairs before encoding.
+ (;; High surrogate
+ (r1 = ((((r0 - #x10000) >> 10) & #x3ff) + #xD800))
+ ;; Low surrogate.
+ (r2 = (((r0 - #x10000) & #x3ff) + #xDC00))
+ ;; Write both surrogate characters.
+ (write ((r1 >> 12) | #xE0))
+ (write (((r1 >> 6) & #x3F) | #x80))
+ (write ((r1 & #x3F) | #x80))
+ (write ((r2 >> 12) | #xE0))
+ (write (((r2 >> 6) & #x3F) | #x80))
+ (write ((r2 & #x3F) | #x80))))))))
+ (repeat))))
+ "Encode characters from the input buffer for Java virtual machines.")
+
+(define-ccl-program android-decode-jni
+ `(1 ((loop
+ ((read-if (r0 >= #x80) ; More than a one-byte sequence?
+ ((if (r0 < #xe0)
+ ;; Two-byte sequence; potentially a NULL
+ ;; character.
+ ((read r4)
+ (r4 &= #x3f)
+ (r0 = (((r0 & #x1f) << 6) | r4)))
+ (if (r0 < ?\xF0)
+ ;; Three-byte sequence, after which surrogate
+ ;; pairs should be processed.
+ ((read r4 r6)
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3f)
+ (r0 = ((((r0 & #xf) << 12) | r4) | r6)))
+ ;; Four-byte sequences are not valid under the
+ ;; JVM specification, but Android produces them
+ ;; when encoding Emoji characters for being
+ ;; supposedly less of a surprise to applications.
+ ;; This is obviously not true of programs written
+ ;; to the letter of the documentation, but 50
+ ;; million Frenchmen make a right (and this
+ ;; deviation from the norm is predictably absent
+ ;; from Android's documentation on the subject).
+ ((read r1 r4 r6)
+ (r1 = ((r1 & #x3f) << 12))
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3F)
+ (r0 = (((((r0 & #x07) << 18) | r1) | r4) | r6))))))))
+ (if ((r0 & #xf800) == #xd800)
+ ;; High surrogate.
+ ((read-if (r2 >= #xe0)
+ ((r0 = ((r0 & #x3ff) << 10))
+ (read r4 r6)
+ (r4 = ((r4 & #x3f) << 6))
+ (r6 &= #x3f)
+ (r1 = ((((r2 & #xf) << 12) | r4) | r6))
+ (r0 = (((r1 & #x3ff) | r0) + #xffff))))))
+ (write r0)
+ (repeat))))
+ "Decode JVM-encoded characters in the input buffer.")
+
+(define-coding-system 'android-jni
+ "CESU-8 based encoding for communication with the Android runtime."
+ :mnemonic ?J
+ :coding-type 'ccl
+ :eol-type 'unix
+ :ascii-compatible-p nil ; for \0 is encoded as a two-byte sequence.
+ :default-char ?\0
+ :charset-list '(unicode)
+ :ccl-decoder 'android-decode-jni
+ :ccl-encoder 'android-encode-jni)
+
+
(provide 'android-win)
;; android-win.el ends here.
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index a8e2f03bd70..a6da34d6a41 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1012,7 +1012,7 @@ if `bibtex-BibTeX-entry-alist' does not define a comment
for FIELD."
("volumes" "Total number of volumes of a multi-volume work")
("year" "Year of publication"))
"Alist of biblatex fields.
-It has the same format as `bibtex-BibTeX-entry-alist'."
+It has the same format as `bibtex-BibTeX-field-alist'."
:group 'bibtex
:version "28.1"
:type 'bibtex-field-alist)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index de59294e9f0..09d4e8a8d1a 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -288,6 +288,15 @@ If this variable is nil, all regions are treated as small."
"The key binding for flyspell auto correction."
:type 'key-sequence)
+(defcustom flyspell-check-changes nil
+ "If non-nil, spell-check only words that were edited.
+By default, this is nil, and Flyspell checks every word across which
+you move point, even if you haven't edited the word. Customizing this
+option to a non-nil value will not flag mis-spelled words across which
+you move point without editing them."
+ :type 'boolean
+ :version "30.1")
+
;;*---------------------------------------------------------------------*/
;;* Mode specific options */
;;* ------------------------------------------------------------- */
@@ -610,7 +619,9 @@ are both non-nil."
(flyspell-accept-buffer-local-defs 'force)
(flyspell-delay-commands)
(flyspell-deplacement-commands)
- (add-hook 'post-command-hook (function flyspell-post-command-hook) t t)
+ (if flyspell-check-changes
+ (add-hook 'post-command-hook (function flyspell-check-changes) t t)
+ (add-hook 'post-command-hook (function flyspell-post-command-hook) t t))
(add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t)
(add-hook 'after-change-functions 'flyspell-after-change-function nil t)
(add-hook 'hack-local-variables-hook
@@ -709,6 +720,7 @@ has been used, the current word is not checked."
;;;###autoload
(defun flyspell--mode-off ()
"Turn Flyspell mode off."
+ (remove-hook 'post-command-hook (function flyspell-check-changes) t)
(remove-hook 'post-command-hook (function flyspell-post-command-hook) t)
(remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t)
(remove-hook 'after-change-functions 'flyspell-after-change-function t)
@@ -990,6 +1002,23 @@ Mostly we check word delimiters."
(setq flyspell-changes (cdr flyspell-changes))))
(setq flyspell-previous-command command)))))
+(defun flyspell-check-changes ()
+ "Function to spell-check only edited words when point moves off the word.
+This is installed by flyspell as `post-command-hook' when the user
+option `flyspell-check-changes' is non-nil. It spell-checks a word
+on moving point from the word only if the word was edited before the move."
+ (when flyspell-mode
+ (with-local-quit
+ (when (consp flyspell-changes)
+ (let ((start (car (car flyspell-changes)))
+ (stop (cdr (car flyspell-changes)))
+ (word (save-excursion (flyspell-get-word))))
+ (unless (and word (<= (nth 1 word) start) (>= (nth 2 word) stop))
+ (save-excursion
+ (goto-char start)
+ (flyspell-word))
+ (setq flyspell-changes nil)))))))
+
;;*---------------------------------------------------------------------*/
;;* flyspell-notify-misspell ... */
;;*---------------------------------------------------------------------*/
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 83ddc640d35..7896ad984df 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -735,20 +735,33 @@ Signal an error if the entire string was not used."
(let ((thing (thing-at-point 'symbol)))
(if thing (intern thing))))
+(defvar thing-at-point-decimal-regexp
+ "-?[0-9]+\\.?[0-9]*"
+ "A regexp matching a decimal number.")
+
+(defvar thing-at-point-hexadecimal-regexp
+ "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)"
+ "A regexp matchin a hexadecimal number.")
+
;;;###autoload
(defun number-at-point ()
"Return the number at point, or nil if none is found.
Decimal numbers like \"14\" or \"-14.5\", as well as hex numbers
like \"0xBEEF09\" or \"#xBEEF09\", are recognized."
(cond
- ((thing-at-point-looking-at "\\(0x\\|#x\\)\\([a-fA-F0-9]+\\)" 500)
+ ((thing-at-point-looking-at thing-at-point-hexadecimal-regexp 500)
(string-to-number
(buffer-substring (match-beginning 2) (match-end 2))
16))
- ((thing-at-point-looking-at "-?[0-9]+\\.?[0-9]*" 500)
+ ((thing-at-point-looking-at thing-at-point-decimal-regexp 500)
(string-to-number
(buffer-substring (match-beginning 0) (match-end 0))))))
+(put 'number 'bounds-of-thing-at-point
+ (lambda ()
+ (and (or (thing-at-point-looking-at thing-at-point-hexadecimal-regexp
500)
+ (thing-at-point-looking-at thing-at-point-decimal-regexp 500))
+ (cons (match-beginning 0) (match-end 0)))))
(put 'number 'forward-op 'forward-word)
(put 'number 'thing-at-point 'number-at-point)
diff --git a/lisp/time.el b/lisp/time.el
index 9b932e945ba..a8d3ab9c813 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -611,7 +611,7 @@ To turn off the world time display, go to the window and
type \\[quit-window]."
(defun world-clock-update (&optional _arg _noconfirm)
"Update the `world-clock' buffer."
(if (get-buffer world-clock-buffer-name)
- (with-current-buffer (get-buffer world-clock-buffer-name)
+ (with-current-buffer world-clock-buffer-name
(let ((op (point)))
(world-clock-display (time--display-world-list))
(goto-char op)))
diff --git a/lisp/transient.el b/lisp/transient.el
index 8cc7cd9b2a9..fad7afb892f 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -5,7 +5,7 @@
;; Author: Jonas Bernoulli <jonas@bernoul.li>
;; URL: https://github.com/magit/transient
;; Keywords: extensions
-;; Version: 0.5.2
+;; Version: 0.6.0
;; SPDX-License-Identifier: GPL-3.0-or-later
@@ -93,17 +93,20 @@ enclosed in a `progn' form. ELSE-FORMS may be empty."
then-form
(cons 'progn else-forms)))
-(defmacro transient--with-emergency-exit (&rest body)
+(defmacro transient--with-emergency-exit (id &rest body)
(declare (indent defun))
+ (unless (keywordp id)
+ (setq body (cons id body))
+ (setq id nil))
`(condition-case err
(let ((debugger #'transient--exit-and-debug))
,(macroexp-progn body))
((debug error)
- (transient--emergency-exit)
+ (transient--emergency-exit ,id)
(signal (car err) (cdr err)))))
(defun transient--exit-and-debug (&rest args)
- (transient--emergency-exit)
+ (transient--emergency-exit :debugger)
(apply #'debug args))
;;; Options
@@ -668,6 +671,7 @@ If `transient-save-history' is nil, then do nothing."
(incompatible :initarg :incompatible :initform nil)
(suffix-description :initarg :suffix-description)
(variable-pitch :initarg :variable-pitch :initform nil)
+ (column-widths :initarg :column-widths :initform nil)
(unwind-suffix :documentation "Internal use." :initform nil))
"Transient prefix command.
@@ -725,7 +729,8 @@ slot is non-nil."
:abstract t)
(defclass transient-suffix (transient-child)
- ((key :initarg :key)
+ ((definition :allocation :class :initform nil)
+ (key :initarg :key)
(command :initarg :command)
(transient :initarg :transient)
(format :initarg :format :initform " %k %d")
@@ -948,7 +953,10 @@ ARGLIST. The infix arguments are usually accessed by using
(pcase-let ((`(,class ,slots ,_ ,docstr ,body)
(transient--expand-define-args args arglist)))
`(progn
- (defalias ',name (lambda ,arglist ,@body))
+ (defalias ',name
+ ,(if (and (not body) class (oref-default class definition))
+ `(oref-default ',class definition)
+ `(lambda ,arglist ,@body)))
(put ',name 'interactive-only t)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
@@ -1000,7 +1008,7 @@ keyword.
`(progn
(defalias ',name #'transient--default-infix-command)
(put ',name 'interactive-only t)
- (put ',name 'command-modes (list 'not-a-mode))
+ (put ',name 'completion-predicate #'transient--suffix-only)
(put ',name 'function-documentation ,docstr)
(put ',name 'transient--suffix
(,(or class 'transient-switch) :command ',name ,@slots)))))
@@ -1016,21 +1024,39 @@ example, sets a variable, use `transient-define-infix'
instead.
(defun transient--default-infix-command ()
;; Most infix commands are but an alias for this command.
- "Cannot show any documentation for this anonymous infix command.
+ "Cannot show any documentation for this transient infix command.
+
+When you request help for an infix command using `transient-help', that
+usually shows the respective man-page and tries to jump to the location
+where the respective argument is being described.
-This infix command was defined anonymously, i.e., it was define
-inside a call to `transient-define-prefix'.
+If no man-page is specified for the containing transient menu, then the
+docstring is displayed instead, if any.
-When you request help for such an infix command, then we usually
-show the respective man-page and jump to the location where the
-respective argument is being described. This isn't possible in
-this case, because the `man-page' slot was not set in this case."
+If the infix command doesn't have a docstring, as is the case here, then
+this docstring is displayed instead, because technically infix commands
+are aliases for `transient--default-infix-command'.
+
+`describe-function' also shows the docstring of the infix command,
+falling back to that of the same aliased command."
(interactive)
(let ((obj (transient-suffix-object)))
(transient-infix-set obj (transient-infix-read obj)))
(transient--show))
(put 'transient--default-infix-command 'interactive-only t)
-(put 'transient--default-infix-command 'command-modes (list 'not-a-mode))
+(put 'transient--default-infix-command 'completion-predicate
+ #'transient--suffix-only)
+
+(defun transient--find-function-advised-original (fn func)
+ "Return nil instead of `transient--default-infix-command'.
+When using `find-function' to jump to the definition of a transient
+infix command/argument, then we want to actually jump to that, not to
+the definition of `transient--default-infix-command', which all infix
+commands are aliases for."
+ (let ((val (funcall fn func)))
+ (and val (not (eq val 'transient--default-infix-command)) val)))
+(advice-add 'find-function-advised-original :around
+ #'transient--find-function-advised-original)
(eval-and-compile
(defun transient--expand-define-args (args &optional arglist)
@@ -1059,7 +1085,8 @@ this case, because the `man-page' slot was not set in
this case."
args))))
(defun transient--parse-child (prefix spec)
- (cl-etypecase spec
+ (cl-typecase spec
+ (null (error "Invalid transient--parse-child spec: %s" spec))
(symbol (let ((value (symbol-value spec)))
(if (and (listp value)
(or (listp (car value))
@@ -1068,7 +1095,8 @@ this case, because the `man-page' slot was not set in
this case."
(transient--parse-child prefix value))))
(vector (and-let* ((c (transient--parse-group prefix spec))) (list c)))
(list (and-let* ((c (transient--parse-suffix prefix spec))) (list c)))
- (string (list spec))))
+ (string (list spec))
+ (t (error "Invalid transient--parse-child spec: %s" spec))))
(defun transient--parse-group (prefix spec)
(setq spec (append spec nil))
@@ -1089,12 +1117,16 @@ this case, because the `man-page' slot was not set in
this case."
(and (listp val) (not (eq (car val) 'lambda))))
(setq args (plist-put args key (macroexp-quote val))))
((setq args (plist-put args key val))))))
+ (unless (or spec class (not (plist-get args :setup-children)))
+ (message "WARNING: %s: When %s is used, %s must also be specified"
+ 'transient-define-prefix :setup-children :class))
(list 'vector
(or level transient--default-child-level)
- (or class
- (if (vectorp car)
- (quote 'transient-columns)
- (quote 'transient-column)))
+ (cond (class)
+ ((or (vectorp car)
+ (and car (symbolp car)))
+ (quote 'transient-columns))
+ ((quote 'transient-column)))
(and args (cons 'list args))
(cons 'list
(cl-mapcan (lambda (s) (transient--parse-child prefix s))
@@ -1133,14 +1165,15 @@ this case, because the `man-page' slot was not set in
this case."
(format "transient:%s:%s"
prefix
(let ((desc (plist-get args :description)))
- (if (and desc (or (stringp desc) (symbolp desc)))
+ (if (and (stringp desc)
+ (length< desc 16))
desc
(plist-get args :key)))))))
(setq args (plist-put
args :command
`(prog1 ',sym
(put ',sym 'interactive-only t)
- (put ',sym 'command-modes (list 'not-a-mode))
+ (put ',sym 'completion-predicate
#'transient--suffix-only)
(defalias ',sym
,(if (eq (car-safe cmd) 'lambda)
cmd
@@ -1163,7 +1196,7 @@ this case, because the `man-page' slot was not set in
this case."
args :command
`(prog1 ',sym
(put ',sym 'interactive-only t)
- (put ',sym 'command-modes (list 'not-a-mode))
+ (put ',sym 'completion-predicate
#'transient--suffix-only)
(defalias ',sym #'transient--default-infix-command))))
(cond ((and car (not (keywordp car)))
(setq class 'transient-option)
@@ -1201,13 +1234,34 @@ this case, because the `man-page' slot was not set in
this case."
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
(match-string 1 arg))))
+(defun transient-command-completion-not-suffix-only-p (symbol _buffer)
+ "Say whether SYMBOL should be offered as a completion.
+If the value of SYMBOL's `completion-predicate' property is
+`transient--suffix-only', then return nil, otherwise return t.
+This is the case when a command should only ever be used as a
+suffix of a transient prefix command (as opposed to bindings
+in regular keymaps or by using `execute-extended-command')."
+ (not (eq (get symbol 'completion-predicate) 'transient--suffix-only)))
+
+(defalias 'transient--suffix-only #'ignore
+ "Ignore ARGUMENTS, do nothing, and return nil.
+Also see `transient-command-completion-not-suffix-only-p'.
+Only use this alias as the value of the `completion-predicate'
+symbol property.")
+
+(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1
+ (not read-extended-command-predicate))
+ (setq read-extended-command-predicate
+ #'transient-command-completion-not-suffix-only-p))
+
(defun transient-parse-suffix (prefix suffix)
"Parse SUFFIX, to be added to PREFIX.
PREFIX is a prefix command, a symbol.
SUFFIX is a suffix command or a group specification (of
the same forms as expected by `transient-define-prefix').
Intended for use in a group's `:setup-children' function."
- (eval (car (transient--parse-child prefix suffix))))
+ (cl-assert (and prefix (symbolp prefix)))
+ (eval (car (transient--parse-child prefix suffix)) t))
(defun transient-parse-suffixes (prefix suffixes)
"Parse SUFFIXES, to be added to PREFIX.
@@ -1215,6 +1269,7 @@ PREFIX is a prefix command, a symbol.
SUFFIXES is a list of suffix command or a group specification
(of the same forms as expected by `transient-define-prefix').
Intended for use in a group's `:setup-children' function."
+ (cl-assert (and prefix (symbolp prefix)))
(mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
;;; Edit
@@ -1226,7 +1281,7 @@ Intended for use in a group's `:setup-children' function."
(string suffix)))
(mem (transient--layout-member loc prefix))
(elt (car mem)))
- (setq suf (eval suf))
+ (setq suf (eval suf t))
(cond
((not mem)
(message "Cannot insert %S into %s; %s not found"
@@ -1475,7 +1530,8 @@ drawing in the transient buffer.")
(defvar transient--pending-suffix nil
"The suffix that is currently being processed.
-This is bound while the suffix predicate is being evaluated.")
+This is bound while the suffix predicate is being evaluated,
+and while functions that return faces are being evaluated.")
(defvar transient--pending-group nil
"The group that is currently being processed.
@@ -1558,33 +1614,35 @@ probably use this instead:
(get COMMAND \\='transient--suffix)"
(when command
(cl-check-type command command))
- (if (or transient--prefix
- transient-current-prefix)
- (let ((suffixes
- (cl-remove-if-not
- (lambda (obj)
- (eq (oref obj command)
- (or command
- (if (eq this-command 'transient-set-level)
- ;; This is how it can look up for which
- ;; command it is setting the level.
- this-original-command
- this-command))))
- (or transient--suffixes
- transient-current-suffixes))))
- (or (and (cdr suffixes)
- (cl-find-if
- (lambda (obj)
- (equal (listify-key-sequence (transient--kbd (oref obj
key)))
- (listify-key-sequence (this-command-keys))))
- suffixes))
- (car suffixes)))
- (and-let* ((obj (transient--suffix-prototype (or command this-command)))
+ (cond
+ (transient--pending-suffix)
+ ((or transient--prefix
+ transient-current-prefix)
+ (let ((suffixes
+ (cl-remove-if-not
+ (lambda (obj)
+ (eq (oref obj command)
+ (or command
+ (if (eq this-command 'transient-set-level)
+ ;; This is how it can look up for which
+ ;; command it is setting the level.
+ this-original-command
+ this-command))))
+ (or transient--suffixes
+ transient-current-suffixes))))
+ (or (and (cdr suffixes)
+ (cl-find-if
+ (lambda (obj)
+ (equal (listify-key-sequence (transient--kbd (oref obj key)))
+ (listify-key-sequence (this-command-keys))))
+ suffixes))
+ (car suffixes))))
+ ((and-let* ((obj (transient--suffix-prototype (or command this-command)))
(obj (clone obj)))
(progn ; work around debbugs#31840
(transient-init-scope obj)
(transient-init-value obj)
- obj))))
+ obj)))))
(defun transient--suffix-prototype (command)
(or (get command 'transient--suffix)
@@ -1681,7 +1739,8 @@ to `transient-predicate-map'. Also see
`transient-base-map'."
"Hide common commands"
"Show common permanently")))
(list "C-x l" "Show/hide suffixes" #'transient-set-level)
- (list "C-x a" #'transient-toggle-level-limit))))))))
+ (list "C-x a" #'transient-toggle-level-limit)))))
+ t)))
(defvar-keymap transient-popup-navigation-map
:doc "One of the keymaps used when popup navigation is enabled.
@@ -1765,7 +1824,10 @@ of the corresponding object."
;; an unbound key, then Emacs calls the `undefined' command
;; but does not set `this-command', `this-original-command'
;; or `real-this-command' accordingly. Instead they are nil.
- "<nil>" #'transient--do-warn)
+ "<nil>" #'transient--do-warn
+ ;; Bound to the `mouse-movement' event, this command is similar
+ ;; to `ignore'.
+ "<ignore-preserving-kill-region>" #'transient--do-noop)
(defvar transient--transient-map nil)
(defvar transient--predicate-map nil)
@@ -1824,7 +1886,7 @@ of the corresponding object."
(defun transient--make-predicate-map ()
(let* ((default (transient--resolve-pre-command
(oref transient--prefix transient-suffix)))
- (return (and transient-current-prefix (eq default t)))
+ (return (and transient--stack (eq default t)))
(map (make-sparse-keymap)))
(set-keymap-parent map transient-predicate-map)
(when (or (and (slot-boundp transient--prefix 'transient-switch-frame)
@@ -1915,7 +1977,7 @@ the \"scope\" of the transient (see
`transient-define-prefix').
This function is also called internally in which case LAYOUT and
EDIT may be non-nil."
(transient--debug 'setup)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :setup
(cond
((not name)
;; Switching between regular and edit mode.
@@ -2169,7 +2231,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--pre-command ()
(transient--debug 'pre-command)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :pre-command
;; The use of `overriding-terminal-local-map' does not prevent the
;; lookup of command remappings in the overridden maps, which can
;; lead to a suffix being remapped to a non-suffix. We have to undo
@@ -2231,14 +2293,14 @@ value. Otherwise return CHILDREN as is."
(when (window-live-p transient--window)
(let ((remain-in-minibuffer-window
(and (minibuffer-selected-window)
- (selected-window)))
- (buf (window-buffer transient--window)))
+ (selected-window))))
;; Only delete the window if it has never shown another buffer.
(unless (eq (car (window-parameter transient--window 'quit-restore))
'other)
(with-demoted-errors "Error while exiting transient: %S"
(delete-window transient--window)))
- (kill-buffer buf)
+ (when-let ((buffer (get-buffer transient--buffer-name)))
+ (kill-buffer buffer))
(when remain-in-minibuffer-window
(select-window remain-in-minibuffer-window)))))
@@ -2256,7 +2318,10 @@ value. Otherwise return CHILDREN as is."
((and transient--prefix transient--redisplay-key)
(setq transient--redisplay-key nil)
(when transient--showp
- (transient--show))))
+ (if-let ((win (minibuffer-selected-window)))
+ (with-selected-window win
+ (transient--show))
+ (transient--show)))))
(transient--pop-keymap 'transient--transient-map)
(transient--pop-keymap 'transient--redisplay-map)
(remove-hook 'pre-command-hook #'transient--pre-command)
@@ -2311,7 +2376,7 @@ value. Otherwise return CHILDREN as is."
(remove-hook 'minibuffer-exit-hook ,exit)))
,@body)))
-(static-if (>= emacs-major-version 30)
+(static-if (>= emacs-major-version 30) ;transient--wrap-command
(defun transient--wrap-command ()
(cl-assert
(>= emacs-major-version 30) nil
@@ -2319,27 +2384,31 @@ value. Otherwise return CHILDREN as is."
(letrec
((prefix transient--prefix)
(suffix this-command)
- (advice (lambda (fn &rest args)
- (interactive
- (lambda (spec)
- (let ((abort t))
- (unwind-protect
- (prog1 (advice-eval-interactive-spec spec)
- (setq abort nil))
- (when abort
- (when-let ((unwind (oref prefix unwind-suffix)))
- (transient--debug 'unwind-interactive)
- (funcall unwind suffix))
- (advice-remove suffix advice)
- (oset prefix unwind-suffix nil))))))
- (unwind-protect
- (apply fn args)
+ (advice
+ (lambda (fn &rest args)
+ (interactive
+ (lambda (spec)
+ (let ((abort t))
+ (unwind-protect
+ (prog1 (let ((debugger #'transient--exit-and-debug))
+ (advice-eval-interactive-spec spec))
+ (setq abort nil))
+ (when abort
(when-let ((unwind (oref prefix unwind-suffix)))
- (transient--debug 'unwind-command)
+ (transient--debug 'unwind-interactive)
(funcall unwind suffix))
(advice-remove suffix advice)
- (oset prefix unwind-suffix nil)))))
- (advice-add suffix :around advice '((depth . -99)))))
+ (oset prefix unwind-suffix nil))))))
+ (unwind-protect
+ (let ((debugger #'transient--exit-and-debug))
+ (apply fn args))
+ (when-let ((unwind (oref prefix unwind-suffix)))
+ (transient--debug 'unwind-command)
+ (funcall unwind suffix))
+ (advice-remove suffix advice)
+ (oset prefix unwind-suffix nil)))))
+ (when (symbolp this-command)
+ (advice-add suffix :around advice '((depth . -99))))))
(defun transient--wrap-command ()
(let* ((prefix transient--prefix)
@@ -2349,7 +2418,8 @@ value. Otherwise return CHILDREN as is."
(lambda (spec)
(let ((abort t))
(unwind-protect
- (prog1 (advice-eval-interactive-spec spec)
+ (prog1 (let ((debugger #'transient--exit-and-debug))
+ (advice-eval-interactive-spec spec))
(setq abort nil))
(when abort
(when-let ((unwind (oref prefix unwind-suffix)))
@@ -2360,7 +2430,8 @@ value. Otherwise return CHILDREN as is."
(advice-body
(lambda (fn &rest args)
(unwind-protect
- (apply fn args)
+ (let ((debugger #'transient--exit-and-debug))
+ (apply fn args))
(when-let ((unwind (oref prefix unwind-suffix)))
(transient--debug 'unwind-command)
(funcall unwind suffix))
@@ -2369,7 +2440,8 @@ value. Otherwise return CHILDREN as is."
(setq advice `(lambda (fn &rest args)
(interactive ,advice-interactive)
(apply ',advice-body fn args)))
- (advice-add suffix :around advice '((depth . -99))))))
+ (when (symbolp this-command)
+ (advice-add suffix :around advice '((depth . -99)))))))
(defun transient--premature-post-command ()
(and (equal (this-command-keys-vector) [])
@@ -2388,7 +2460,7 @@ value. Otherwise return CHILDREN as is."
(defun transient--post-command ()
(unless (transient--premature-post-command)
(transient--debug 'post-command)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :post-command
(cond (transient--exitp (transient--post-exit))
;; If `this-command' is the current transient prefix, then we
;; have already taken care of updating the transient buffer...
@@ -2506,24 +2578,29 @@ value. Otherwise return CHILDREN as is."
(if (symbolp arg)
(message "-- %-22s (cmd: %s, event: %S, exit: %s%s)"
arg
- (or (and (symbolp this-command) this-command)
- (if (byte-code-function-p this-command)
- "#[...]"
- this-command))
+ (if (fboundp 'help-fns-function-name)
+ (help-fns-function-name this-command)
+ (if (byte-code-function-p this-command)
+ "#[...]"
+ this-command))
(key-description (this-command-keys-vector))
transient--exitp
- (cond ((stringp (car args))
+ (cond ((keywordp (car args))
+ (format ", from: %s"
+ (substring (symbol-name (car args)) 1)))
+ ((stringp (car args))
(concat ", " (apply #'format args)))
- (args
+ ((functionp (car args))
(concat ", " (apply (car args) (cdr args))))
("")))
(apply #'message arg args)))))
-(defun transient--emergency-exit ()
+(defun transient--emergency-exit (&optional id)
"Exit the current transient command after an error occurred.
When no transient is active (i.e., when `transient--prefix' is
-nil) then do nothing."
- (transient--debug 'emergency-exit)
+nil) then do nothing. Optional ID is a keyword identifying the
+exit."
+ (transient--debug 'emergency-exit id)
(when transient--prefix
(setq transient--stack nil)
(setq transient--exitp t)
@@ -2547,6 +2624,7 @@ nil) then do nothing."
(defun transient--get-pre-command (&optional cmd enforce-type)
(or (and (not (eq enforce-type 'non-suffix))
+ (symbolp cmd)
(lookup-key transient--predicate-map (vector cmd)))
(and (not (eq enforce-type 'suffix))
(transient--resolve-pre-command
@@ -2909,7 +2987,7 @@ transient is active."
(interactive)
(transient-set-value (transient-prefix-object)))
-(defalias 'transient-set-and-exit 'transient-set
+(defalias 'transient-set-and-exit #'transient-set
"Set active transient's value for this Emacs session and exit.")
(defun transient-save ()
@@ -2917,7 +2995,7 @@ transient is active."
(interactive)
(transient-save-value (transient-prefix-object)))
-(defalias 'transient-save-and-exit 'transient-save
+(defalias 'transient-save-and-exit #'transient-save
"Save active transient's value for this and future Emacs sessions and exit.")
(defun transient-reset ()
@@ -3090,14 +3168,14 @@ infix command determines what the new value should be,
based
on the previous value.")
(cl-defmethod transient-infix-read :around ((obj transient-infix))
- "Refresh the transient buffer buffer calling the next method.
+ "Refresh the transient buffer and call the next method.
Also wrap `cl-call-next-method' with two macros:
- `transient--with-suspended-override' allows use of minibuffer.
- `transient--with-emergency-exit' arranges for the transient to
be exited in case of an error."
(transient--show)
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :infix-read
(transient--with-suspended-override
(cl-call-next-method obj))))
@@ -3179,8 +3257,10 @@ The last value is \"don't use any of these switches\"."
"Elsewhere use the reader of the infix command COMMAND.
Use this if you want to share an infix's history with a regular
stand-alone command."
- (cl-letf (((symbol-function #'transient--show) #'ignore))
- (transient-infix-read (transient--suffix-prototype command))))
+ (if-let ((obj (transient--suffix-prototype command)))
+ (cl-letf (((symbol-function #'transient--show) #'ignore))
+ (transient-infix-read obj))
+ (error "Not a suffix command: `%s'" command)))
;;;; Readers
@@ -3357,7 +3437,7 @@ the set, saved or default value for PREFIX."
(transient--init-suffixes prefix)))))
(defun transient-get-value ()
- (transient--with-emergency-exit
+ (transient--with-emergency-exit :get-value
(cl-mapcan (lambda (obj)
(and (or (not (slot-exists-p obj 'unsavable))
(not (oref obj unsavable)))
@@ -3568,7 +3648,7 @@ have a history of their own.")
(propertize "\n" 'face face 'line-height t))))
(defmacro transient-with-shadowed-buffer (&rest body)
- "While in the transient buffer, temporarily make the shadowed buffer
current."
+ "While in the transient buffer, temporarly make the shadowed buffer current."
(declare (indent 0) (debug t))
`(with-current-buffer (or transient--shadowed-buffer (current-buffer))
,@body))
@@ -3623,7 +3703,8 @@ have a history of their own.")
(lambda (column)
(transient--maybe-pad-keys column group)
(transient-with-shadowed-buffer
- (let ((rows (mapcar #'transient-format (oref column suffixes))))
+ (let* ((transient--pending-group column)
+ (rows (mapcar #'transient-format (oref column
suffixes))))
(when-let ((desc (transient-format-description column)))
(push desc rows))
(flatten-tree rows))))
@@ -3632,10 +3713,15 @@ have a history of their own.")
transient-align-variable-pitch))
(rs (apply #'max (mapcar #'length columns)))
(cs (length columns))
- (cw (mapcar (lambda (col)
- (apply #'max
- (mapcar (if vp #'transient--pixel-width #'length)
- col)))
+ (cw (mapcar (let ((widths (oref transient--prefix column-widths)))
+ (lambda (col)
+ (apply
+ #'max
+ (if-let ((min (pop widths)))
+ (if vp (* min (transient--pixel-width " ")) min)
+ 0)
+ (mapcar (if vp #'transient--pixel-width #'length)
+ col))))
columns))
(cc (transient--seq-reductions-from
(apply-partially #'+ (* 3 (if vp (transient--pixel-width " ")
1)))
@@ -3911,7 +3997,10 @@ If the OBJ's `key' is currently unreachable, then apply
the face
(face (slot-value obj slot)))
(if (and (not (facep face))
(functionp face))
- (funcall face)
+ (let ((transient--pending-suffix obj))
+ (if (= (car (func-arity face)) 1)
+ (funcall face obj)
+ (funcall face)))
face)))
(defun transient--key-face (&optional cmd enforce-type)
diff --git a/lisp/treesit.el b/lisp/treesit.el
index fa82ad898a9..2b4893e6129 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2237,7 +2237,7 @@ for invalid node.
This is used by `treesit-beginning-of-defun' and friends.")
(defvar-local treesit-defun-tactic 'nested
- "Determines how does Emacs treat nested defuns.
+ "Determines how Emacs treats nested defuns.
If the value is `top-level', Emacs only moves across top-level
defuns, if the value is `nested', Emacs recognizes nested defuns.")
@@ -2253,9 +2253,8 @@ If the value is nil, no skipping is performed.")
(defvar-local treesit-defun-name-function nil
"A function that is called with a node and returns its defun name or nil.
If the node is a defun node, return the defun name, e.g., the
-function name of a function. If the node is not a defun node, or
-the defun node doesn't have a name, or the node is nil, return
-nil.")
+name of a function. If the node is not a defun node, or the
+defun node doesn't have a name, or the node is nil, return nil.")
(defvar-local treesit-add-log-defun-delimiter "."
"The delimiter used to connect several defun names.
@@ -2728,12 +2727,12 @@ function is called recursively."
;; TODO: In corporate into thing-at-point.
(defun treesit-thing-at-point (thing tactic)
- "Return the THING at point or nil if none is found.
+ "Return the THING at point, or nil if none is found.
-THING can be a symbol, regexp, a predicate function, and more,
+THING can be a symbol, a regexp, a predicate function, and more;
see `treesit-thing-settings' for details.
-Return the top-level THING if TACTIC is `top-level', return the
+Return the top-level THING if TACTIC is `top-level'; return the
smallest enclosing THING as POS if TACTIC is `nested'."
(let ((node (treesit--thing-at (point) thing)))
@@ -2742,11 +2741,11 @@ smallest enclosing THING as POS if TACTIC is `nested'."
node)))
(defun treesit-defun-at-point ()
- "Return the defun node at point or nil if none is found.
+ "Return the defun node at point, or nil if none is found.
-Respects `treesit-defun-tactic': return the top-level defun if it
-is `top-level', return the immediate parent defun if it is
-`nested'.
+Respects `treesit-defun-tactic': returns the top-level defun if it
+is `top-level', otherwise return the immediate parent defun if it
+is `nested'.
Return nil if `treesit-defun-type-regexp' isn't set and `defun'
isn't defined in `treesit-thing-settings'."
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index 0d27321cc47..ce6de2b3ee4 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -70,7 +70,7 @@ FILE can be created or overwritten."
;;;###autoload
(defun url-store-in-cache (&optional buff)
"Store buffer BUFF in the cache."
- (with-current-buffer (get-buffer (or buff (current-buffer)))
+ (with-current-buffer (or buff (current-buffer))
(let ((fname (url-cache-create-filename (url-view-url t))))
(if (url-cache-prepare fname)
(let ((coding-system-for-write 'binary))
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index ac7d55c8a46..0f393ba86a2 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -240,6 +240,8 @@ The default \"-b\" means to ignore whitespace-only changes,
:help "Apply the current hunk to the source file and go to the next"]
["Test applying hunk" diff-test-hunk
:help "See whether it's possible to apply the current hunk"]
+ ["Apply all hunks" diff-apply-buffer
+ :help "Apply all hunks in the current diff buffer"]
["Apply diff with Ediff" diff-ediff-patch
:help "Call `ediff-patch-file' on the current buffer"]
["Create Change Log entries" diff-add-change-log-entries-other-window
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index 52039f8da74..63b566b0afe 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -476,7 +476,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(concat "-j" first-revision)
(concat "-j" second-revision))
(vc-file-setprop file 'vc-state 'edited)
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
(if (re-search-forward "conflicts during merge" nil t)
(progn
@@ -495,7 +495,7 @@ The changes are between FIRST-REVISION and SECOND-REVISION."
(vc-cvs-command nil nil file "update")
;; Analyze the merge result reported by CVS, and set
;; file properties accordingly.
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
;; get new working revision
(if (re-search-forward
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 18b4a8691e9..b23a5ca95a1 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -817,27 +817,31 @@ or an empty string if none."
cmds))
(defun vc-git-dir-extra-headers (dir)
- (let ((str (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "symbolic-ref" "HEAD"))))
+ (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
(stash-list (vc-git-stash-list))
(default-directory dir)
(in-progress (vc-git--cmds-in-progress))
- branch remote remote-url stash-button stash-string)
+ branch remote-url stash-button stash-string tracking-branch)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
(progn
(setq branch (match-string 2 str))
- (setq remote
- (with-output-to-string
- (with-current-buffer standard-output
- (vc-git--out-ok "config"
- (concat "branch." branch ".remote")))))
- (when (string-match "\\([^\n]+\\)" remote)
- (setq remote (match-string 1 remote)))
- (when (> (length remote) 0)
- (setq remote-url (vc-git-repository-url dir remote))))
- (setq branch "not (detached HEAD)"))
+ (let ((remote (vc-git--out-str
+ "config" (concat "branch." branch ".remote")))
+ (merge (vc-git--out-str
+ "config" (concat "branch." branch ".merge"))))
+ (when (string-match "\\([^\n]+\\)" remote)
+ (setq remote (match-string 1 remote)))
+ (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
+ (setq tracking-branch (match-string 2 merge)))
+ (pcase remote
+ ("."
+ (setq remote-url "none (tracking local branch)"))
+ ((pred (not string-empty-p))
+ (setq
+ remote-url (vc-git-repository-url dir remote)
+ tracking-branch (concat remote "/" tracking-branch))))))
+ (setq branch "none (detached HEAD)"))
(when stash-list
(let* ((len (length stash-list))
(limit
@@ -890,6 +894,11 @@ or an empty string if none."
(propertize "Branch : " 'face 'vc-dir-header)
(propertize branch
'face 'vc-dir-header-value)
+ (when tracking-branch
+ (concat
+ "\n"
+ (propertize "Tracking : " 'face 'vc-dir-header)
+ (propertize tracking-branch 'face 'vc-dir-header-value)))
(when remote-url
(concat
"\n"
@@ -2226,8 +2235,17 @@ The difference to vc-do-command is that this function
always invokes
(apply #'process-file vc-git-program nil buffer nil "--no-pager" command
args)))
(defun vc-git--out-ok (command &rest args)
+ "Run `git COMMAND ARGS...' and insert standard output in current buffer.
+Return whether the process exited with status zero."
(zerop (apply #'vc-git--call '(t nil) command args)))
+(defun vc-git--out-str (command &rest args)
+ "Run `git COMMAND ARGS...' and return standard output as a string.
+The exit status is ignored."
+ (with-output-to-string
+ (with-current-buffer standard-output
+ (apply #'vc-git--out-ok command args))))
+
(defun vc-git--run-command-string (file &rest args)
"Run a git command on FILE and return its output as string.
FILE can be nil."
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index 1a43b440d18..33377ce1cc8 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1177,7 +1177,7 @@ variable `vc-rcs-release' is set to the returned value."
(or vc-rcs-release
(setq vc-rcs-release
(or (and (zerop (vc-do-command "*vc*" nil "rcs" nil "-V"))
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(vc-parse-buffer "^RCS version \\([0-9.]+ *.*\\)" 1)))
'unknown))))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 96baa642b44..ae281e54519 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -436,7 +436,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(concat first-version ":" second-version)
first-version))
(vc-file-setprop file 'vc-state 'edited)
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
(if (looking-at "C ")
1 ; signal conflict
@@ -450,7 +450,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION."
(vc-svn-command nil 0 file "update")
;; Analyze the merge result reported by SVN, and set
;; file properties accordingly.
- (with-current-buffer (get-buffer "*vc*")
+ (with-current-buffer "*vc*"
(goto-char (point-min))
;; get new working revision
(if (re-search-forward
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index bb56f3f62fb..d4000187bd1 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -141,7 +141,7 @@ The following commands are available:
(setq key (nth 0 items)
value (nth 1 items)
printer (or (get key 'widget-keyword-printer)
- 'widget-browse-sexp)
+ #'widget-browse-sexp)
items (cdr (cdr items)))
(widget-insert "\n" (symbol-name key) "\n\t")
(funcall printer widget key value)
@@ -204,24 +204,10 @@ VALUE is assumed to be a list of widgets."
(defun widget-browse-sexp (_widget _key value)
"Insert description of WIDGET's KEY VALUE.
Nothing is assumed about value."
- (let ((pp (condition-case signal
- (pp-to-string value)
- (error (prin1-to-string signal)))))
- (when (string-match "\n\\'" pp)
- (setq pp (substring pp 0 (1- (length pp)))))
- (if (cond ((string-search "\n" pp)
- nil)
- ((> (length pp) (- (window-width) (current-column)))
- nil)
- (t t))
- (widget-insert pp)
- (widget-create 'push-button
- :tag "show"
- :action (lambda (widget &optional _event)
- (with-output-to-temp-buffer
- "*Pp Eval Output*"
- (princ (widget-get widget :value))))
- pp))))
+ (require 'pp)
+ (declare-function pp-insert-short-sexp "pp" (sexp &optional width))
+ (widget--allow-insertion
+ (pp-insert-short-sexp value)))
(defun widget-browse-sexps (widget key value)
"Insert description of WIDGET's KEY VALUE.
@@ -235,11 +221,11 @@ VALUE is assumed to be a list of widgets."
;;; Keyword Printers.
-(put :parent 'widget-keyword-printer 'widget-browse-widget)
-(put :children 'widget-keyword-printer 'widget-browse-widgets)
-(put :buttons 'widget-keyword-printer 'widget-browse-widgets)
-(put :button 'widget-keyword-printer 'widget-browse-widget)
-(put :args 'widget-keyword-printer 'widget-browse-sexps)
+(put :parent 'widget-keyword-printer #'widget-browse-widget)
+(put :children 'widget-keyword-printer #'widget-browse-widgets)
+(put :buttons 'widget-keyword-printer #'widget-browse-widgets)
+(put :button 'widget-keyword-printer #'widget-browse-widget)
+(put :args 'widget-keyword-printer #'widget-browse-sexps)
;;; Widget Minor Mode.
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index cd06acd3f99..172da3db1e0 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -1,4 +1,4 @@
-;;; wid-edit.el --- Functions for creating and using widgets -*-
lexical-binding:t -*-
+;; wid-edit.el --- Functions for creating and using widgets -*-
lexical-binding:t -*-
;;
;; Copyright (C) 1996-1997, 1999-2024 Free Software Foundation, Inc.
;;
@@ -247,10 +247,10 @@ to evaluate to nil for the menu item to be meaningful."
(eq (car value) :radio))
(setq selected (cdr value))))
(setq plist (cddr plist)))
- (when (and (eval visible)
- (eval enable)
+ (when (and (eval visible t)
+ (eval enable t)
(or (not selected)
- (not (eval selected))))
+ (not (eval selected t))))
(push (cons (nth 1 def) ev) simplified)))))
extended)
(reverse simplified)))
@@ -317,7 +317,7 @@ in the key vector, as in the argument of `define-key'."
(when (keymapp items)
(setq items (widget--simplify-menu items)))
;; Read the choice of name from the minibuffer.
- (setq items (cl-remove-if 'stringp items))
+ (setq items (cl-remove-if #'stringp items))
(let ((val (completing-read (concat title ": ") items nil t)))
(if (stringp val)
(let ((try (try-completion val items)))
@@ -330,12 +330,11 @@ in the key vector, as in the argument of `define-key'."
;; Construct a menu of the choices
;; and then use it for prompting for a single character.
(let ((next-digit ?0)
- alist choice some-choice-enabled value)
+ alist some-choice-enabled value)
(with-current-buffer (get-buffer-create " widget-choose")
(erase-buffer)
(insert "Available choices:\n\n")
- (while items
- (setq choice (pop items))
+ (dolist (choice items)
(when (consp choice)
(insert (format "%c = %s\n" next-digit (car choice)))
(push (cons next-digit (cdr choice)) alist)
@@ -510,14 +509,20 @@ With CHECK-AFTER non-nil, considers also the content
after point, if needed."
;; indented it.
(not (eq (following-char) ?\s))))))
-(defmacro widget-specify-insert (&rest form)
- "Execute FORM without inheriting any text properties."
- (declare (debug (body)))
+(defmacro widget--allow-insertion (&rest forms)
+ "Run FORMS such that they can insert widgets in the current buffer."
+ (declare (debug t))
+ `(let ((inhibit-read-only t)
+ (inhibit-modification-hooks t)) ;; FIXME: Why? This is risky!
+ ,@forms))
+
+(defmacro widget-specify-insert (&rest forms)
+ "Execute FORMS without inheriting any text properties."
+ (declare (debug t))
`(save-restriction
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
+ (widget--allow-insertion
(narrow-to-region (point) (point))
- (prog1 (progn ,@form)
+ (prog1 (progn ,@forms)
(goto-char (point-max))))))
(defface widget-inactive
@@ -659,12 +664,9 @@ The current value is assumed to be VALUE, unless UNBOUND
is non-nil."
(defun widget-get-sibling (widget)
"Get the item WIDGET is assumed to toggle.
This is only meaningful for radio buttons or checkboxes in a list."
- (let* ((children (widget-get (widget-get widget :parent) :children))
- child)
+ (let* ((children (widget-get (widget-get widget :parent) :children)))
(catch 'child
- (while children
- (setq child (car children)
- children (cdr children))
+ (dolist (child children)
(when (eq (widget-get child :button) widget)
(throw 'child child)))
nil)))
@@ -844,14 +846,14 @@ button is pressed or inactive, respectively. These are
currently ignored."
(defun widget-create (type &rest args)
"Create widget of TYPE.
The optional ARGS are additional keyword arguments."
- (let ((widget (apply 'widget-convert type args)))
+ (let ((widget (apply #'widget-convert type args)))
(widget-apply widget :create)
widget))
(defun widget-create-child-and-convert (parent type &rest args)
"As part of the widget PARENT, create a child widget TYPE.
The child is converted, using the keyword arguments ARGS."
- (let ((widget (apply 'widget-convert type args)))
+ (let ((widget (apply #'widget-convert type args)))
(widget-put widget :parent parent)
(unless (widget-get widget :indent)
(widget-put widget :indent (+ (or (widget-get parent :indent) 0)
@@ -905,18 +907,19 @@ The optional ARGS are additional keyword arguments."
(keys args))
;; First set the :args keyword.
(while (cdr current) ;Look in the type.
- (if (and (keywordp (cadr current))
- ;; If the last element is a keyword,
- ;; it is still the :args element,
- ;; even though it is a keyword.
- (cddr current))
- (if (eq (cadr current) :args)
- ;; If :args is explicitly specified, obey it.
- (setq current nil)
- ;; Some other irrelevant keyword.
- (setq current (cdr (cdr current))))
- (setcdr current (list :args (cdr current)))
- (setq current nil)))
+ (setq current
+ (if (and (keywordp (cadr current))
+ ;; If the last element is a keyword,
+ ;; it is still the :args element,
+ ;; even though it is a keyword.
+ (cddr current))
+ (if (eq (cadr current) :args)
+ ;; If :args is explicitly specified, obey it.
+ nil
+ ;; Some other irrelevant keyword.
+ (cdr (cdr current)))
+ (setcdr current (list :args (cdr current)))
+ nil)))
(while (and args (not done)) ;Look in ARGS.
(cond ((eq (car args) :args)
;; Handle explicit specification of :args.
@@ -937,11 +940,9 @@ The optional ARGS are additional keyword arguments."
;; Finally set the keyword args.
(while keys
(let ((next (nth 0 keys)))
- (if (keywordp next)
- (progn
- (widget-put widget next (nth 1 keys))
- (setq keys (nthcdr 2 keys)))
- (setq keys nil))))
+ (setq keys (when (keywordp next)
+ (widget-put widget next (nth 1 keys))
+ (nthcdr 2 keys)))))
;; Convert the :value to internal format.
(if (widget-member widget :value)
(widget-put widget
@@ -954,9 +955,8 @@ The optional ARGS are additional keyword arguments."
;;;###autoload
(defun widget-insert (&rest args)
"Call `insert' with ARGS even if surrounding text is read only."
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t))
- (apply 'insert args)))
+ (widget--allow-insertion
+ (apply #'insert args)))
(defun widget-convert-text (type from to
&optional button-from button-to
@@ -967,7 +967,7 @@ and TO will be used as the widgets end points. If optional
arguments
BUTTON-FROM and BUTTON-TO are given, these will be used as the widgets
button end points.
Optional ARGS are extra keyword arguments for TYPE."
- (let ((widget (apply 'widget-convert type :delete 'widget-leave-text args))
+ (let ((widget (apply #'widget-convert type :delete 'widget-leave-text args))
(from (copy-marker from))
(to (copy-marker to)))
(set-marker-insertion-type from t)
@@ -984,7 +984,7 @@ Optional ARGS are extra keyword arguments for TYPE.
No text will be inserted to the buffer, instead the text between FROM
and TO will be used as the widgets end points, as well as the widgets
button end points."
- (apply 'widget-convert-text type from to from to args))
+ (apply #'widget-convert-text type from to from to args))
(defun widget-leave-text (widget)
"Remove markers and overlays from WIDGET and its children."
@@ -1002,7 +1002,7 @@ button end points."
(delete-overlay doc))
(when field
(delete-overlay field))
- (mapc 'widget-leave-text (widget-get widget :children))))
+ (mapc #'widget-leave-text (widget-get widget :children))))
(defun widget-text (widget)
"Get the text representation of the widget."
@@ -1017,7 +1017,7 @@ button end points."
;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html
(define-obsolete-function-alias 'advertised-widget-backward
- 'widget-backward "23.2")
+ #'widget-backward "23.2")
;;;###autoload
(defvar widget-keymap
@@ -1043,13 +1043,13 @@ Note that such modes will need to require wid-edit.")
(defvar widget-field-keymap
(let ((map (copy-keymap widget-keymap)))
- (define-key map "\C-k" 'widget-kill-line)
- (define-key map "\M-\t" 'widget-complete)
- (define-key map "\C-m" 'widget-field-activate)
+ (define-key map "\C-k" #'widget-kill-line)
+ (define-key map "\M-\t" #'widget-complete)
+ (define-key map "\C-m" #'widget-field-activate)
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
- ;; (define-key map "\C-a" 'widget-beginning-of-line)
- (define-key map "\C-e" 'widget-end-of-line)
+ ;; (define-key map "\C-a" #'widget-beginning-of-line)
+ (define-key map "\C-e" #'widget-end-of-line)
map)
"Keymap used inside an editable field.")
@@ -1057,8 +1057,8 @@ Note that such modes will need to require wid-edit.")
(let ((map (copy-keymap widget-keymap)))
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
- ;; (define-key map "\C-a" 'widget-beginning-of-line)
- (define-key map "\C-e" 'widget-end-of-line)
+ ;; (define-key map "\C-a" #'widget-beginning-of-line)
+ (define-key map "\C-e" #'widget-end-of-line)
map)
"Keymap used inside a text field.")
@@ -1299,7 +1299,7 @@ With optional ARG, move across that many fields."
;; Since the widget code uses a `field' property to identify fields,
;; ordinary beginning-of-line does the right thing.
-(defalias 'widget-beginning-of-line 'beginning-of-line)
+(defalias 'widget-beginning-of-line #'beginning-of-line)
(defun widget-end-of-line ()
"Go to end of field or end of line, whichever is first.
@@ -1376,19 +1376,18 @@ When not inside a field, signal an error."
;;;###autoload
(defun widget-setup ()
"Setup current buffer so editing string widgets works."
- (let ((inhibit-read-only t)
- (inhibit-modification-hooks t)
- field)
- (while widget-field-new
- (setq field (car widget-field-new)
- widget-field-new (cdr widget-field-new)
- widget-field-list (cons field widget-field-list))
- (let ((from (car (widget-get field :field-overlay)))
- (to (cdr (widget-get field :field-overlay))))
- (widget-specify-field field
- (marker-position from) (marker-position to))
- (set-marker from nil)
- (set-marker to nil))))
+ (widget--allow-insertion
+ (let (field)
+ (while widget-field-new
+ (setq field (car widget-field-new)
+ widget-field-new (cdr widget-field-new)
+ widget-field-list (cons field widget-field-list))
+ (let ((from (car (widget-get field :field-overlay)))
+ (to (cdr (widget-get field :field-overlay))))
+ (widget-specify-field field
+ (marker-position from) (marker-position to))
+ (set-marker from nil)
+ (set-marker to nil)))))
(widget-clear-undo)
(widget-add-change))
@@ -1463,11 +1462,8 @@ When not inside a field, signal an error."
(defun widget-field-find (pos)
"Return the field at POS.
Unlike (get-char-property POS \\='field), this works with empty fields too."
- (let ((fields widget-field-list)
- field found)
- (while fields
- (setq field (car fields)
- fields (cdr fields))
+ (let (found)
+ (dolist (field widget-field-list)
(when (and (<= (widget-field-start field) pos)
(<= pos (widget-field-end field)))
(when found
@@ -1482,11 +1478,11 @@ Unlike (get-char-property POS \\='field), this works
with empty fields too."
(let ((from-field (widget-field-find from))
(to-field (widget-field-find to)))
(cond ((not (eq from-field to-field))
- (add-hook 'post-command-hook 'widget-add-change nil t)
+ (add-hook 'post-command-hook #'widget-add-change nil t)
(signal 'text-read-only
'("Change should be restricted to a single field")))
((null from-field)
- (add-hook 'post-command-hook 'widget-add-change nil t)
+ (add-hook 'post-command-hook #'widget-add-change nil t)
(signal 'text-read-only
'("Attempt to change text outside editable field")))
(widget-field-use-before-change
@@ -1494,9 +1490,9 @@ Unlike (get-char-property POS \\='field), this works with
empty fields too."
from-field (list 'before-change from to)))))))
(defun widget-add-change ()
- (remove-hook 'post-command-hook 'widget-add-change t)
- (add-hook 'before-change-functions 'widget-before-change nil t)
- (add-hook 'after-change-functions 'widget-after-change nil t))
+ (remove-hook 'post-command-hook #'widget-add-change t)
+ (add-hook 'before-change-functions #'widget-before-change nil t)
+ (add-hook 'after-change-functions #'widget-after-change nil t))
(defun widget-after-change (from to _old)
"Adjust field size and text properties."
@@ -1516,12 +1512,12 @@ Unlike (get-char-property POS \\='field), this works
with empty fields too."
(insert-char ?\s (- (+ begin size) end))))
((> (- end begin) size)
;; Field too large and
- (if (or (< (point) (+ begin size))
- (> (point) end))
- ;; Point is outside extra space.
- (setq begin (+ begin size))
- ;; Point is within the extra space.
- (setq begin (point)))
+ (setq begin (if (or (< (point) (+ begin size))
+ (> (point) end))
+ ;; Point is outside extra space.
+ (+ begin size)
+ ;; Point is within the extra space.
+ (point)))
(save-excursion
(goto-char end)
(while (and (eq (preceding-char) ?\s)
@@ -1541,9 +1537,9 @@ Optional EVENT is the event that triggered the action."
(defun widget-children-value-delete (widget)
"Delete all :children and :buttons in WIDGET."
- (mapc 'widget-delete (widget-get widget :children))
+ (mapc #'widget-delete (widget-get widget :children))
(widget-put widget :children nil)
- (mapc 'widget-delete (widget-get widget :buttons))
+ (mapc #'widget-delete (widget-get widget :buttons))
(widget-put widget :buttons nil))
(defun widget-children-validate (widget)
@@ -1594,13 +1590,13 @@ The value of the :type attribute should be an
unconverted widget type."
(defun widget-types-copy (widget)
"Copy :args as widget types in WIDGET."
- (widget-put widget :args (mapcar 'widget-copy (widget-get widget :args)))
+ (widget-put widget :args (mapcar #'widget-copy (widget-get widget :args)))
widget)
;; Made defsubst to speed up face editor creation.
(defsubst widget-types-convert-widget (widget)
"Convert :args as widget types in WIDGET."
- (widget-put widget :args (mapcar 'widget-convert (widget-get widget :args)))
+ (widget-put widget :args (mapcar #'widget-convert (widget-get widget :args)))
widget)
(defun widget-value-convert-widget (widget)
@@ -1655,17 +1651,18 @@ The value of the :type attribute should be an
unconverted widget type."
(defun widget-default-completions (widget)
"Return completion data, like `completion-at-point-functions' would."
(let ((completions (widget-get widget :completions)))
- (if completions
- (list (widget-field-start widget)
- (max (point) (widget-field-text-end widget))
- completions)
- (if (widget-get widget :complete)
- (lambda () (widget-apply widget :complete))
- (if (widget-get widget :complete-function)
- (lambda ()
- (let ((widget--completing-widget widget))
- (call-interactively
- (widget-get widget :complete-function)))))))))
+ (cond
+ (completions
+ (list (widget-field-start widget)
+ (max (point) (widget-field-text-end widget))
+ completions))
+ ((widget-get widget :complete)
+ (lambda () (widget-apply widget :complete)))
+ ((widget-get widget :complete-function)
+ (lambda ()
+ (let ((widget--completing-widget widget))
+ (call-interactively
+ (widget-get widget :complete-function))))))))
(defun widget-default-create (widget)
"Create WIDGET at point in the current buffer."
@@ -1773,24 +1770,23 @@ The value of the :type attribute should be an
unconverted widget type."
(inactive-overlay (widget-get widget :inactive))
(button-overlay (widget-get widget :button-overlay))
(sample-overlay (widget-get widget :sample-overlay))
- (doc-overlay (widget-get widget :doc-overlay))
- (inhibit-modification-hooks t)
- (inhibit-read-only t))
- (widget-apply widget :value-delete)
- (widget-children-value-delete widget)
- (when inactive-overlay
- (delete-overlay inactive-overlay))
- (when button-overlay
- (delete-overlay button-overlay))
- (when sample-overlay
- (delete-overlay sample-overlay))
- (when doc-overlay
- (delete-overlay doc-overlay))
- (when (< from to)
- ;; Kludge: this doesn't need to be true for empty formats.
- (delete-region from to))
- (set-marker from nil)
- (set-marker to nil))
+ (doc-overlay (widget-get widget :doc-overlay)))
+ (widget--allow-insertion
+ (widget-apply widget :value-delete)
+ (widget-children-value-delete widget)
+ (when inactive-overlay
+ (delete-overlay inactive-overlay))
+ (when button-overlay
+ (delete-overlay button-overlay))
+ (when sample-overlay
+ (delete-overlay sample-overlay))
+ (when doc-overlay
+ (delete-overlay doc-overlay))
+ (when (< from to)
+ ;; Kludge: this doesn't need to be true for empty formats.
+ (delete-region from to))
+ (set-marker from nil)
+ (set-marker to nil)))
(widget-clear-undo))
(defun widget-default-value-set (widget value)
@@ -1811,9 +1807,9 @@ The value of the :type attribute should be an unconverted
widget type."
(widget-put widget :value value)
(widget-apply widget :create))
(if offset
- (if (< offset 0)
- (goto-char (+ (widget-get widget :to) offset 1))
- (goto-char (min (+ from offset) (1- (widget-get widget :to))))))))
+ (goto-char (if (< offset 0)
+ (+ (widget-get widget :to) offset 1)
+ (min (+ from offset) (1- (widget-get widget :to))))))))
(defun widget-default-value-inline (widget)
"Wrap value in a list unless it is inline."
@@ -1976,8 +1972,8 @@ as the argument to `documentation-property'."
;; Only bind mouse-2, since mouse-1 will be translated accordingly to
;; the customization of `mouse-1-click-follows-link'.
(define-key map [down-mouse-1] (lookup-key widget-global-map
[down-mouse-1]))
- (define-key map [down-mouse-2] 'widget-button-click)
- (define-key map [mouse-2] 'widget-button-click)
+ (define-key map [down-mouse-2] #'widget-button-click)
+ (define-key map [mouse-2] #'widget-button-click)
map)
"Keymap used inside a link widget.")
@@ -2325,13 +2321,10 @@ when he invoked the menu."
((and widget-choice-toggle
(= (length args) 2)
(memq old args))
- (if (eq old (nth 0 args))
- (nth 1 args)
- (nth 0 args)))
+ (nth (if (eq old (nth 0 args)) 1 0)
+ args))
(t
- (while args
- (setq current (car args)
- args (cdr args))
+ (dolist (current args)
(setq choices
(cons (cons (widget-apply current :menu-tag-get)
current)
@@ -2424,9 +2417,8 @@ when he invoked the menu."
(widget-toggle-action widget event)
(let ((sibling (widget-get-sibling widget)))
(when sibling
- (if (widget-value widget)
- (widget-apply sibling :activate)
- (widget-apply sibling :deactivate))
+ (widget-apply sibling
+ (if (widget-value widget) :activate :deactivate))
(widget-clear-undo))))
;;; The `checklist' Widget.
@@ -2475,7 +2467,7 @@ If the item is checked, CHOSEN is a cons whose cdr is the
value."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?b)
- (setq button (apply 'widget-create-child-and-convert
+ (setq button (apply #'widget-create-child-and-convert
widget 'checkbox
:value (not (null chosen))
button-args)))
@@ -2555,11 +2547,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-checklist-value-get (widget)
;; The values of all selected items.
- (let ((children (widget-get widget :children))
- child result)
- (while children
- (setq child (car children)
- children (cdr children))
+ (let (result)
+ (dolist (child (widget-get widget :children))
(if (widget-value (widget-get child :button))
(setq result (append result (widget-apply child :value-inline)))))
result))
@@ -2627,12 +2616,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-radio-value-create (widget)
;; Insert all values
- (let ((args (widget-get widget :args))
- arg)
- (while args
- (setq arg (car args)
- args (cdr args))
- (widget-radio-add-item widget arg))))
+ (dolist (arg (widget-get widget :args))
+ (widget-radio-add-item widget arg)))
(defun widget-radio-add-item (widget type)
"Add to radio widget WIDGET a new radio button item of type TYPE."
@@ -2659,7 +2644,7 @@ Return an alist of (TYPE MATCH)."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?b)
- (setq button (apply 'widget-create-child-and-convert
+ (setq button (apply #'widget-create-child-and-convert
widget 'radio-button
:value (not (null chosen))
button-args)))
@@ -2715,11 +2700,8 @@ Return an alist of (TYPE MATCH)."
;; We can't just delete and recreate a radio widget, since children
;; can be added after the original creation and won't be recreated
;; by `:create'.
- (let ((children (widget-get widget :children))
- current found)
- (while children
- (setq current (car children)
- children (cdr children))
+ (let (found)
+ (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button))
(match (and (not found)
(widget-apply current :match value))))
@@ -2746,13 +2728,9 @@ Return an alist of (TYPE MATCH)."
(defun widget-radio-action (widget child event)
;; Check if a radio button was pressed.
- (let ((children (widget-get widget :children))
- (buttons (widget-get widget :buttons))
- current)
+ (let ((buttons (widget-get widget :buttons)))
(when (memq child buttons)
- (while children
- (setq current (car children)
- children (cdr children))
+ (dolist (current (widget-get widget :children))
(let* ((button (widget-get current :button)))
(cond ((eq child button)
(widget-value-set button t)
@@ -2822,7 +2800,7 @@ Return an alist of (TYPE MATCH)."
(and (widget--should-indent-p)
(widget-get widget :indent)
(insert-char ?\s (widget-get widget :indent)))
- (apply 'widget-create-child-and-convert
+ (apply #'widget-create-child-and-convert
widget 'insert-button
(widget-get widget :append-button-args)))
(t
@@ -2842,9 +2820,9 @@ Return an alist of (TYPE MATCH)."
(if answer
(setq children (cons (widget-editable-list-entry-create
widget
- (if (widget-inline-p type t)
- (car answer)
- (car (car answer)))
+ (car (if (widget-inline-p type t)
+ answer
+ (car answer)))
t)
children)
value (cdr answer))
@@ -2853,8 +2831,8 @@ Return an alist of (TYPE MATCH)."
(defun widget-editable-list-value-get (widget)
;; Get value of the child widget.
- (apply 'append (mapcar (lambda (child) (widget-apply child :value-inline))
- (widget-get widget :children))))
+ (apply #'append (mapcar (lambda (child) (widget-apply child :value-inline))
+ (widget-get widget :children))))
(defun widget-editable-list-match (widget value)
;; Value must be a list and all the members must match the type.
@@ -2885,27 +2863,26 @@ The new widget gets inserted at the position of the
BEFORE child."
(last-deleted (when-let ((lst (widget-get widget :last-deleted)))
(prog1
(pop lst)
- (widget-put widget :last-deleted lst))))
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (cond (before
- (goto-char (widget-get before :entry-from)))
- (t
- (goto-char (widget-get widget :value-pos))))
- (let ((child (widget-editable-list-entry-create
- widget (and last-deleted
- (widget-apply last-deleted
- :value-to-external
- (widget-get last-deleted
:value)))
- last-deleted)))
- (when (< (widget-get child :entry-from) (widget-get widget :from))
- (set-marker (widget-get widget :from)
- (widget-get child :entry-from)))
- (if (eq (car children) before)
- (widget-put widget :children (cons child children))
- (while (not (eq (car (cdr children)) before))
- (setq children (cdr children)))
- (setcdr children (cons child (cdr children)))))))
+ (widget-put widget :last-deleted lst)))))
+ (widget--allow-insertion
+ (cond (before
+ (goto-char (widget-get before :entry-from)))
+ (t
+ (goto-char (widget-get widget :value-pos))))
+ (let ((child (widget-editable-list-entry-create
+ widget (and last-deleted
+ (widget-apply last-deleted
+ :value-to-external
+ (widget-get last-deleted
:value)))
+ last-deleted)))
+ (when (< (widget-get child :entry-from) (widget-get widget :from))
+ (set-marker (widget-get widget :from)
+ (widget-get child :entry-from)))
+ (if (eq (car children) before)
+ (widget-put widget :children (cons child children))
+ (while (not (eq (car (cdr children)) before))
+ (setq children (cdr children)))
+ (setcdr children (cons child (cdr children))))))))
(widget-setup)
(widget-apply widget :notify widget))
@@ -2921,25 +2898,19 @@ Save CHILD into the :last-deleted list, so it can be
inserted later."
(widget-put widget :last-deleted lst))
;; Delete child from list of children.
(save-excursion
- (let ((buttons (copy-sequence (widget-get widget :buttons)))
- button
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (while buttons
- (setq button (car buttons)
- buttons (cdr buttons))
- (when (eq (widget-get button :widget) child)
- (widget-put widget
- :buttons (delq button (widget-get widget :buttons)))
- (widget-delete button))))
+ (widget--allow-insertion
+ (dolist (button (copy-sequence (widget-get widget :buttons)))
+ (when (eq (widget-get button :widget) child)
+ (widget-put widget
+ :buttons (delq button (widget-get widget :buttons)))
+ (widget-delete button))))
(let ((entry-from (widget-get child :entry-from))
- (entry-to (widget-get child :entry-to))
- (inhibit-read-only t)
- (inhibit-modification-hooks t))
- (widget-delete child)
- (delete-region entry-from entry-to)
- (set-marker entry-from nil)
- (set-marker entry-to nil))
+ (entry-to (widget-get child :entry-to)))
+ (widget--allow-insertion
+ (widget-delete child)
+ (delete-region entry-from entry-to)
+ (set-marker entry-from nil)
+ (set-marker entry-to nil)))
(widget-put widget :children (delq child (widget-get widget :children))))
(widget-setup)
(widget-apply widget :notify widget))
@@ -2962,19 +2933,17 @@ Save CHILD into the :last-deleted list, so it can be
inserted later."
(cond ((eq escape ?%)
(insert ?%))
((eq escape ?i)
- (setq insert (apply 'widget-create-child-and-convert
+ (setq insert (apply #'widget-create-child-and-convert
widget 'insert-button
(widget-get widget :insert-button-args))))
((eq escape ?d)
- (setq delete (apply 'widget-create-child-and-convert
+ (setq delete (apply #'widget-create-child-and-convert
widget 'delete-button
(widget-get widget :delete-button-args))))
((eq escape ?v)
- (if conv
- (setq child (widget-create-child-value
- widget type value))
- (setq child (widget-create-child-value
- widget type (widget-default-get type)))))
+ (setq child (widget-create-child-value
+ widget type
+ (if conv value (widget-default-get type)))))
(t
(error "Unknown escape `%c'" escape)))))
(let ((buttons (widget-get widget :buttons)))
@@ -3014,13 +2983,10 @@ Save CHILD into the :last-deleted list, so it can be
inserted later."
(defun widget-group-value-create (widget)
;; Create each component.
- (let ((args (widget-get widget :args))
- (value (widget-get widget :value))
- arg answer children)
- (while args
- (setq arg (car args)
- args (cdr args)
- answer (widget-match-inline arg value)
+ (let ((value (widget-get widget :value))
+ answer children)
+ (dolist (arg (widget-get widget :args))
+ (setq answer (widget-match-inline arg value)
value (cdr answer))
(and (widget--should-indent-p)
(widget-get widget :indent)
@@ -3036,7 +3002,7 @@ Save CHILD into the :last-deleted list, so it can be
inserted later."
(defun widget-group-default-get (widget)
;; Get the default of the components.
- (mapcar 'widget-default-get (widget-get widget :args)))
+ (mapcar #'widget-default-get (widget-get widget :args)))
(defun widget-group-match (widget vals)
;; Match if the components match.
@@ -3094,20 +3060,20 @@ The following properties have special meanings for this
widget:
"Display documentation for WIDGET's value. Ignore optional argument EVENT."
(let* ((string (widget-get widget :value))
(symbol (intern string)))
- (if (and (fboundp symbol) (boundp symbol))
- ;; If there are two doc strings, give the user a way to pick one.
- (apropos (concat "\\`" (regexp-quote string) "\\'"))
- (cond
- ((fboundp symbol)
- (describe-function symbol))
- ((facep symbol)
- (describe-face symbol))
- ((featurep symbol)
- (describe-package symbol))
- ((or (boundp symbol) (get symbol 'variable-documentation))
- (describe-variable symbol))
- (t
- (message "No documentation available for %s" symbol))))))
+ (cond
+ ((and (fboundp symbol) (boundp symbol))
+ ;; If there are two doc strings, give the user a way to pick one.
+ (apropos (concat "\\`" (regexp-quote string) "\\'")))
+ ((fboundp symbol)
+ (describe-function symbol))
+ ((facep symbol)
+ (describe-face symbol))
+ ((featurep symbol)
+ (describe-package symbol))
+ ((or (boundp symbol) (get symbol 'variable-documentation))
+ (describe-variable symbol))
+ (t
+ (message "No documentation available for %s" symbol)))))
(defcustom widget-documentation-links t
"Add hyperlinks to documentation strings when non-nil."
@@ -3240,7 +3206,7 @@ Optional ARGS specifies additional keyword arguments for
the
(unless (or (numberp doc-indent) (null doc-indent))
(setq doc-indent 0))
(widget-put widget :buttons
- (cons (apply 'widget-create-child-and-convert
+ (cons (apply #'widget-create-child-and-convert
widget 'documentation-string
:indent doc-indent
(nconc args (list doc)))
@@ -3352,18 +3318,18 @@ It reads a file name from an editable text field."
(must-match (widget-get widget :must-match)))
(read-file-name (format-prompt prompt value) dir nil must-match
file)))))
-;;;(defun widget-file-action (widget &optional event)
-;;; ;; Read a file name from the minibuffer.
-;;; (let* ((value (widget-value widget))
-;;; (dir (file-name-directory value))
-;;; (file (file-name-nondirectory value))
-;;; (menu-tag (widget-apply widget :menu-tag-get))
-;;; (must-match (widget-get widget :must-match))
-;;; (answer (read-file-name (format-prompt menu-tag value)
-;;; dir nil must-match file)))
-;;; (widget-value-set widget (abbreviate-file-name answer))
-;;; (widget-setup)
-;;; (widget-apply widget :notify widget event)))
+;;(defun widget-file-action (widget &optional event)
+;; ;; Read a file name from the minibuffer.
+;; (let* ((value (widget-value widget))
+;; (dir (file-name-directory value))
+;; (file (file-name-nondirectory value))
+;; (menu-tag (widget-apply widget :menu-tag-get))
+;; (must-match (widget-get widget :must-match))
+;; (answer (read-file-name (format-prompt menu-tag value)
+;; dir nil must-match file)))
+;; (widget-value-set widget (abbreviate-file-name answer))
+;; (widget-setup)
+;; (widget-apply widget :notify widget event)))
;; Fixme: use file-name-as-directory.
(define-widget 'directory 'file
@@ -3552,7 +3518,7 @@ It reads a directory name from an editable text field."
(if (stringp value)
(if (string-match "\\`[[:space:]]*\\'" value)
widget-key-sequence-default-value
- (read-kbd-macro value))
+ (key-parse value))
value))
@@ -3825,7 +3791,7 @@ or a list with the default value of each component of the
list WIDGET."
:format "%{%t%}:\n%v"
:match 'widget-vector-match
:value-to-internal (lambda (_widget value) (append value nil))
- :value-to-external (lambda (_widget value) (apply 'vector value)))
+ :value-to-external (lambda (_widget value) (apply #'vector value)))
(defun widget-vector-match (widget value)
(and (vectorp value)
@@ -3840,7 +3806,7 @@ or a list with the default value of each component of the
list WIDGET."
:value-to-internal (lambda (_widget value)
(list (car value) (cdr value)))
:value-to-external (lambda (_widget value)
- (apply 'cons value)))
+ (apply #'cons value)))
(defun widget-cons-match (widget value)
(and (consp value)
@@ -3927,7 +3893,7 @@ example:
(args (if options
(list `(checklist :inline t
:greedy t
- ,@(mapcar 'widget-plist-convert-option
+ ,@(mapcar #'widget-plist-convert-option
options))
other)
(list other))))
@@ -3940,9 +3906,7 @@ example:
(if (listp option)
(let ((key (nth 0 option)))
(setq value-type (nth 1 option))
- (if (listp key)
- (setq key-type key)
- (setq key-type `(const ,key))))
+ (setq key-type (if (listp key) key `(const ,key))))
(setq key-type `(const ,option)
value-type widget-plist-value-type))
`(group :format "Key: %v" :inline t ,key-type ,value-type)))
@@ -3972,7 +3936,7 @@ example:
(args (if options
(list `(checklist :inline t
:greedy t
- ,@(mapcar 'widget-alist-convert-option
+ ,@(mapcar #'widget-alist-convert-option
options))
other)
(list other))))
@@ -3985,9 +3949,7 @@ example:
(if (listp option)
(let ((key (nth 0 option)))
(setq value-type (nth 1 option))
- (if (listp key)
- (setq key-type key)
- (setq key-type `(const ,key))))
+ (setq key-type (if (listp key) key `(const ,key))))
(setq key-type `(const ,option)
value-type widget-alist-value-type))
`(cons :format "Key: %v" ,key-type ,value-type)))
@@ -4045,17 +4007,13 @@ current choice is inline."
((and widget-choice-toggle
(= (length args) 2)
(memq old args))
- (if (eq old (nth 0 args))
- (nth 1 args)
- (nth 0 args)))
+ (nth (if (eq old (nth 0 args)) 1 0)
+ args))
(t
- (while args
- (setq current (car args)
- args (cdr args))
- (setq choices
- (cons (cons (widget-apply current :menu-tag-get)
- current)
- choices)))
+ (dolist (current args)
+ (push (cons (widget-apply current :menu-tag-get)
+ current)
+ choices))
(let ((val (completing-read prompt choices nil t)))
(if (stringp val)
(let ((try (try-completion val choices)))
@@ -4206,7 +4164,7 @@ is inline."
(help-echo (and widget (widget-get widget :help-echo))))
(if (functionp help-echo)
(setq help-echo (funcall help-echo widget)))
- (if help-echo (message "%s" (eval help-echo)))))
+ (if help-echo (message "%s" (eval help-echo t)))))
(define-obsolete-function-alias 'widget-sublist #'seq-subseq "28.1")
(define-obsolete-function-alias 'widget-visibility-value-create
diff --git a/lisp/window.el b/lisp/window.el
index 0037e69f4fe..e399f8da837 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -6286,7 +6286,8 @@ value can be also stored on disk and read back in a new
session."
(when state
(let* ((old-buffer-or-name (car state))
(buffer (get-buffer old-buffer-or-name))
- (state (cdr state)))
+ (state (cdr state))
+ (dedicated (cdr (assq 'dedicated state))))
(if (buffer-live-p buffer)
(with-current-buffer buffer
(set-window-buffer window buffer)
@@ -6345,7 +6346,7 @@ value can be also stored on disk and read back in a new
session."
window delta t ignore nil nil nil pixelwise))
(window-resize window delta t ignore pixelwise))))
;; Set dedicated status.
- (set-window-dedicated-p window (cdr (assq 'dedicated state)))
+ (set-window-dedicated-p window dedicated)
;; Install positions (maybe we should do this after all
;; windows have been created and sized).
(ignore-errors
@@ -6388,12 +6389,12 @@ value can be also stored on disk and read back in a new
session."
(set-marker (make-marker) m2
buffer))))))
prev-buffers))))
- ;; We don't want to raise an error in case the buffer does
- ;; not exist anymore, so we switch to a previous one and
- ;; save the window with the intention of deleting it later
- ;; if possible.
- (switch-to-prev-buffer window)
- (if window-kept-windows-functions
+ (unless (window-minibuffer-p window)
+ ;; Preferably show a buffer previously shown in this
+ ;; window.
+ (switch-to-prev-buffer window)
+ (cond
+ ((functionp window-restore-killed-buffer-windows)
(let* ((start (cdr (assq 'start state)))
;; Handle both - marker positions from writable
;; states and markers from non-writable states.
@@ -6404,9 +6405,15 @@ value can be also stored on disk and read back in a new
session."
(point-pos (if (markerp point)
(marker-last-position point)
point)))
- (push (list window old-buffer-or-name start-pos point-pos)
- window-state-put-kept-windows))
- (push window window-state-put-stale-windows))))))))
+ (push (list window old-buffer-or-name
+ start-pos point-pos dedicated nil)
+ window-state-put-kept-windows)))
+ ((or (and dedicated
+ (eq window-restore-killed-buffer-windows 'dedicated))
+ (memq window-restore-killed-buffer-windows '(nil delete)))
+ ;; Try to delete the window.
+ (push window window-state-put-stale-windows)))
+ (set-window-dedicated-p window nil))))))))
(defun window-state-put (state &optional window ignore)
"Put window state STATE into WINDOW.
@@ -6421,16 +6428,9 @@ sizes and fixed size restrictions. IGNORE equal `safe'
means
windows can get as small as `window-safe-min-height' and
`window-safe-min-width'.
-If the abnormal hook `window-kept-windows-functions' is non-nil,
-do not delete any windows saved by STATE whose buffers were
-deleted since STATE was saved. Rather, show some live buffer in
-them and call the functions in `window-kept-windows-functions'
-with a list of two arguments: the frame where STATE was put and a
-list of entries for each such window. Each entry contains four
-elements - the window, its old buffer and the last positions of
-`window-start' and `window-point' for the buffer in that window.
-Always check the window for liveness because another function run
-by this hook may have deleted it."
+If this function tries to restore a non-minibuffer window whose buffer
+was killed since STATE was made, it will consult the variable
+`window-restore-killed-buffer-windows' on how to proceed."
(setq window-state-put-stale-windows nil)
(setq window-state-put-kept-windows nil)
@@ -6544,10 +6544,9 @@ by this hook may have deleted it."
(when (and (window-valid-p window)
(eq (window-deletable-p window) t))
(delete-window window))))
- (when window-kept-windows-functions
- (run-hook-with-args
- 'window-kept-windows-functions
- frame window-state-put-kept-windows)
+ (when (functionp window-restore-killed-buffer-windows)
+ (funcall window-restore-killed-buffer-windows
+ frame window-state-put-kept-windows 'state)
(setq window-state-put-kept-windows nil))
(window--check frame))))
@@ -8669,11 +8668,11 @@ buffer. ALIST is a buffer display action alist as
compiled by
use time is higher than this.
- `window-min-width' specifies a preferred minimum width in
- canonical frame columns. If it is the constant `full-width',
+ canonical frame columns. If it is the symbol `full-width',
prefer a full-width window.
- `window-min-height' specifies a preferred minimum height in
- canonical frame lines. If it is the constant `full-height',
+ canonical frame lines. If it is the symbol `full-height',
prefer a full-height window.
If ALIST contains a non-nil `inhibit-same-window' entry, do not
@@ -8800,11 +8799,11 @@ Distinctive features are:
call.
`window-min-width' specifies a preferred minimum width in
- canonical frame columns. If it is the constant `full-width',
+ canonical frame columns. If it is the symbol `full-width',
prefer a full-width window.
`window-min-height' specifies a preferred minimum height in
- canonical frame lines. If it is the constant `full-height',
+ canonical frame lines. If it is the symbol `full-height',
prefer a full-height window.
- If the preceding steps fail, try to pop up a new window on the
diff --git a/m4/ndk-build.m4 b/m4/ndk-build.m4
index aacb2ed048b..7012471e046 100644
--- a/m4/ndk-build.m4
+++ b/m4/ndk-build.m4
@@ -21,10 +21,6 @@ AC_ARG_WITH([ndk_path],
[AS_HELP_STRING([--with-ndk-path],
[find Android libraries in these directories])])
-AC_ARG_WITH([ndk_cxx_shared],
- [AS_HELP_STRING([--with-ndk-cxx-shared],
- [name of the C++ standard library included with the NDK])])
-
AC_ARG_WITH([ndk_cxx],
[AS_HELP_STRING([--with-ndk-cxx],
[name of the C++ compiler included with the NDK])])
@@ -59,6 +55,7 @@ ndk_DIR=$3
ndk_ANY_CXX=
ndk_BUILD_CFLAGS="$4"
ndk_working_cxx=no
+ndk_CXX_SHARED=
AS_CASE(["$ndk_ABI"],
[*arm64*], [ndk_ARCH=arm64],
@@ -149,7 +146,7 @@ ndk_resolve_import_module () {
for ndk_android_mk in $ndk_module_files; do
# Read this Android.mk file. Set NDK_ROOT to /tmp: the Android in
- # tree build system sets it to a meaning value, but build files
+ # tree build system sets it to a meaningful value, but build files
# just use it to test whether or not the NDK is being used.
ndk_commands=`ndk_run_test`
eval "$ndk_commands"
@@ -169,13 +166,14 @@ that could not be found in the list of directories
specified in \
ndk_ANY_CXX=yes
fi
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but it was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \
+ && test -z "$ndk_CXX_LDFLAGS"],
+ [AC_MSG_ERROR([The module $1 requires a C++ standard library,
+but none were found.])])
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but a working C++ compiler was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"],
+ [AC_MSG_ERROR([The module [$]1 requires the C++ standard library,
+but a working C++ compiler was not found.])])
AC_MSG_RESULT([yes])
@@ -227,6 +225,88 @@ ndk_subst_cc_onto_cxx () {
done
}
+# ndk_subst_cflags_onto_cxx
+# ---------------------
+# Print any options in CFLAGS also suitable for a C++ compiler.
+
+ndk_subst_cflags_onto_cxx () {
+ ndk_flag=
+ for ndk_word in $CFLAGS; do
+ AS_IF([test "$ndk_flag" = "yes"],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=no],
+ [AS_CASE([$ndk_word],
+ [*-sysroot=*],
+ [AS_ECHO_N(["$ndk_word "])],
+ [*-isystem*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [*-I*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [*-sysroot*],
+ [AS_ECHO_N(["$ndk_word "])
+ ndk_flag=yes],
+ [-D__ANDROID_API__*],
+ [AS_ECHO_N(["$ndk_word "])])])
+ done
+}
+
+# Detect the installation directory and type of the NDK being used.
+
+ndk_install_dir=
+ndk_toolchain_type=
+
+AC_MSG_CHECKING([for the directory where the NDK is installed])
+
+dnl If the install directory isn't available, repeat the search over
+dnl each entry in the programs directory.
+ndk_programs_dirs=`$CC -print-search-dirs | sed -n "s/^programs:[[\t
]]*=\?\(.*\)/\1/p"`
+ndk_save_IFS=$IFS; IFS=:
+for ndk_dir in $ndk_programs_dirs; do
+ if test -d "$ndk_dir"; then :; else
+ continue
+ fi
+ ndk_dir=`cd "$ndk_dir"; pwd`
+ while test "$ndk_dir" != "/" && test -z "$ndk_toolchain_type"; do
+ ndk_dir=`AS_DIRNAME([$ndk_dir])`
+ AS_IF([test -d "$ndk_dir/bin" && test -d "$ndk_dir/lib"],
+ [dnl The directory reached is most likely either the directory
+ dnl holding prebuilt binaries in a combined toolchain or the
+ dnl directory holding a standalone toolchain itself.
+ dnl
+ dnl Distinguish between the two by verifying the name of the
+ dnl parent directory (and its parent).
+ ndk_dir1=`AS_DIRNAME(["$ndk_dir"])`
+ ndk_basename=`AS_BASENAME(["$ndk_dir1"])`
+ AS_IF([test "$ndk_basename" = "prebuilt"],
+ [dnl Directories named "prebuilt" are exclusively present in
+ dnl combined toolchains, where they are children of the
+ dnl base directory or, in recent releases, a directory
+ dnl within the base directory. Continue searching for the
+ dnl base directory.
+ ndk_toolchain_type=combined
+ while test "$ndk_dir1" != "/"; do
+ AS_IF([test -d "$ndk_dir1/toolchains" \
+ && test -d "$ndk_dir1/sources"],
+ [ndk_install_dir=$ndk_dir1
+ break])
+ ndk_dir1=`AS_DIRNAME(["$ndk_dir1"])`
+ done],
+ [ndk_toolchain_type=standalone
+ ndk_install_dir=$ndk_dir])])
+ done
+ AS_IF([test -n "$ndk_toolchain_type"],
+ [break])
+done
+IFS=$ndk_save_IFS
+
+AS_IF([test -z "$ndk_install_dir"],
+ [AC_MSG_RESULT([unknown])
+ AC_MSG_WARN([The NDK installation directory could not be \
+derived from the compiler.])],
+ [AC_MSG_RESULT([$ndk_install_dir ($ndk_toolchain_type)])])
+
# Look for a suitable ar and ranlib in the same directory as the C
# compiler.
ndk_cc_firstword=`AS_ECHO(["$CC"]) | cut -d' ' -f1`
@@ -259,72 +339,8 @@ NDK_BUILD_NASM=
AS_IF([test "$ndk_ARCH" = "x86" || test "$ndk_ARCH" = "x86_64"],
[AC_CHECK_PROGS([NDK_BUILD_NASM], [nasm])])
-# Look for a file named ``libc++_shared.so'' in a subdirectory of
-# $ndk_where_cc if it was not specified.
-AC_MSG_CHECKING([for libc++_shared.so])
-
-ndk_where_toolchain=
-AS_IF([test -z "$with_ndk_cxx_shared" && test -n "$ndk_where_cc"],[
- # Find the NDK root directory. Go to $ndk_where_cc.
- SAVE_PWD=`pwd`
- cd `AS_DIRNAME(["$ndk_where_cc"])`
-
- # Now, keep moving backwards until pwd ends with ``toolchains''.
- while :; do
- if test "`pwd`" = "/"; then
- cd "$SAVE_PWD"
- break
- fi
-
- ndk_pwd=`pwd`
- if test "`AS_BASENAME([$ndk_pwd])`" = "toolchains"; then
- ndk_where_toolchain=$ndk_pwd
- cd "$SAVE_PWD"
- break
- fi
-
- cd ..
- done
-
- ndk_matching_libcxx_shared_so=
-
- # The toolchain directory should be in "$ndk_where_toolchain".
- AS_IF([test -n "$ndk_where_toolchain"],[
- # Now, look in the directory behind it.
- ndk_cxx_shared_so=`find "$ndk_where_toolchain" -name libc++_shared.so`
-
- # Look for one with the correct architecture.
- for ndk_candidate in $ndk_cxx_shared_so; do
- AS_CASE([$ndk_candidate],
- [*arm-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "arm"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*aarch64-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "arm64"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*i[[3-6]]86-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "x86"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])],
- [*x86_64-linux-android*],
- [AS_IF([test "$ndk_ARCH" = "x86_64"],
- [ndk_matching_libcxx_shared_so=$ndk_candidate])])
-
- AS_IF([test -n "$ndk_matching_libcxx_shared_so"],
- [with_ndk_cxx_shared=$ndk_matching_libcxx_shared_so])
- done])])
-
-AS_IF([test -z "$with_ndk_cxx_shared"],[AC_MSG_RESULT([no])
- AC_MSG_WARN([The C++ standard library could not be found. \
-If you try to build Emacs with a dependency that requires the C++ standard \
-library, Emacs will not build correctly, unless you manually specify the \
-name of an appropriate ``libc++_shared.so'' binary.])],
- [AC_MSG_RESULT([$with_ndk_cxx_shared])])
-
-ndk_CXX_SHARED=$with_ndk_cxx_shared
-
-# These variables have now been found. Now look for a C++ compiler.
-# Upon failure, pretend the C compiler is a C++ compiler and use that
-# instead.
+# Search for a C++ compiler. Upon failure, pretend the C compiler is a
+# C++ compiler and use that instead.
ndk_cc_name=`AS_BASENAME(["${ndk_cc_firstword}"])`
ndk_cxx_name=
@@ -338,8 +354,162 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx],
[], [`AS_DIRNAME(["$ndk_where_cc"])`:$PATH])
AS_IF([test -z "$CXX"], [CXX=`ndk_filter_cc_for_cxx`],
[CXX=`ndk_subst_cc_onto_cxx`])])
+
+# None of the C++ standard libraries installed with Android are
+# available to NDK programs, which are expected to select one of several
+# standard libraries distributed with the NDK. This library must be
+# extracted from the NDK by the program's build system and copied into
+# the application directory, and the build system is also expected to
+# provide the compiler with suitable options to enable it.
+#
+# Emacs, on recent releases of the NDK, prefers the libc++ library, the
+# most complete of the libraries available, when it detects the presence
+# of its headers and libraries in the compiler's search path. Next in
+# line are the several libraries located in a directory named `cxx-stl'
+# inside the NDK distribution, of which Emacs prefers, in this order,
+# the GNU libstdc++, stlport, gabi and the system C++ library. The
+# scope of the last two is confined to providing runtime support for
+# basic C++ operations, and is useless for compiling most C++
+# dependencies whose requirements go beyond such operations.
+#
+# The NDK comes in two forms. In a "combined toolchain", all C++
+# libraries are present in the NDK directory and the responsibility is
+# left to the build system to locate and select the best C++ library,
+# whereas in a "standalone toolchain" an STL will have already been
+# specified a C++ library, besides which no others will be present.
+#
+# Though Android.mk files are provided by the NDK for each such library,
+# Emacs cannot use any of these, both for lack of prebuilt support in
+# its ndk-build implementation, and since they are absent from combined
+# toolchains.
+
+ndk_CXX_SHARED=
+ndk_CXX_STL=
+ndk_CXX_LDFLAGS=
+
+AS_IF([test -n "$CXX" && test -n "$ndk_install_dir"],
+ [ndk_library_dirs=`$CXX -print-search-dirs \
+ | sed -n "s/^libraries:[[\t ]]*=\?\(.*\)/\1/p"`
+ AS_IF([test "$ndk_toolchain_type" = "standalone"],
+ [dnl With a standalone toolchain, just use the first C++ library
+ dnl present in the compiler's library search path, that being the
+ dnl only C++ library that will ever be present.
+ ndk_save_IFS=$IFS; IFS=:
+ for ndk_dir in $ndk_library_dirs; do
+ if test -d "$ndk_dir"; then :; else
+ continue
+ fi
+ ndk_dir=`cd "$ndk_dir"; pwd`
+ if test -f "$ndk_dir/libc++_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libc++_shared.so"
+ ndk_CXX_LDFLAGS=-lc++_shared; break
+ elif test -f "$ndk_dir/libgnustl_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libgnustl_shared.so"
+ ndk_CXX_LDFLAGS=-lgnustl_shared; break
+ elif test -f "$ndk_dir/libstlport_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libstlport_shared.so"
+ ndk_CXX_LDFLAGS=-lstlport_shared; break
+ fi
+ done
+ IFS=$ndk_save_IFS],
+ [dnl Otherwise, search for a suitable standard library
+ dnl in the order stated above.
+ dnl
+ dnl Detect if this compiler is configured to link against libc++ by
+ dnl default.
+ AC_MSG_CHECKING([whether compiler defaults to libc++])
+ cat <<_ACEOF >conftest.cc
+#include <string>
+#ifndef _LIBCPP_VERSION
+Not libc++!
+#endif /* _LIBCPP_VERSION */
+
+int
+main (void)
+{
+
+}
+_ACEOF
+ AS_IF([$CXX conftest.cc -o conftest.o >&AS_MESSAGE_LOG_FD 2>&1],
+ [dnl The compiler defaults to libc++.
+ AC_MSG_RESULT([yes])
+ ndk_save_IFS=$IFS; IFS=:
+ for ndk_dir in $ndk_library_dirs; do
+ if test -f "$ndk_dir/libc++_shared.so"; then
+ ndk_CXX_SHARED="$ndk_dir/libc++_shared.so"
+ ndk_CXX_LDFLAGS=-lc++_shared; break
+ fi
+ done
+ IFS=$ndk_save_IFS],
+ [dnl Search for gnustl, stlport, gabi, and failing that, system.
+ dnl The name of the gabi system root directory varies by GCC
+ dnl version.
+ AC_MSG_RESULT([no])
+ ndk_gcc_version=`($CXX -v 2>&1) \
+ | sed -n "s/^gcc version \([[0123456789]\+.[0123456789]\+]\).*/\1/p"`
+ cxx_stl="$ndk_install_dir/sources/cxx-stl"
+ ndk_cxx_stl_base="$cxx_stl/gnu-libstdc++/$ndk_gcc_version"
+ AS_IF([test -n "$ndk_gcc_version" \
+ && test -d "$ndk_cxx_stl_base/libs/$ndk_ABI"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lgnustl_shared"
+ ndk_CXX_LDFLAGS="$ndk_CXX_LDFLAGS -lsupc++"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include"
+ ndk_CXX_STL="$ndk_CXX_STL -isystem
$ndk_cxx_stl_base/libs/$ndk_ABI/include"
+
ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libgnustl_shared.so"])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [dnl No STL was located or the library is not reachable.
+ dnl Search for alternatives.
+ ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/stlport"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI
-lstlport_shared"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/stlport"
+
ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/libstlport_shared.so"])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/gabi++"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI
-lgabi++_shared"
+ ndk_CXX_STL="$ndk_CXX_STL -isystem $ndk_cxx_stl_base/include"
+
ndk_CXX_SHARED="$ndk_cxx_stl_base/libs/$ndk_ABI/lgabi++_shared.so"])])
+ AS_IF([test -f "$ndk_CXX_SHARED"], [],
+ [ndk_CXX_STL=
+ ndk_CXX_SHARED=
+ ndk_CXX_LDFLAGS=
+ ndk_cxx_stl_base="$cxx_stl/system"
+ AS_IF([test -d "$ndk_cxx_stl_base"],
+ [ndk_CXX_LDFLAGS="-L$ndk_cxx_stl_base/libs/$ndk_ABI -lstdc++"
+ ndk_CXX_STL="-isystem $ndk_cxx_stl_base/include"
+ dnl The "system" library is distributed with Android and
+ dnl need not be present in app packages.
+ ndk_CXX_SHARED=
+ dnl Done.
+ ])])])])
+ rm -f conftest.o])])
+
+AS_ECHO([])
+AS_ECHO(["C++ compiler configuration: "])
+AS_ECHO([])
+AS_ECHO(["Library includes : $ndk_CXX_STL"])
+AS_ECHO(["Linker options : $ndk_CXX_LDFLAGS"])
+AS_ECHO(["Library file (if any) : $ndk_CXX_SHARED"])
+AS_ECHO([])
])
+# ndk_LATE_EARLY
+# --------------
+# Call before ndk_LATE to establish certain variables in time for
+# ndk_LATE's C++ compiler detection.
+
+AC_DEFUN([ndk_LATE_EARLY],
+[ndk_save_LDFLAGS="$LDFLAGS"
+ LDFLAGS="$LDFLAGS $ndk_CXX_LDFLAGS"
+ CXXFLAGS="$CXXFLAGS `ndk_subst_cflags_onto_cxx` $ndk_CXX_STL"])
+
# ndk_LATE
# --------
# Perform late initialization of the ndk-build system by checking for
@@ -347,17 +517,14 @@ AS_IF([test -n "$with_ndk_cxx"], [CXX=$with_ndk_cxx],
AC_DEFUN([ndk_LATE],
[dnl
-dnl This calls AC_REQUIRE([AC_PROG_CXX]), leading to configure looking
-dnl for a C++ compiler. However, the language is not restored
-dnl afterwards if not `$ndk_INITIALIZED'.
AS_IF([test "$ndk_INITIALIZED" = "yes"],[
- AS_IF([test -n "$CXX"], [AC_LANG_PUSH([C++])
+ AS_IF([test -n "$CXX"], [
+ AC_LANG_PUSH([C++])
AC_CHECK_HEADER([string], [ndk_working_cxx=yes],
- [AC_MSG_WARN([Your C++ compiler is not properly set up, and\
- the standard library headers could not be found.])])
+ [AC_MSG_WARN([Your C++ compiler is not properly configured, as \
+the standard library headers could not be found.])])
AC_LANG_POP([C++])])])
-dnl Thus, manually switch back to C here.
-AC_LANG([C])
+LDFLAGS="$ndk_save_LDFLAGS"
])
# ndk_SEARCH_MODULE(MODULE, NAME, ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND])
@@ -396,13 +563,14 @@ else
ndk_ANY_CXX=yes
fi
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test -z "$with_ndk_cxx_shared"],
- [AC_MSG_ERROR([The module $1 requires the C++ standard library \
-(libc++_shared.so), but it was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test -z "$ndk_CXX_STL" \
+ && test -z "$ndk_CXX_LDFLAGS"],
+ [AC_MSG_ERROR([The module $1 requires a C++ standard library,
+but none were found.])])
- AS_IF([test "$ndk_ANY_CXX" = "yes" && test "$ndk_working_cxx" != "yes"],
- [AC_MSG_ERROR([The module [$]1 requires the C++ standard library \
-(libc++_shared.so), but a working C++ compiler was not found.])])
+ AS_IF([test "$module_cxx_deps" = "yes" && test "$ndk_working_cxx" != "yes"],
+ [AC_MSG_ERROR([The module [$]1 requires the C++ standard library,
+but a working C++ compiler was not found.])])
$2[]_CFLAGS="[$]$2[]_CFLAGS $module_cflags $module_includes"
$2[]_LIBS="[$]$2[]_LIBS $module_ldflags"
@@ -457,6 +625,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES],
NDK_BUILD_AR=$AR
NDK_BUILD_MODULES="$ndk_MODULES"
NDK_BUILD_CXX_SHARED="$ndk_CXX_SHARED"
+ NDK_BUILD_CXX_STL="$ndk_CXX_STL"
+ NDK_BUILD_CXX_LDFLAGS="$ndk_CXX_LDFLAGS"
NDK_BUILD_ANY_CXX_MODULE=$ndk_ANY_CXX
NDK_BUILD_CFLAGS="$ndk_BUILD_CFLAGS"
@@ -470,6 +640,8 @@ AC_DEFUN_ONCE([ndk_CONFIG_FILES],
AC_SUBST([NDK_BUILD_NASM])
AC_SUBST([NDK_BUILD_MODULES])
AC_SUBST([NDK_BUILD_CXX_SHARED])
+ AC_SUBST([NDK_BUILD_CXX_STL])
+ AC_SUBST([NDK_BUILD_CXX_LDFLAGS])
AC_SUBST([NDK_BUILD_ANY_CXX_MODULE])
AC_SUBST([NDK_BUILD_CFLAGS])
diff --git a/src/androidselect.c b/src/androidselect.c
index 521133976a7..2f6114d0fcb 100644
--- a/src/androidselect.c
+++ b/src/androidselect.c
@@ -526,7 +526,7 @@ android_init_emacs_desktop_notification (void)
FIND_METHOD (init, "<init>", "(Ljava/lang/String;"
"Ljava/lang/String;Ljava/lang/String;"
"Ljava/lang/String;II[Ljava/lang/String;"
- "[Ljava/lang/String;)V");
+ "[Ljava/lang/String;J)V");
FIND_METHOD (display, "display", "()V");
#undef FIND_METHOD
}
@@ -567,16 +567,17 @@ android_locate_icon (const char *name)
}
/* Display a desktop notification with the provided TITLE, BODY,
- REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, RESIDENT, ACTION_CB and
- CLOSE_CB. Return an identifier for the resulting notification. */
+ REPLACES_ID, GROUP, ICON, URGENCY, ACTIONS, TIMEOUT, RESIDENT,
+ ACTION_CB and CLOSE_CB. Return an identifier for the resulting
+ notification. */
static intmax_t
android_notifications_notify_1 (Lisp_Object title, Lisp_Object body,
Lisp_Object replaces_id,
Lisp_Object group, Lisp_Object icon,
Lisp_Object urgency, Lisp_Object actions,
- Lisp_Object resident, Lisp_Object action_cb,
- Lisp_Object close_cb)
+ Lisp_Object timeout, Lisp_Object resident,
+ Lisp_Object action_cb, Lisp_Object close_cb)
{
static intmax_t counter;
intmax_t id;
@@ -593,6 +594,7 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
jint nitems, i;
jstring item;
Lisp_Object length;
+ jlong timeout_val;
if (EQ (urgency, Qlow))
type = 2; /* IMPORTANCE_LOW */
@@ -603,6 +605,23 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
else
signal_error ("Invalid notification importance given", urgency);
+ /* Decode the timeout. */
+
+ timeout_val = 0;
+
+ if (!NILP (timeout))
+ {
+ CHECK_INTEGER (timeout);
+
+ if (!integer_to_intmax (timeout, &id)
+ || id > TYPE_MAXIMUM (jlong)
+ || id < TYPE_MINIMUM (jlong))
+ signal_error ("Invalid timeout", timeout);
+
+ if (id > 0)
+ timeout_val = id;
+ }
+
nitems = 0;
/* If ACTIONS is provided, split it into two arrays of Java strings
@@ -714,7 +733,8 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
notification_class.init,
title1, body1, group1,
identifier1, icon1, type,
- action_keys, action_titles);
+ action_keys, action_titles,
+ timeout_val);
android_exception_check_6 (title1, body1, group1, identifier1,
action_titles, action_keys);
@@ -723,12 +743,8 @@ android_notifications_notify_1 (Lisp_Object title,
Lisp_Object body,
ANDROID_DELETE_LOCAL_REF (body1);
ANDROID_DELETE_LOCAL_REF (group1);
ANDROID_DELETE_LOCAL_REF (identifier1);
-
- if (action_keys)
- ANDROID_DELETE_LOCAL_REF (action_keys);
-
- if (action_titles)
- ANDROID_DELETE_LOCAL_REF (action_titles);
+ ANDROID_DELETE_LOCAL_REF (action_keys);
+ ANDROID_DELETE_LOCAL_REF (action_titles);
/* Display the notification. */
(*android_java_env)->CallNonvirtualVoidMethod (android_java_env,
@@ -769,8 +785,14 @@ keywords is understood:
The action for which CALLBACK is called when the
notification itself is selected is named "default",
its existence is implied, and its TITLE is ignored.
- No more than three actions can be defined, not
- counting any action with "default" as its key.
+ No more than three actions defined here will be
+ displayed, not counting any with "default" as its
+ key.
+ :timeout Number of miliseconds from the display of the
+ notification at which it will be automatically
+ dismissed, or a value of zero or smaller if it
+ is to remain until user action is taken to dismiss
+ it.
:resident When set the notification will not be automatically
dismissed when it or an action is selected.
:on-action Function to call when an action is invoked.
@@ -780,12 +802,15 @@ keywords is understood:
with the notification id and the symbol `undefined'
for arguments.
-The notification group is ignored on Android 7.1 and earlier versions
-of Android. Outside such older systems, it identifies a category that
-will be displayed in the system Settings menu, and the urgency
-provided always extends to affect all notifications displayed within
-that category. If the group is not provided, it defaults to the
-string "Desktop Notifications".
+The notification group and timeout are ignored on Android 7.1 and
+earlier versions of Android. On more recent versions, the group
+identifies a category that will be displayed in the system Settings
+menu, and the urgency provided always extends to affect all
+notifications displayed within that category, though it may be ignored
+if higher than any previously-specified urgency or if the user have
+already configured a different urgency for this category from Settings.
+If the group is not provided, it defaults to the string "Desktop
+Notifications" with the urgency suffixed.
Each caller should strive to provide one unchanging combination of
notification group and urgency for each kind of notification it sends,
@@ -795,8 +820,8 @@ first notification sent to its notification group.
The provided icon should be the name of a "drawable resource" present
within the "android.R.drawable" class designating an icon with a
-transparent background. If no icon is provided (or the icon is absent
-from this system), it defaults to "ic_dialog_alert".
+transparent background. Should no icon be provided (or the icon is
+absent from this system), it defaults to "ic_dialog_alert".
Actions specified with :actions cannot be displayed on Android 4.0 and
earlier versions of the system.
@@ -814,17 +839,18 @@ this function.
usage: (android-notifications-notify &rest ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object title, body, replaces_id, group, urgency, resident;
+ Lisp_Object title, body, replaces_id, group, urgency, timeout, resident;
Lisp_Object icon;
Lisp_Object key, value, actions, action_cb, close_cb;
ptrdiff_t i;
+ AUTO_STRING (default_icon, "ic_dialog_alert");
if (!android_init_gui)
error ("No Android display connection!");
/* Clear each variable above. */
title = body = replaces_id = group = icon = urgency = actions = Qnil;
- resident = action_cb = close_cb = Qnil;
+ timeout = resident = action_cb = close_cb = Qnil;
/* If NARGS is odd, error. */
@@ -852,6 +878,8 @@ usage: (android-notifications-notify &rest ARGS) */)
icon = value;
else if (EQ (key, QCactions))
actions = value;
+ else if (EQ (key, QCtimeout))
+ timeout = value;
else if (EQ (key, QCresident))
resident = value;
else if (EQ (key, QCon_action))
@@ -874,16 +902,19 @@ usage: (android-notifications-notify &rest ARGS) */)
urgency = Qlow;
if (NILP (group))
- group = build_string ("Desktop Notifications");
+ {
+ AUTO_STRING (format, "Desktop Notifications (%s importance)");
+ group = CALLN (Fformat, format, urgency);
+ }
if (NILP (icon))
- icon = build_string ("ic_dialog_alert");
+ icon = default_icon;
else
CHECK_STRING (icon);
return make_int (android_notifications_notify_1 (title, body, replaces_id,
group, icon, urgency,
- actions, resident,
+ actions, timeout, resident,
action_cb, close_cb));
}
@@ -1001,6 +1032,7 @@ syms_of_androidselect (void)
DEFSYM (QCurgency, ":urgency");
DEFSYM (QCicon, ":icon");
DEFSYM (QCactions, ":actions");
+ DEFSYM (QCtimeout, ":timeout");
DEFSYM (QCresident, ":resident");
DEFSYM (QCon_action, ":on-action");
DEFSYM (QCon_close, ":on-close");
diff --git a/src/androidterm.c b/src/androidterm.c
index f68f8a9ef62..ba9b6d3b8a9 100644
--- a/src/androidterm.c
+++ b/src/androidterm.c
@@ -361,22 +361,52 @@ static int
android_android_to_emacs_modifiers (struct android_display_info *dpyinfo,
int state)
{
- return (((state & ANDROID_CONTROL_MASK) ? ctrl_modifier : 0)
- | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0)
- | ((state & ANDROID_ALT_MASK) ? meta_modifier : 0)
- | ((state & ANDROID_SUPER_MASK) ? super_modifier : 0)
- | ((state & ANDROID_META_MASK) ? alt_modifier : 0));
+ int mod_ctrl = ctrl_modifier;
+ int mod_meta = meta_modifier;
+ int mod_alt = alt_modifier;
+ int mod_super = super_modifier;
+ Lisp_Object tem;
+
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem) & INT_MAX;
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_super = XFIXNUM (tem) & INT_MAX;
+
+ return (((state & ANDROID_CONTROL_MASK) ? mod_ctrl : 0)
+ | ((state & ANDROID_SHIFT_MASK) ? shift_modifier : 0)
+ | ((state & ANDROID_ALT_MASK) ? mod_meta : 0)
+ | ((state & ANDROID_SUPER_MASK) ? mod_super : 0)
+ | ((state & ANDROID_META_MASK) ? mod_alt : 0));
}
static int
android_emacs_to_android_modifiers (struct android_display_info *dpyinfo,
intmax_t state)
{
- return (((state & ctrl_modifier) ? ANDROID_CONTROL_MASK : 0)
- | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0)
- | ((state & meta_modifier) ? ANDROID_ALT_MASK : 0)
- | ((state & super_modifier) ? ANDROID_SUPER_MASK : 0)
- | ((state & alt_modifier) ? ANDROID_META_MASK : 0));
+ EMACS_INT mod_ctrl = ctrl_modifier;
+ EMACS_INT mod_meta = meta_modifier;
+ EMACS_INT mod_alt = alt_modifier;
+ EMACS_INT mod_super = super_modifier;
+ Lisp_Object tem;
+
+ tem = Fget (Vx_ctrl_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_ctrl = XFIXNUM (tem);
+ tem = Fget (Vx_alt_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_alt = XFIXNUM (tem);
+ tem = Fget (Vx_meta_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_meta = XFIXNUM (tem);
+ tem = Fget (Vx_super_keysym, Qmodifier_value);
+ if (FIXNUMP (tem)) mod_super = XFIXNUM (tem);
+
+ return (((state & mod_ctrl) ? ANDROID_CONTROL_MASK : 0)
+ | ((state & shift_modifier) ? ANDROID_SHIFT_MASK : 0)
+ | ((state & mod_meta) ? ANDROID_ALT_MASK : 0)
+ | ((state & mod_super) ? ANDROID_SUPER_MASK : 0)
+ | ((state & mod_alt) ? ANDROID_META_MASK : 0));
}
static void android_frame_rehighlight (struct android_display_info *);
@@ -6670,6 +6700,26 @@ Emacs is running on. */);
doc: /* Name of the developer of the running version of Android. */);
Vandroid_build_manufacturer = Qnil;
+ DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_ctrl_keysym = Qnil;
+
+ DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_alt_keysym = Qnil;
+
+ DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_hyper_keysym = Qnil;
+
+ DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_meta_keysym = Qnil;
+
+ DEFVAR_LISP ("x-super-keysym", Vx_super_keysym,
+ doc: /* SKIP: real doc in xterm.c. */);
+ Vx_super_keysym = Qnil;
+
/* Only defined so loadup.el loads scroll-bar.el. */
DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
doc: /* SKIP: real doc in xterm.c. */);
@@ -6683,6 +6733,17 @@ Emacs is running on. */);
/* Symbols defined for DND events. */
DEFSYM (Quri, "uri");
DEFSYM (Qtext, "text");
+
+ /* Symbols defined for modifier value reassignment. */
+ DEFSYM (Qmodifier_value, "modifier-value");
+ DEFSYM (Qctrl, "ctrl");
+ Fput (Qctrl, Qmodifier_value, make_fixnum (ctrl_modifier));
+ DEFSYM (Qalt, "alt");
+ Fput (Qalt, Qmodifier_value, make_fixnum (alt_modifier));
+ DEFSYM (Qmeta, "meta");
+ Fput (Qmeta, Qmodifier_value, make_fixnum (meta_modifier));
+ DEFSYM (Qsuper, "super");
+ Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier));
}
void
diff --git a/src/androidterm.h b/src/androidterm.h
index ca6929bef0e..fd4cc99f641 100644
--- a/src/androidterm.h
+++ b/src/androidterm.h
@@ -461,7 +461,7 @@ extern void sfntfont_android_shrink_scanline_buffer (void);
extern void init_sfntfont_android (void);
extern void syms_of_sfntfont_android (void);
-/* Defined in androidselect.c */
+/* Defined in androidselect.c. */
#ifndef ANDROID_STUBIFY
@@ -473,6 +473,9 @@ extern void android_notification_action (struct
android_notification_event *,
extern void init_androidselect (void);
extern void syms_of_androidselect (void);
+/* Defined in androidvfs.c. */
+extern void syms_of_androidvfs (void);
+
#endif
diff --git a/src/androidvfs.c b/src/androidvfs.c
index 4bb652f3eb7..a9035ae53c6 100644
--- a/src/androidvfs.c
+++ b/src/androidvfs.c
@@ -33,12 +33,15 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <sys/mman.h>
#include <stat-time.h>
+#include <md5.h>
#include <linux/ashmem.h>
#include "android.h"
+#include "androidterm.h"
#include "systime.h"
#include "blockinput.h"
+#include "coding.h"
#if __ANDROID_API__ >= 9
#include <android/asset_manager.h>
@@ -247,14 +250,21 @@ struct android_special_vnode
/* Function called to create the initial vnode from the rest of the
component. */
struct android_vnode *(*initial) (char *, size_t);
+
+ /* If non-nil, an encoding system into which file name buffers are to
+ be re-encoded before being handed to VFS functions. */
+ Lisp_Object special_coding_system;
};
+verify (NIL_IS_ZERO); /* special_coding_system above. */
+
enum android_vnode_type
{
ANDROID_VNODE_UNIX,
ANDROID_VNODE_AFS,
ANDROID_VNODE_CONTENT,
ANDROID_VNODE_CONTENT_AUTHORITY,
+ ANDROID_VNODE_CONTENT_AUTHORITY_NAMED,
ANDROID_VNODE_SAF_ROOT,
ANDROID_VNODE_SAF_TREE,
ANDROID_VNODE_SAF_FILE,
@@ -2435,6 +2445,7 @@ struct android_content_vdir
};
static struct android_vnode *android_authority_initial (char *, size_t);
+static struct android_vnode *android_authority_initial_name (char *, size_t);
static struct android_vnode *android_saf_root_initial (char *, size_t);
/* Content provider meta-interface. This implements a vnode at
@@ -2445,9 +2456,9 @@ static struct android_vnode *android_saf_root_initial
(char *, size_t);
a list of each directory tree Emacs has been granted permanent
access to through the Storage Access Framework.
- /content/by-authority exists on Android 4.4 and later; it contains
- no directories, but provides a `name' function that converts
- children into content URIs. */
+ /content/by-authority and /content/by-authority-named exists on
+ Android 4.4 and later; it contains no directories, but provides a
+ `name' function that converts children into content URIs. */
static struct android_vnode *android_content_name (struct android_vnode *,
char *, size_t);
@@ -2490,7 +2501,7 @@ static struct android_vops content_vfs_ops =
static const char *content_directory_contents[] =
{
- "storage", "by-authority",
+ "storage", "by-authority", "by-authority-named",
};
/* Chain consisting of all open content directory streams. */
@@ -2508,8 +2519,9 @@ android_content_name (struct android_vnode *vnode, char
*name,
int api;
static struct android_special_vnode content_vnodes[] = {
- { "storage", 7, android_saf_root_initial, },
- { "by-authority", 12, android_authority_initial, },
+ { "storage", 7, android_saf_root_initial, },
+ { "by-authority", 12, android_authority_initial, },
+ { "by-authority-named", 18, android_authority_initial_name, },
};
/* Canonicalize NAME. */
@@ -2551,7 +2563,7 @@ android_content_name (struct android_vnode *vnode, char
*name,
call its root lookup function with the rest of NAME there. */
if (api < 19)
- i = 2;
+ i = 3;
else if (api < 21)
i = 1;
else
@@ -2855,18 +2867,59 @@ android_content_initial (char *name, size_t length)
+#ifdef __clang__
+#pragma clang diagnostic push
+#pragma clang diagnostic ignored "-Wmissing-prototypes"
+#else /* GNUC */
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wmissing-prototypes"
+#endif /* __clang__ */
+
/* Content URI management functions. */
+JNIEXPORT jstring JNICALL
+NATIVE_NAME (displayNameHash) (JNIEnv *env, jobject object,
+ jbyteArray display_name)
+{
+ char checksum[9], block[MD5_DIGEST_SIZE];
+ jbyte *data;
+
+ data = (*env)->GetByteArrayElements (env, display_name, NULL);
+ if (!data)
+ return NULL;
+
+ /* Hash the buffer. */
+ md5_buffer ((char *) data, (*env)->GetArrayLength (env, display_name),
+ block);
+ (*env)->ReleaseByteArrayElements (env, display_name, data, JNI_ABORT);
+
+ /* Generate the digest string. */
+ hexbuf_digest (checksum, (char *) block, 4);
+ checksum[8] = '\0';
+ return (*env)->NewStringUTF (env, checksum);
+}
+
+#ifdef __clang__
+#pragma clang diagnostic pop
+#else /* GNUC */
+#pragma GCC diagnostic pop
+#endif /* __clang__ */
+
/* Return the content URI corresponding to a `/content/by-authority'
file name, or NULL if it is invalid for some reason. FILENAME
should be relative to /content/by-authority, with no leading
- directory separator character. */
+ directory separator character.
+
+ WITH_CHECKSUM should be true if FILENAME contains a display name and
+ a checksum for that display name. */
static char *
-android_get_content_name (const char *filename)
+android_get_content_name (const char *filename, bool with_checksum)
{
char *fill, *buffer;
size_t length;
+ char checksum[9], new_checksum[9], block[MD5_DIGEST_SIZE];
+ const char *p2, *p1;
/* Make sure FILENAME isn't obviously invalid: it must contain an
authority name and a file name component. */
@@ -2888,11 +2941,55 @@ android_get_content_name (const char *filename)
return NULL;
}
+ if (!with_checksum)
+ goto no_checksum;
+
+ /* Content file names hold two components providing a display name and
+ a short checksum that protects against files being opened under
+ display names besides those provided in the content file name at
+ the time of generation. */
+
+ p1 = strrchr (filename, '/'); /* Display name. */
+ p2 = memrchr (filename, '/', p1 - filename); /* Start of checksum. */
+
+ /* If the name be excessively short or the checksum of an invalid
+ length, return. */
+ if (!p2 || (p1 - p2) != 9)
+ {
+ errno = ENOENT;
+ return NULL;
+ }
+
+ /* Copy the checksum into CHECKSUM. */
+ memcpy (checksum, p2 + 1, 8);
+ new_checksum[8] = checksum[8] = '\0';
+
+ /* Hash this string and store 8 bytes of the resulting digest into
+ new_checksum. */
+ md5_buffer (p1 + 1, strlen (p1 + 1), block);
+ hexbuf_digest (new_checksum, (char *) block, 4);
+
+ /* Compare both checksums. */
+ if (strcmp (new_checksum, checksum))
+ {
+ errno = ENOENT;
+ return NULL;
+ }
+
+ /* Remove the checksum and file display name from the URI. */
+ length = p2 - filename;
+
+ no_checksum:
+ if (length > INT_MAX)
+ {
+ errno = ENOMEM;
+ return NULL;
+ }
+
/* Prefix FILENAME with content:// and return the buffer containing
that URI. */
-
- buffer = xmalloc (sizeof "content://" + length);
- sprintf (buffer, "content://%s", filename);
+ buffer = xmalloc (sizeof "content://" + length + 1);
+ sprintf (buffer, "content://%.*s", (int) length, filename);
return buffer;
}
@@ -2932,7 +3029,7 @@ android_check_content_access (const char *uri, int mode)
/* Content authority-based vnode implementation.
- /contents/by-authority is a simple vnode implementation that converts
+ /content/by-authority is a simple vnode implementation that converts
components to content:// URIs.
It does not canonicalize file names by removing parent directory
@@ -3039,7 +3136,14 @@ android_authority_name (struct android_vnode *vnode,
char *name,
if (android_verify_jni_string (name))
goto no_entry;
- uri_name = android_get_content_name (name);
+ if (vp->vnode.type == ANDROID_VNODE_CONTENT_AUTHORITY_NAMED)
+ /* This indicates that the two trailing components of NAME
+ provide a checksum and a file display name, to be verified,
+ then excluded from the content URI. */
+ uri_name = android_get_content_name (name, true);
+ else
+ uri_name = android_get_content_name (name, false);
+
if (!uri_name)
goto error;
@@ -3333,6 +3437,32 @@ android_authority_initial (char *name, size_t length)
return android_authority_name (&temp.vnode, name, length);
}
+/* Find the vnode designated by NAME relative to the root of the
+ by-authority-named directory.
+
+ If NAME is empty or a single leading separator character, return
+ a vnode representing the by-authority directory itself.
+
+ Otherwise, represent the remainder of NAME as a URI (without
+ normalizing it) and return a vnode corresponding to that.
+
+ Value may also be NULL with errno set if the designated vnode is
+ not available, such as when Android windowing has not been
+ initialized. */
+
+static struct android_vnode *
+android_authority_initial_name (char *name, size_t length)
+{
+ struct android_authority_vnode temp;
+
+ temp.vnode.ops = &authority_vfs_ops;
+ temp.vnode.type = ANDROID_VNODE_CONTENT_AUTHORITY_NAMED;
+ temp.vnode.flags = 0;
+ temp.uri = NULL;
+
+ return android_authority_name (&temp.vnode, name, length);
+}
+
/* SAF ``root'' vnode implementation.
@@ -3745,7 +3875,8 @@ android_saf_root_readdir (struct android_vdir *vdir)
NULL);
android_exception_check_nonnull ((void *) chars, string);
- /* Figure out how large it is, and then resize dirent to fit. */
+ /* Figure out how large it is, and then resize dirent to fit--this
+ string is always ASCII. */
length = strlen (chars) + 1;
size = offsetof (struct dirent, d_name) + length;
dirent = xrealloc (dirent, size);
@@ -5357,6 +5488,7 @@ android_saf_tree_readdir (struct android_vdir *vdir)
jmethodID method;
size_t length, size;
const char *chars;
+ struct coding_system coding;
dir = (struct android_saf_tree_vdir *) vdir;
@@ -5404,9 +5536,24 @@ android_saf_tree_readdir (struct android_vdir *vdir)
NULL);
android_exception_check_nonnull ((void *) chars, d_name);
- /* Figure out how large it is, and then resize dirent to fit. */
- length = strlen (chars) + 1;
- size = offsetof (struct dirent, d_name) + length;
+ /* Decode this JNI string into utf-8-emacs; see
+ android_vfs_convert_name for considerations regarding coding
+ systems. */
+ length = strlen (chars);
+ setup_coding_system (Qandroid_jni, &coding);
+ coding.mode |= CODING_MODE_LAST_BLOCK;
+ coding.source = (const unsigned char *) chars;
+ coding.dst_bytes = 0;
+ coding.destination = NULL;
+ decode_coding_object (&coding, Qnil, 0, 0, length, length, Qnil);
+
+ /* Release the string data and the local reference to STRING. */
+ (*android_java_env)->ReleaseStringUTFChars (android_java_env,
+ (jstring) d_name,
+ chars);
+
+ /* Resize dirent to accommodate the decoded text. */
+ size = offsetof (struct dirent, d_name) + 1 + coding.produced;
dirent = xrealloc (dirent, size);
/* Clear dirent. */
@@ -5418,12 +5565,12 @@ android_saf_tree_readdir (struct android_vdir *vdir)
dirent->d_off = 0;
dirent->d_reclen = size;
dirent->d_type = d_type ? DT_DIR : DT_UNKNOWN;
- strcpy (dirent->d_name, chars);
+ memcpy (dirent->d_name, coding.destination, coding.produced);
+ dirent->d_name[coding.produced] = '\0';
+
+ /* Free the coding system destination buffer. */
+ xfree (coding.destination);
- /* Release the string data and the local reference to STRING. */
- (*android_java_env)->ReleaseStringUTFChars (android_java_env,
- (jstring) d_name,
- chars);
ANDROID_DELETE_LOCAL_REF (d_name);
return dirent;
}
@@ -6409,9 +6556,31 @@ static struct android_vops root_vfs_ops =
static struct android_special_vnode special_vnodes[] =
{
{ "assets", 6, android_afs_initial, },
- { "content", 7, android_content_initial, },
+ { "content", 7, android_content_initial,
+ LISPSYM_INITIALLY (Qandroid_jni), },
};
+/* Convert the file name NAME from Emacs's internal character encoding
+ to CODING, and return a Lisp string with the data so produced.
+
+ Calling this function creates an implicit assumption that
+ file-name-coding-system is compatible with utf-8-emacs, which is not
+ unacceptable as users with cause to modify file-name-coding-system
+ should be aware and prepared for consequences towards files stored on
+ different filesystems, including virtual ones. */
+
+static Lisp_Object
+android_vfs_convert_name (const char *name, Lisp_Object coding)
+{
+ Lisp_Object name1;
+
+ /* Convert the contents of the buffer after BUFFER_END from the file
+ name coding system to special->special_coding_system. */
+ name1 = build_string (name);
+ name1 = code_convert_string (name1, coding, Qt, true, true, true);
+ return name1;
+}
+
static struct android_vnode *
android_root_name (struct android_vnode *vnode, char *name,
size_t length)
@@ -6419,6 +6588,8 @@ android_root_name (struct android_vnode *vnode, char
*name,
char *component_end;
struct android_special_vnode *special;
size_t i;
+ Lisp_Object file_name;
+ struct android_vnode *vp;
/* Skip any leading separator in NAME. */
@@ -6445,8 +6616,29 @@ android_root_name (struct android_vnode *vnode, char
*name,
if (component_end - name == special->length
&& !memcmp (special->name, name, special->length))
- return (*special->initial) (component_end,
- length - special->length);
+ {
+ if (!NILP (special->special_coding_system))
+ {
+ USE_SAFE_ALLOCA;
+
+ file_name
+ = android_vfs_convert_name (component_end,
+ special->special_coding_system);
+
+ /* Allocate a buffer and copy file_name into the same. */
+ length = SBYTES (file_name) + 1;
+ name = SAFE_ALLOCA (length);
+
+ /* Copy the trailing NULL byte also. */
+ memcpy (name, SDATA (file_name), length);
+ vp = (*special->initial) (name, length - 1);
+ SAFE_FREE ();
+ return vp;
+ }
+
+ return (*special->initial) (component_end,
+ length - special->length);
+ }
/* Detect the case where a special is named with a trailing
directory separator. */
@@ -6454,9 +6646,30 @@ android_root_name (struct android_vnode *vnode, char
*name,
if (component_end - name == special->length + 1
&& !memcmp (special->name, name, special->length)
&& name[special->length] == '/')
- /* Make sure to include the directory separator. */
- return (*special->initial) (component_end - 1,
- length - special->length);
+ {
+ if (!NILP (special->special_coding_system))
+ {
+ USE_SAFE_ALLOCA;
+
+ file_name
+ = android_vfs_convert_name (component_end - 1,
+ special->special_coding_system);
+
+ /* Allocate a buffer and copy file_name into the same. */
+ length = SBYTES (file_name) + 1;
+ name = SAFE_ALLOCA (length);
+
+ /* Copy the trailing NULL byte also. */
+ memcpy (name, SDATA (file_name), length);
+ vp = (*special->initial) (name, length - 1);
+ SAFE_FREE ();
+ return vp;
+ }
+
+ /* Make sure to include the directory separator. */
+ return (*special->initial) (component_end - 1,
+ length - special->length);
+ }
}
/* Otherwise, continue searching for a vnode normally. */
@@ -6467,8 +6680,9 @@ android_root_name (struct android_vnode *vnode, char
*name,
/* File system lookup. */
-/* Look up the vnode that designates NAME, a file name that is at
- least N bytes.
+/* Look up the vnode that designates NAME, a file name that is at least
+ N bytes, converting between different file name coding systems as
+ necessary.
NAME may be either an absolute file name or a name relative to the
current working directory. It must not be longer than EMACS_PATH_MAX
@@ -7483,3 +7697,11 @@ android_closedir (struct android_vdir *dirp)
{
return (*dirp->closedir) (dirp);
}
+
+
+
+void
+syms_of_androidvfs (void)
+{
+ DEFSYM (Qandroid_jni, "android-jni");
+}
diff --git a/src/bidi.c b/src/bidi.c
index 36d1a0496b8..bdf60001781 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -754,6 +754,19 @@ bidi_cache_find_level_change (int level, int dir, bool
before)
return -1;
}
+/* Find the previous character position where LEVEL changes to a lower
+ one. Return -1 if not found (which really shouldn't happen if this
+ function is called on a backward scan). */
+ptrdiff_t
+bidi_level_start (int level)
+{
+ ptrdiff_t slot = bidi_cache_find_level_change (level, -1, true);
+
+ if (slot >= 0)
+ return bidi_cache[slot].charpos;
+ return -1;
+}
+
static void
bidi_cache_ensure_space (ptrdiff_t idx)
{
diff --git a/src/buffer.c b/src/buffer.c
index 43a9249528c..07d19dfc078 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -327,6 +327,11 @@ bset_name (struct buffer *b, Lisp_Object val)
b->name_ = val;
}
static void
+bset_last_name (struct buffer *b, Lisp_Object val)
+{
+ b->last_name_ = val;
+}
+static void
bset_overwrite_mode (struct buffer *b, Lisp_Object val)
{
b->overwrite_mode_ = val;
@@ -647,6 +652,7 @@ even if it is dead. The return value is never nil. */)
name = Fcopy_sequence (buffer_or_name);
set_string_intervals (name, NULL);
bset_name (b, name);
+ bset_last_name (b, name);
b->inhibit_buffer_hooks = !NILP (inhibit_buffer_hooks);
bset_undo_list (b, SREF (name, 0) != ' ' ? Qnil : Qt);
@@ -866,6 +872,7 @@ Interactively, CLONE and INHIBIT-BUFFER-HOOKS are nil. */)
name = Fcopy_sequence (name);
set_string_intervals (name, NULL);
bset_name (b, name);
+ bset_last_name (b, name);
/* An indirect buffer shares undo list of its base (Bug#18180). */
bset_undo_list (b, BVAR (b->base_buffer, undo_list));
@@ -1282,6 +1289,17 @@ Return nil if BUFFER has been killed. */)
return BVAR (decode_buffer (buffer), name);
}
+DEFUN ("buffer-last-name", Fbuffer_last_name, Sbuffer_last_name, 0, 1, 0,
+ doc: /* Return last name of BUFFER, as a string.
+BUFFER defaults to the current buffer.
+
+This is the name BUFFER had before the last time it was renamed or
+immediately before it was killed. */)
+ (Lisp_Object buffer)
+{
+ return BVAR (decode_buffer (buffer), last_name);
+}
+
DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0,
doc: /* Return name of file BUFFER is visiting, or nil if none.
No argument or nil as argument means use the current buffer. */)
@@ -1652,6 +1670,7 @@ This does not change the name of the visited file (if
any). */)
(register Lisp_Object newname, Lisp_Object unique)
{
register Lisp_Object tem, buf;
+ Lisp_Object oldname = BVAR (current_buffer, name);
Lisp_Object requestedname = newname;
CHECK_STRING (newname);
@@ -1669,12 +1688,12 @@ This does not change the name of the visited file (if
any). */)
if (NILP (unique) && XBUFFER (tem) == current_buffer)
return BVAR (current_buffer, name);
if (!NILP (unique))
- newname = Fgenerate_new_buffer_name (newname,
- BVAR (current_buffer, name));
+ newname = Fgenerate_new_buffer_name (newname, oldname);
else
error ("Buffer name `%s' is in use", SDATA (newname));
}
+ bset_last_name (current_buffer, oldname);
bset_name (current_buffer, newname);
/* Catch redisplay's attention. Unless we do this, the mode lines for
@@ -2095,6 +2114,7 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
This gets rid of them for certain. */
reset_buffer_local_variables (b, 1);
+ bset_last_name (b, BVAR (b, name));
bset_name (b, Qnil);
block_input ();
@@ -4666,6 +4686,7 @@ init_buffer_once (void)
/* These used to be stuck at 0 by default, but now that the all-zero value
means Qnil, we have to initialize them explicitly. */
bset_name (&buffer_local_flags, make_fixnum (0));
+ bset_last_name (&buffer_local_flags, make_fixnum (0));
bset_mark (&buffer_local_flags, make_fixnum (0));
bset_local_var_alist (&buffer_local_flags, make_fixnum (0));
bset_keymap (&buffer_local_flags, make_fixnum (0));
@@ -6026,6 +6047,7 @@ There is no reason to change that value except for
debugging purposes. */);
defsubr (&Smake_indirect_buffer);
defsubr (&Sgenerate_new_buffer_name);
defsubr (&Sbuffer_name);
+ defsubr (&Sbuffer_last_name);
defsubr (&Sbuffer_file_name);
defsubr (&Sbuffer_base_buffer);
defsubr (&Sbuffer_local_value);
diff --git a/src/buffer.h b/src/buffer.h
index 87ba2802b39..bbe1aeff668 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -309,6 +309,9 @@ struct buffer
/* The name of this buffer. */
Lisp_Object name_;
+ /* The last name of this buffer before it was renamed or killed. */
+ Lisp_Object last_name_;
+
/* The name of the file visited in this buffer, or nil. */
Lisp_Object filename_;
diff --git a/src/coding.c b/src/coding.c
index 5f3ceab718b..c51ceb95475 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -614,10 +614,11 @@ inhibit_flag (int encoded_flag, bool var)
static bool
growable_destination (struct coding_system *coding)
{
- return STRINGP (coding->dst_object) || BUFFERP (coding->dst_object);
+ return (STRINGP (coding->dst_object)
+ || BUFFERP (coding->dst_object)
+ || NILP (coding->dst_object));
}
-
/* Safely get one byte from the source text pointed by SRC which ends
at SRC_END, and set C to that byte. If there are not enough bytes
in the source, it jumps to 'no_more_source'. If MULTIBYTEP,
@@ -5488,7 +5489,7 @@ decode_coding_charset (struct coding_system *coding)
{
int c;
Lisp_Object val;
- struct charset *charset;
+ struct charset *charset UNINIT;
int dim;
int len = 1;
unsigned code;
@@ -7005,7 +7006,6 @@ get_translation (Lisp_Object trans, int *buf, int
*buf_end, ptrdiff_t *nchars)
return Qnil;
}
-
static int
produce_chars (struct coding_system *coding, Lisp_Object translation_table,
bool last_block)
@@ -7063,7 +7063,10 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
|| ckd_add (&dst_size, dst_size, buf_end - buf))
memory_full (SIZE_MAX);
dst = alloc_destination (coding, dst_size, dst);
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ /* Input and output are not C buffers, which are safe to
+ assume to be different. */
+ && !NILP (coding->src_object))
{
coding_set_source (coding);
dst_end = (((unsigned char *) coding->source)
@@ -7098,7 +7101,10 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
const unsigned char *src = coding->source;
const unsigned char *src_end = src + coding->consumed;
- if (EQ (coding->dst_object, coding->src_object))
+ if (EQ (coding->dst_object, coding->src_object)
+ /* Input and output are not C buffers, which are safe to
+ assume to be different. */
+ && !NILP (coding->src_object))
{
eassert (growable_destination (coding));
dst_end = (unsigned char *) src;
@@ -7119,7 +7125,8 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
if (dst == dst_end)
{
eassert (growable_destination (coding));
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
if (dst == dst_end)
{
@@ -7131,7 +7138,8 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
coding_set_source (coding);
src = coding->source + offset;
src_end = coding->source + coding->consumed;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
}
}
@@ -7150,14 +7158,16 @@ produce_chars (struct coding_system *coding,
Lisp_Object translation_table,
if (dst >= dst_end - 1)
{
eassert (growable_destination (coding));
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
if (dst >= dst_end - 1)
{
ptrdiff_t offset = src - coding->source;
ptrdiff_t more_bytes;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
more_bytes = ((src_end - src) / 2) + 2;
else
more_bytes = src_end - src + 2;
@@ -7166,7 +7176,8 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
coding_set_source (coding);
src = coding->source + offset;
src_end = coding->source + coding->consumed;
- if (EQ (coding->src_object, coding->dst_object))
+ if (EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object))
dst_end = (unsigned char *) src;
}
}
@@ -7175,7 +7186,8 @@ produce_chars (struct coding_system *coding, Lisp_Object
translation_table,
}
else
{
- if (!EQ (coding->src_object, coding->dst_object))
+ if (!(EQ (coding->src_object, coding->dst_object)
+ && !NILP (coding->src_object)))
{
ptrdiff_t require = coding->src_bytes - coding->dst_bytes;
diff --git a/src/comp.c b/src/comp.c
index 3f989c722d4..99f51e07048 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -469,7 +469,7 @@ load_gccjit_if_necessary (bool mandatory)
/* Increase this number to force a new Vcomp_abi_hash to be generated. */
-#define ABI_VERSION "5"
+#define ABI_VERSION "6"
/* Length of the hashes used for eln file naming. */
#define HASH_LENGTH 8
@@ -502,11 +502,9 @@ load_gccjit_if_necessary (bool mandatory)
#define THIRD(x) \
XCAR (XCDR (XCDR (x)))
-#if 0 /* unused for now */
/* Like call0 but stringify and intern. */
#define CALL0I(fun) \
CALLN (Ffuncall, intern_c_string (STR (fun)))
-#endif
/* Like call1 but stringify and intern. */
#define CALL1I(fun, arg) \
@@ -702,6 +700,8 @@ static void helper_save_restriction (void);
static bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object, enum pvec_type);
static struct Lisp_Symbol_With_Pos *
helper_GET_SYMBOL_WITH_POSITION (Lisp_Object);
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object, Lisp_Object);
/* Note: helper_link_table must match the list created by
`declare_runtime_imported_funcs'. */
@@ -714,6 +714,7 @@ static void *helper_link_table[] =
helper_unbind_n,
helper_save_restriction,
helper_GET_SYMBOL_WITH_POSITION,
+ helper_sanitizer_assert,
record_unwind_current_buffer,
set_internal,
helper_unwind_protect,
@@ -2442,7 +2443,7 @@ emit_limple_insn (Lisp_Object insn)
{
Lisp_Object arg1 = arg[1];
- if (EQ (Ftype_of (arg1), Qcomp_mvar))
+ if (EQ (Fcl_type_of (arg1), Qcomp_mvar))
res = emit_mvar_rval (arg1);
else if (EQ (FIRST (arg1), Qcall))
res = emit_limple_call (XCDR (arg1));
@@ -2975,6 +2976,10 @@ declare_runtime_imported_funcs (void)
ADD_IMPORTED (helper_GET_SYMBOL_WITH_POSITION,
comp.lisp_symbol_with_position_ptr_type,
1, args);
+ args[0] = comp.lisp_obj_type;
+ args[1] = comp.lisp_obj_type;
+ ADD_IMPORTED (helper_sanitizer_assert, comp.lisp_obj_type, 2, args);
+
ADD_IMPORTED (record_unwind_current_buffer, comp.void_type, 0, NULL);
args[0] = args[1] = args[2] = comp.lisp_obj_type;
@@ -4619,6 +4624,8 @@ Return t on success. */)
emit_simple_limple_call_void_ret);
register_emitter (Qhelper_save_restriction,
emit_simple_limple_call_void_ret);
+ register_emitter (Qhelper_sanitizer_assert,
+ emit_simple_limple_call_lisp_ret);
/* Inliners. */
register_emitter (Qadd1, emit_add1);
register_emitter (Qsub1, emit_sub1);
@@ -5082,6 +5089,21 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object a)
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Symbol_With_Pos);
}
+static Lisp_Object
+helper_sanitizer_assert (Lisp_Object val, Lisp_Object type)
+{
+ if (!comp_sanitizer_active
+ || !NILP ((CALL2I (cl-typep, val, type))))
+ return Qnil;
+
+ AUTO_STRING (format, "Comp sanitizer FAIL for %s with type %s");
+ CALLN (Fmessage, format, val, type);
+ CALL0I (backtrace);
+ xsignal2 (Qcomp_sanitizer_error, val, type);
+
+ return Qnil;
+}
+
/* `native-comp-eln-load-path' clean-up support code. */
@@ -5709,6 +5731,7 @@ natively-compiled one. */);
DEFSYM (Qhelper_unbind_n, "helper_unbind_n");
DEFSYM (Qhelper_unwind_protect, "helper_unwind_protect");
DEFSYM (Qhelper_save_restriction, "helper_save_restriction");
+ DEFSYM (Qhelper_sanitizer_assert, "helper_sanitizer_assert");
/* Inliners. */
DEFSYM (Qadd1, "1+");
DEFSYM (Qsub1, "1-");
@@ -5779,6 +5802,12 @@ natively-compiled one. */);
build_pure_c_string ("eln file inconsistent with current runtime "
"configuration, please recompile"));
+ DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error");
+ Fput (Qcomp_sanitizer_error, Qerror_conditions,
+ pure_list (Qcomp_sanitizer_error, Qerror));
+ Fput (Qcomp_sanitizer_error, Qerror_message,
+ build_pure_c_string ("Native code sanitizer runtime error"));
+
DEFSYM (Qnative__compile_async, "native--compile-async");
defsubr (&Scomp__subr_signature);
@@ -5901,6 +5930,14 @@ subr-name -> arity
For internal use. */);
Vcomp_subr_arities_h = CALLN (Fmake_hash_table, QCtest, Qequal);
+ DEFVAR_BOOL ("comp-sanitizer-active", comp_sanitizer_active,
+ doc: /* If non-nil, enable runtime execution of native-compiler sanitizer.
+For this to be effective, Lisp code must be compiled
+with `comp-sanitizer-emit' non-nil.
+This is intended to be used only for development and
+verification of the native compiler. */);
+ comp_sanitizer_active = false;
+
Fprovide (intern_c_string ("native-compile"), Qnil);
#endif /* #ifdef HAVE_NATIVE_COMP */
diff --git a/src/data.c b/src/data.c
index b64ea56ae63..12a92bcb90c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -193,16 +193,37 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0,
DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
doc: /* Return a symbol representing the type of OBJECT.
The symbol returned names the object's basic type;
-for example, (type-of 1) returns `integer'. */)
+for example, (type-of 1) returns `integer'.
+Contrary to `cl-type-of', the returned type is not always the most
+precise type possible, because instead this function tries to preserve
+compatibility with the return value of previous Emacs versions. */)
+ (Lisp_Object object)
+{
+ return SYMBOLP (object) ? Qsymbol
+ : INTEGERP (object) ? Qinteger
+ : SUBRP (object) ? Qsubr
+ : Fcl_type_of (object);
+}
+
+DEFUN ("cl-type-of", Fcl_type_of, Scl_type_of, 1, 1, 0,
+ doc: /* Return a symbol representing the type of OBJECT.
+The returned symbol names the most specific possible type of the object.
+for example, (cl-type-of nil) returns `null'.
+The specific type returned may change depending on Emacs versions,
+so we recommend you use `cl-typep', `cl-typecase', or other predicates
+rather than compare the return value of this function against
+a fixed set of types. */)
(Lisp_Object object)
{
switch (XTYPE (object))
{
case_Lisp_Int:
- return Qinteger;
+ return Qfixnum;
case Lisp_Symbol:
- return Qsymbol;
+ return NILP (object) ? Qnull
+ : EQ (object, Qt) ? Qboolean
+ : Qsymbol;
case Lisp_String:
return Qstring;
@@ -215,7 +236,7 @@ for example, (type-of 1) returns `integer'. */)
switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
{
case PVEC_NORMAL_VECTOR: return Qvector;
- case PVEC_BIGNUM: return Qinteger;
+ case PVEC_BIGNUM: return Qbignum;
case PVEC_MARKER: return Qmarker;
case PVEC_SYMBOL_WITH_POS: return Qsymbol_with_pos;
case PVEC_OVERLAY: return Qoverlay;
@@ -224,7 +245,10 @@ for example, (type-of 1) returns `integer'. */)
case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
case PVEC_PROCESS: return Qprocess;
case PVEC_WINDOW: return Qwindow;
- case PVEC_SUBR: return Qsubr;
+ case PVEC_SUBR:
+ return XSUBR (object)->max_args == UNEVALLED ? Qspecial_form
+ : SUBR_NATIVE_COMPILEDP (object) ? Qsubr_native_elisp
+ : Qprimitive_function;
case PVEC_COMPILED: return Qcompiled_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
@@ -4207,7 +4231,9 @@ syms_of_data (void)
"Variable binding depth exceeds max-specpdl-size");
/* Types that type-of returns. */
+ DEFSYM (Qboolean, "boolean");
DEFSYM (Qinteger, "integer");
+ DEFSYM (Qbignum, "bignum");
DEFSYM (Qsymbol, "symbol");
DEFSYM (Qstring, "string");
DEFSYM (Qcons, "cons");
@@ -4223,6 +4249,9 @@ syms_of_data (void)
DEFSYM (Qprocess, "process");
DEFSYM (Qwindow, "window");
DEFSYM (Qsubr, "subr");
+ DEFSYM (Qspecial_form, "special-form");
+ DEFSYM (Qprimitive_function, "primitive-function");
+ DEFSYM (Qsubr_native_elisp, "subr-native-elisp");
DEFSYM (Qcompiled_function, "compiled-function");
DEFSYM (Qbuffer, "buffer");
DEFSYM (Qframe, "frame");
@@ -4261,6 +4290,7 @@ syms_of_data (void)
defsubr (&Seq);
defsubr (&Snull);
defsubr (&Stype_of);
+ defsubr (&Scl_type_of);
defsubr (&Slistp);
defsubr (&Snlistp);
defsubr (&Sconsp);
diff --git a/src/dispextern.h b/src/dispextern.h
index 5387cb45603..1c3232fae3d 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3438,6 +3438,7 @@ extern void bidi_pop_it (struct bidi_it *);
extern void *bidi_shelve_cache (void);
extern void bidi_unshelve_cache (void *, bool);
extern ptrdiff_t bidi_find_first_overridden (struct bidi_it *);
+extern ptrdiff_t bidi_level_start (int);
/* Defined in xdisp.c */
diff --git a/src/emacs.c b/src/emacs.c
index f4bfb9a6bbd..87f12d3fa86 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -2444,6 +2444,7 @@ Using an Emacs configured with --with-x-toolkit=lucid
does not have this problem
#if !defined ANDROID_STUBIFY
syms_of_androidfont ();
syms_of_androidselect ();
+ syms_of_androidvfs ();
syms_of_sfntfont ();
syms_of_sfntfont_android ();
#endif /* !ANDROID_STUBIFY */
diff --git a/src/eval.c b/src/eval.c
index 4c69d13560f..ff1e5e8c1ee 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1462,8 +1462,8 @@ push_handler_bind (Lisp_Object conditions, Lisp_Object
handler, int skip)
}
DEFUN ("handler-bind-1", Fhandler_bind_1, Shandler_bind_1, 1, MANY, 0,
- doc: /* Setup error handlers around execution of BODYFUN.
-BODYFUN be a function and it is called with no arguments.
+ doc: /* Set up error handlers around execution of BODYFUN.
+BODYFUN should be a function and it is called with no arguments.
CONDITIONS should be a list of condition names (symbols).
When an error is signaled during execution of BODYFUN, if that
error matches one of CONDITIONS, then the associated HANDLER is
diff --git a/src/fileio.c b/src/fileio.c
index 483498fd879..12da7a9ed3a 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -847,7 +847,7 @@ Each element in COMPONENTS must be a string or nil.
DIRECTORY or the non-final elements in COMPONENTS may or may not end
with a slash -- if they don't end with a slash, a slash will be
inserted before concatenating.
-usage: (record DIRECTORY &rest COMPONENTS) */)
+usage: (file-name-concat DIRECTORY &rest COMPONENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
ptrdiff_t chars = 0, bytes = 0, multibytes = 0, eargs = 0;
diff --git a/src/lisp.h b/src/lisp.h
index ab967e0403b..21be235eeae 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -569,10 +569,8 @@ enum Lisp_Fwd_Type
your object -- this way, the same object could be used to represent
several disparate C structures.
- In addition, you need to add switch branches in data.c for Ftype_of.
-
- You also need to add the new type to the constant
- `cl--typeof-types' in lisp/emacs-lisp/cl-preloaded.el. */
+ In addition, you need to add switch branches in data.c for Fcl_type_of
+ and `cl--define-builtin-type` in lisp/emacs-lisp/cl-preloaded.el. */
/* A Lisp_Object is a tagged pointer or integer. Ordinarily it is a
diff --git a/src/lread.c b/src/lread.c
index 9cafa54b4d6..5f864df0d37 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1992,9 +1992,9 @@ maybe_swap_for_eln (bool no_native, Lisp_Object
*filename, int *fd,
= Fcons (list2
(Qcomp,
CALLN (Fformat,
- build_string ("Cannot look up eln "
- "file as no source file "
- "was found for %s"),
+ build_string ("Cannot look up .eln file "
+ "for %s because no source "
+ "file was found for it"),
*filename)),
Vdelayed_warnings_list);
return;
diff --git a/src/minibuf.c b/src/minibuf.c
index df6ca7ce1d8..51816133fb2 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1701,11 +1701,12 @@ or from one of the possible completions. */)
tem = Fcommandp (elt, Qnil);
else
{
- tem = (type == hash_table
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection),
- idx - 1))
- : call1 (predicate, elt));
+ if (type == hash_table)
+ tem = call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (collection),
+ idx - 1));
+ else
+ tem = call1 (predicate, elt);
}
if (NILP (tem)) continue;
}
@@ -1845,9 +1846,12 @@ with a space are ignored unless STRING itself starts
with a space. */)
Lisp_Object allmatches;
if (VECTORP (collection))
collection = check_obarray (collection);
- int type = HASH_TABLE_P (collection) ? 3
- : OBARRAYP (collection) ? 2
- : NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
+ int type = (HASH_TABLE_P (collection)
+ ? 3 : (OBARRAYP (collection)
+ ? 2 : ((NILP (collection)
+ || (CONSP (collection)
+ && !FUNCTIONP (collection)))
+ ? 1 : 0)));
ptrdiff_t idx = 0;
Lisp_Object bucket, tem, zero;
@@ -1931,10 +1935,12 @@ with a space are ignored unless STRING itself starts
with a space. */)
tem = Fcommandp (elt, Qnil);
else
{
- tem = type == 3
- ? call2 (predicate, elt,
- HASH_VALUE (XHASH_TABLE (collection), idx - 1))
- : call1 (predicate, elt);
+ if (type == 3)
+ tem = call2 (predicate, elt,
+ HASH_VALUE (XHASH_TABLE (collection),
+ idx - 1));
+ else
+ tem = call1 (predicate, elt);
}
if (NILP (tem)) continue;
}
diff --git a/src/nsterm.m b/src/nsterm.m
index f094b145fe3..faf9324402b 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -4739,12 +4739,15 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set
*writefds,
check_native_fs ();
#endif
- if (hold_event_q.nr > 0 && !run_loop_only)
+ /* If there are input events pending, store them so that Emacs can
+ recognize C-g. (And we must make sure [NSApp run] is called in
+ this function, so that C-g has a chance to land in
+ hold_event_q.) */
+ if (hold_event_q.nr > 0)
{
- /* We already have events pending. */
- raise (SIGIO);
- errno = EINTR;
- return -1;
+ for (int i = 0; i < hold_event_q.nr; ++i)
+ kbd_buffer_store_event_hold (&hold_event_q.q[i], NULL);
+ hold_event_q.nr = 0;
}
eassert (nfds <= FD_SETSIZE);
@@ -4754,11 +4757,15 @@ ns_select_1 (int nfds, fd_set *readfds, fd_set
*writefds,
if (writefds && FD_ISSET(k, writefds)) ++nr;
}
- if (NSApp == nil
- || ![NSThread isMainThread]
+ /* emacs -nw doesn't have an NSApp, so we're done. */
+ if (NSApp == nil)
+ return thread_select (pselect, nfds, readfds, writefds, exceptfds,
+ timeout, sigmask);
+
+ if (![NSThread isMainThread]
|| (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
- return thread_select (pselect, nfds, readfds, writefds,
- exceptfds, timeout, sigmask);
+ thread_select (pselect, nfds, readfds, writefds,
+ exceptfds, timeout, sigmask);
else
{
struct timespec t = {0, 0};
diff --git a/src/pdumper.c b/src/pdumper.c
index eae521c8a87..b4ac8d7fb3e 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2796,7 +2796,7 @@ dump_obarray (struct dump_context *ctx, Lisp_Object
object)
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_EBBA38AEFA
+#if CHECK_STRUCTS && !defined HASH_buffer_B02F648B82
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2808,6 +2808,7 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
else
eassert (buffer->window_count == -1);
buffer->local_minor_modes_ = Qnil;
+ buffer->last_name_ = Qnil;
buffer->last_selected_window_ = Qnil;
buffer->display_count_ = make_fixnum (0);
buffer->clip_changed = 0;
diff --git a/src/puresize.h b/src/puresize.h
index ac5d2da30dc..2a716872832 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -47,7 +47,7 @@ INLINE_HEADER_BEGIN
#endif
#ifndef BASE_PURESIZE
-#define BASE_PURESIZE (2750000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
+#define BASE_PURESIZE (3000000 + SYSTEM_PURESIZE_EXTRA +
SITELOAD_PURESIZE_EXTRA)
#endif
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
diff --git a/src/sfntfont-android.c b/src/sfntfont-android.c
index 94aedd0cd66..1ed394b9458 100644
--- a/src/sfntfont-android.c
+++ b/src/sfntfont-android.c
@@ -770,7 +770,7 @@ init_sfntfont_android (void)
build_string ("Roboto")),
Fcons (build_string ("DejaVu Serif"),
build_string ("Noto Serif")));
- else if (api_level >= 15)
+ else if (api_level >= 14)
/* Android 4.0 and later distribute Roboto in lieu of Droid
Sans. */
Vsfnt_default_family_alist
diff --git a/src/sqlite.c b/src/sqlite.c
index 7a018b28aa4..261080da673 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -349,9 +349,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
value = XCAR (values);
values = XCDR (values);
}
- Lisp_Object type = Ftype_of (value);
-
- if (EQ (type, Qstring))
+ if (STRINGP (value))
{
Lisp_Object encoded;
bool blob = false;
@@ -385,14 +383,11 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
SSDATA (encoded), SBYTES (encoded),
NULL);
}
- else if (EQ (type, Qinteger))
- {
- if (BIGNUMP (value))
- ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
- else
- ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
- }
- else if (EQ (type, Qfloat))
+ else if (FIXNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, XFIXNUM (value));
+ else if (BIGNUMP (value))
+ ret = sqlite3_bind_int64 (stmt, i + 1, bignum_to_intmax (value));
+ else if (FLOATP (value))
ret = sqlite3_bind_double (stmt, i + 1, XFLOAT_DATA (value));
else if (NILP (value))
ret = sqlite3_bind_null (stmt, i + 1);
diff --git a/src/w32.c b/src/w32.c
index df5465c2135..d34ab70f82d 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -10392,11 +10392,16 @@ check_windows_init_file (void)
}
}
+/* from w32fns.c */
+extern void remove_w32_kbdhook (void);
+
void
term_ntproc (int ignored)
{
(void)ignored;
+ remove_w32_kbdhook ();
+
term_timers ();
/* shutdown the socket interface if necessary */
diff --git a/src/w32console.c b/src/w32console.c
index 0936b5f37e6..7dcbc795cac 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -659,6 +659,24 @@ w32_face_attributes (struct frame *f, int face_id)
return char_attr;
}
+/* The IME window is needed to receive the session notifications
+ required to reset the low level keyboard hook state. */
+
+static BOOL CALLBACK
+find_ime_window (HWND hwnd, LPARAM arg)
+{
+ char window_class[32];
+
+ GetClassName (hwnd, window_class, sizeof (window_class));
+ if (strcmp (window_class, "IME") == 0)
+ {
+ *(HWND *) arg = hwnd;
+ return FALSE;
+ }
+ /* keep looking */
+ return TRUE;
+}
+
void
initialize_w32_display (struct terminal *term, int *width, int *height)
{
@@ -818,11 +836,14 @@ initialize_w32_display (struct terminal *term, int
*width, int *height)
else
w32_console_unicode_input = 0;
- /* Setup w32_display_info structure for this frame. */
+ /* Setup w32_display_info structure for this frame. */
w32_initialize_display_info (build_string ("Console"));
+ HWND hwnd = NULL;
+ EnumThreadWindows (GetCurrentThreadId (), find_ime_window, (LPARAM) &hwnd);
+
/* Set up the keyboard hook. */
- setup_w32_kbdhook ();
+ setup_w32_kbdhook (hwnd);
}
diff --git a/src/w32fns.c b/src/w32fns.c
index 8d4bd00b91c..ace8d1016a5 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -47,8 +47,16 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "w32inevt.h"
#ifdef WINDOWSNT
+/* mingw.org's MinGW headers mistakenly omit this enumeration: */
+# ifndef MINGW_W64
+typedef enum _WTS_VIRTUAL_CLASS {
+ WTSVirtualClientData,
+ WTSVirtualFileHandle
+} WTS_VIRTUAL_CLASS;
+# endif
#include <mbstring.h>
#include <mbctype.h> /* for _getmbcp */
+#include <wtsapi32.h> /* for WTS(Un)RegisterSessionNotification */
#endif /* WINDOWSNT */
#if CYGWIN
@@ -204,6 +212,10 @@ typedef HRESULT (WINAPI * SetWindowTheme_Proc)
typedef HRESULT (WINAPI * DwmSetWindowAttribute_Proc)
(HWND hwnd, DWORD dwAttribute, IN LPCVOID pvAttribute, DWORD cbAttribute);
+typedef BOOL (WINAPI * WTSRegisterSessionNotification_Proc)
+ (HWND hwnd, DWORD dwFlags);
+typedef BOOL (WINAPI * WTSUnRegisterSessionNotification_Proc) (HWND hwnd);
+
TrackMouseEvent_Proc track_mouse_event_fn = NULL;
ImmGetCompositionString_Proc get_composition_string_fn = NULL;
ImmGetContext_Proc get_ime_context_fn = NULL;
@@ -220,6 +232,8 @@ IsDebuggerPresent_Proc is_debugger_present = NULL;
SetThreadDescription_Proc set_thread_description = NULL;
SetWindowTheme_Proc SetWindowTheme_fn = NULL;
DwmSetWindowAttribute_Proc DwmSetWindowAttribute_fn = NULL;
+WTSUnRegisterSessionNotification_Proc WTSUnRegisterSessionNotification_fn =
NULL;
+WTSRegisterSessionNotification_Proc WTSRegisterSessionNotification_fn = NULL;
extern AppendMenuW_Proc unicode_append_menu;
@@ -291,10 +305,12 @@ static unsigned int sound_type = 0xFFFFFFFF;
/* Special virtual key code for indicating "any" key. */
#define VK_ANY 0xFF
-#ifndef WM_WTSSESSION_CHANGE
+#ifdef WINDOWSNT
+# ifndef WM_WTSSESSION_CHANGE
/* 32-bit MinGW does not define these constants. */
-# define WM_WTSSESSION_CHANGE 0x02B1
-# define WTS_SESSION_LOCK 0x7
+# define WM_WTSSESSION_CHANGE 0x02B1
+# define WTS_SESSION_LOCK 0x7
+# endif
#endif
#ifndef WS_EX_NOACTIVATE
@@ -307,6 +323,7 @@ static struct
int hook_count; /* counter, if several windows are created */
HHOOK hook; /* hook handle */
HWND console; /* console window handle */
+ HWND notified_wnd; /* window that receives session notifications */
int lwindown; /* Left Windows key currently pressed (and hooked) */
int rwindown; /* Right Windows key currently pressed (and hooked) */
@@ -2744,7 +2761,7 @@ funhook (int code, WPARAM w, LPARAM l)
/* Set up the hook; can be called several times, with matching
remove_w32_kbdhook calls. */
void
-setup_w32_kbdhook (void)
+setup_w32_kbdhook (HWND hwnd)
{
kbdhook.hook_count++;
@@ -2800,6 +2817,15 @@ setup_w32_kbdhook (void)
/* Set the hook. */
kbdhook.hook = SetWindowsHookEx (WH_KEYBOARD_LL, funhook,
GetModuleHandle (NULL), 0);
+
+ /* Register session notifications so we get notified about the
+ computer being locked. */
+ kbdhook.notified_wnd = NULL;
+ if (hwnd != NULL && WTSRegisterSessionNotification_fn != NULL)
+ {
+ WTSRegisterSessionNotification_fn (hwnd, NOTIFY_FOR_THIS_SESSION);
+ kbdhook.notified_wnd = hwnd;
+ }
}
}
@@ -2811,7 +2837,11 @@ remove_w32_kbdhook (void)
if (kbdhook.hook_count == 0 && w32_kbdhook_active)
{
UnhookWindowsHookEx (kbdhook.hook);
+ if (kbdhook.notified_wnd != NULL
+ && WTSUnRegisterSessionNotification_fn != NULL)
+ WTSUnRegisterSessionNotification_fn (kbdhook.notified_wnd);
kbdhook.hook = NULL;
+ kbdhook.notified_wnd = NULL;
}
}
#endif /* WINDOWSNT */
@@ -2884,13 +2914,12 @@ check_w32_winkey_state (int vkey)
}
return 0;
}
-#endif /* WINDOWSNT */
/* Reset the keyboard hook state. Locking the workstation with Win-L
leaves the Win key(s) "down" from the hook's point of view - the
keyup event is never seen. Thus, this function must be called when
the system is locked. */
-static void
+void
reset_w32_kbdhook_state (void)
{
kbdhook.lwindown = 0;
@@ -2900,6 +2929,7 @@ reset_w32_kbdhook_state (void)
kbdhook.suppress_lone = 0;
kbdhook.winseen = 0;
}
+#endif /* WINDOWSNT */
/* GetKeyState and MapVirtualKey on Windows 95 do not actually distinguish
between left and right keys as advertised. We test for this
@@ -4129,6 +4159,47 @@ deliver_wm_chars (int do_translate, HWND hwnd, UINT msg,
UINT wParam,
return 0;
}
+/* Maybe pass session notification registration to another frame. If
+ the frame with window handle HWND is deleted, we must pass the
+ notifications to some other frame, if they have been sent to this
+ frame before and have not already been passed on. If there is no
+ other frame, do nothing. */
+
+#ifdef WINDOWSNT
+static void
+maybe_pass_notification (HWND hwnd)
+{
+ if (hwnd == kbdhook.notified_wnd
+ && kbdhook.hook_count > 0 && w32_kbdhook_active)
+ {
+ Lisp_Object tail, frame;
+ struct frame *f;
+ bool found_frame = false;
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ f = XFRAME (frame);
+ if (FRAME_W32_P (f) && FRAME_OUTPUT_DATA (f) != NULL
+ && FRAME_W32_WINDOW (f) != hwnd)
+ {
+ found_frame = true;
+ break;
+ }
+ }
+
+ if (found_frame && WTSUnRegisterSessionNotification_fn != NULL
+ && WTSRegisterSessionNotification_fn != NULL)
+ {
+ /* There is another frame, pass on the session notification. */
+ HWND next_wnd = FRAME_W32_WINDOW (f);
+ WTSUnRegisterSessionNotification_fn (hwnd);
+ WTSRegisterSessionNotification_fn (next_wnd, NOTIFY_FOR_THIS_SESSION);
+ kbdhook.notified_wnd = next_wnd;
+ }
+ }
+}
+#endif /* WINDOWSNT */
+
/* Main window procedure */
static LRESULT CALLBACK
@@ -5301,23 +5372,29 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam,
LPARAM lParam)
#ifdef WINDOWSNT
case WM_CREATE:
- setup_w32_kbdhook ();
+ setup_w32_kbdhook (hwnd);
goto dflt;
#endif
case WM_DESTROY:
#ifdef WINDOWSNT
+ maybe_pass_notification (hwnd);
remove_w32_kbdhook ();
#endif
CoUninitialize ();
return 0;
+#ifdef WINDOWSNT
case WM_WTSSESSION_CHANGE:
if (wParam == WTS_SESSION_LOCK)
reset_w32_kbdhook_state ();
goto dflt;
+#endif
case WM_CLOSE:
+#ifdef WINDOWSNT
+ maybe_pass_notification (hwnd);
+#endif
wmsg.dwModifiers = w32_get_modifiers ();
my_post_msg (&wmsg, hwnd, msg, wParam, lParam);
return 0;
@@ -11335,6 +11412,14 @@ globals_of_w32fns (void)
set_thread_description = (SetThreadDescription_Proc)
get_proc_addr (hm_kernel32, "SetThreadDescription");
+#ifdef WINDOWSNT
+ HMODULE wtsapi32_lib = LoadLibrary ("wtsapi32.dll");
+ WTSRegisterSessionNotification_fn = (WTSRegisterSessionNotification_Proc)
+ get_proc_addr (wtsapi32_lib, "WTSRegisterSessionNotification");
+ WTSUnRegisterSessionNotification_fn = (WTSUnRegisterSessionNotification_Proc)
+ get_proc_addr (wtsapi32_lib, "WTSUnRegisterSessionNotification");
+#endif
+
/* Support OS dark mode on Windows 10 version 1809 and higher.
See `w32_applytheme' which uses appropriate APIs per version of Windows.
For future wretches who may need to understand Windows build numbers:
diff --git a/src/w32term.h b/src/w32term.h
index 29ace0b2797..3120c8bd71f 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -779,8 +779,9 @@ extern bool w32_image_rotations_p (void);
#ifdef WINDOWSNT
/* Keyboard hooks. */
-extern void setup_w32_kbdhook (void);
+extern void setup_w32_kbdhook (HWND);
extern void remove_w32_kbdhook (void);
+extern void reset_w32_kbdhook_state (void);
extern int check_w32_winkey_state (int);
#define w32_kbdhook_active (os_subtype != OS_SUBTYPE_9X)
#else
diff --git a/src/w32xfns.c b/src/w32xfns.c
index fa7d5fbdb61..b248697e658 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -23,6 +23,20 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <windows.h>
#include <windowsx.h>
+#ifdef WINDOWSNT
+/* Override API version to get the required functionality. */
+# undef _WIN32_WINNT
+# define _WIN32_WINNT 0x0501
+/* mingw.org's MinGW headers mistakenly omit this enumeration: */
+# ifndef MINGW_W64
+typedef enum _WTS_VIRTUAL_CLASS {
+ WTSVirtualClientData,
+ WTSVirtualFileHandle
+} WTS_VIRTUAL_CLASS;
+# endif
+#include <wtsapi32.h> /* for WM_WTSSESSION_CHANGE, WTS_SESSION_LOCK */
+#endif /* WINDOWSNT */
+
#include "lisp.h"
#include "frame.h"
#include "w32term.h"
@@ -413,8 +427,18 @@ drain_message_queue (void)
while (PeekMessage (&msg, NULL, 0, 0, PM_REMOVE))
{
- if (msg.message == WM_EMACS_FILENOTIFY)
- retval = 1;
+ switch (msg.message)
+ {
+#ifdef WINDOWSNT
+ case WM_WTSSESSION_CHANGE:
+ if (msg.wParam == WTS_SESSION_LOCK)
+ reset_w32_kbdhook_state ();
+ break;
+#endif
+ case WM_EMACS_FILENOTIFY:
+ retval = 1;
+ break;
+ }
TranslateMessage (&msg);
DispatchMessage (&msg);
}
diff --git a/src/window.c b/src/window.c
index ea761fad8bc..748ad9e77d4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7109,23 +7109,9 @@ current at the start of the function. If
DONT-SET-MINIWINDOW is non-nil,
the mini-window of the frame doesn't get set to the corresponding element
of CONFIGURATION.
-Normally, this function will try to delete any dead window in
-CONFIGURATION whose buffer has been deleted since CONFIGURATION was
-made. However, if the abnormal hook `window-kept-windows-functions' is
-non-nil, it will preserve such a window in the restored layout and show
-another buffer in it.
-
-After restoring the frame layout, this function runs the abnormal hook
-`window-kept-windows-functions' with two arguments - the frame whose
-layout it has restored and a list of entries for each window whose
-buffer has been found dead when it tried to restore CONFIGURATION: Each
-entry is a list of four elements <window, buffer, start, point> where
-`window' denotes the window whose buffer was found dead, `buffer'
-denotes the dead buffer, and `start' and `point' denote the last known
-positions of `window-start' and `window-point' of the buffer in that
-window. Any function run by this hook should check such a window for
-liveness because another function run by this hook may have deleted it
-in the meantime."
+This function consults the variable `window-restore-killed-buffer-windows'
+when restoring a window whose buffer was killed after CONFIGURATION was
+recorded.
If CONFIGURATION was made from a frame that is now deleted,
only frame-independent values can be restored. In this case,
@@ -7378,10 +7364,12 @@ the return value is nil. Otherwise the value is t. */)
BUF_PT (XBUFFER (w->contents)),
BUF_PT_BYTE (XBUFFER (w->contents)));
w->start_at_line_beg = true;
- if (!NILP (Vwindow_kept_windows_functions))
- kept_windows = Fcons (list4 (window, p->buffer,
+ if (FUNCTIONP (window_restore_killed_buffer_windows)
+ && !MINI_WINDOW_P (w))
+ kept_windows = Fcons (listn (6, window, p->buffer,
Fmarker_last_position (p->start),
- Fmarker_last_position (p->pointm)),
+ Fmarker_last_position (p->pointm),
+ p->dedicated, Qt),
kept_windows);
}
else if (!NILP (w->start))
@@ -7398,16 +7386,25 @@ the return value is nil. Otherwise the value is t. */)
set_marker_restricted_both (w->pointm, w->contents, 0, 0);
set_marker_restricted_both (w->old_pointm, w->contents, 0, 0);
w->start_at_line_beg = true;
- if (!NILP (w->dedicated))
- /* Record this window as dead. */
- dead_windows = Fcons (window, dead_windows);
- /* Make sure window is no more dedicated. */
- wset_dedicated (w, Qnil);
- if (!NILP (Vwindow_kept_windows_functions))
- kept_windows = Fcons (list4 (window, p->buffer,
- Fmarker_last_position (p->start),
- Fmarker_last_position (p->pointm)),
- kept_windows);
+ if (!MINI_WINDOW_P (w))
+ {
+ if (FUNCTIONP (window_restore_killed_buffer_windows))
+ kept_windows
+ = Fcons (listn (6, window, p->buffer,
+ Fmarker_last_position (p->start),
+ Fmarker_last_position (p->pointm),
+ p->dedicated, Qnil),
+ kept_windows);
+ else if (EQ (window_restore_killed_buffer_windows, Qdelete)
+ || (!NILP (p->dedicated)
+ && (NILP (window_restore_killed_buffer_windows)
+ || EQ (window_restore_killed_buffer_windows,
+ Qdedicated))))
+ /* Try to delete this window later. */
+ dead_windows = Fcons (window, dead_windows);
+ /* Make sure window is no more dedicated. */
+ wset_dedicated (w, Qnil);
+ }
}
}
@@ -7459,13 +7456,12 @@ the return value is nil. Otherwise the value is t. */)
unblock_input ();
/* Scan dead buffer windows. */
- if (!NILP (Vwindow_kept_windows_functions))
- for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
- {
- window = XCAR (dead_windows);
- if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
- delete_deletable_window (window);
- }
+ for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
+ {
+ window = XCAR (dead_windows);
+ if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
+ delete_deletable_window (window);
+ }
/* Record the selected window's buffer here. The window should
already be the selected one from the call above. */
@@ -7513,9 +7509,9 @@ the return value is nil. Otherwise the value is t. */)
SAFE_FREE ();
- if (!NILP (Vrun_hooks) && !NILP (Vwindow_kept_windows_functions))
- run_hook_with_args_2 (Qwindow_kept_windows_functions, frame,
- kept_windows);
+ if (!NILP (Vrun_hooks) && FUNCTIONP (window_restore_killed_buffer_windows))
+ safe_calln (window_restore_killed_buffer_windows,
+ frame, kept_windows, Qconfiguration);
return FRAME_LIVE_P (f) ? Qt : Qnil;
}
@@ -8514,8 +8510,9 @@ syms_of_window (void)
DEFSYM (Qheader_line_format, "header-line-format");
DEFSYM (Qtab_line_format, "tab-line-format");
DEFSYM (Qno_other_window, "no-other-window");
- DEFSYM (Qwindow_kept_windows_functions,
- "window-kept-windows-functions");
+ DEFSYM (Qconfiguration, "configuration");
+ DEFSYM (Qdelete, "delete");
+ DEFSYM (Qdedicated, "dedicated");
DEFVAR_LISP ("temp-buffer-show-function", Vtemp_buffer_show_function,
doc: /* Non-nil means call as function to display a help buffer.
@@ -8673,27 +8670,61 @@ its buffer or its total or body size since the last
redisplay. Each
call is performed with the frame temporarily selected. */);
Vwindow_configuration_change_hook = Qnil;
- DEFVAR_LISP ("window-kept-windows-functions",
- Vwindow_kept_windows_functions,
- doc: /* Functions run after restoring a window configuration or
state.
-These functions are called by `set-window-configuration' and
-`window-state-put'. When the value of this variable is non-nil, these
-functions restore any window whose buffer has been deleted since the
-corresponding configuration or state was saved. Rather than deleting
-such a window, `set-window-configuration' and `window-state-put' show
-some live buffer in it.
-
-The value should be a list of functions that take two arguments. The
-first argument specifies the frame whose configuration has been
-restored. The second argument, if non-nil, specifies a list of entries
-for each window whose buffer has been found dead at the time
-'set-window-configuration' or `window-state-put' tried to restore it in
-that window. Each entry is a list of four values - the window whose
-buffer was found dead, the dead buffer, and the positions of start and
-point of the buffer in that window. Note that the window may be already
-dead since another function on this list may have deleted it in the
-meantime. */);
- Vwindow_kept_windows_functions = Qnil;
+ DEFVAR_LISP ("window-restore-killed-buffer-windows",
+ window_restore_killed_buffer_windows,
+ doc: /* Control restoring windows whose buffer was killed.
+This variable specifies how the functions `set-window-configuration' and
+`window-state-put' shall handle a window whose buffer has been killed
+since the corresponding configuration or state was recorded. Any such
+window may be live -- in which case it shows some other buffer -- or
+dead at the time one of these functions is called.
+
+By default, `set-window-configuration' leaves the window alone if it is
+live, while `window-state-put' deletes it. The following values can be
+used to override the default behavior for dead windows in the case of
+`set-window-configuration' and for dead and live windows in the case of
+`window-state-put'.
+
+ - t means to restore the window and show some other buffer in it.
+
+ - `delete' means to try to delete the window.
+
+ - `dedicated' means to try to delete the window if and only if it is
+ dedicated to its buffer.
+
+ - nil, the default, which means that `set-window-configuration' will
+ try to delete the window if and only if it is dedicated to its
+ buffer while `window-state-put' will unconditionally try to delete
+ it.
+
+ - a function means to restore the window and show some other buffer in
+ it, like if the value were t, but also to add an entry for that
+ window to a list that will be later passed as argument to that
+ function.
+
+If a window cannot be deleted (typically, because it is the last window
+on its frame), show another buffer in it.
+
+If the value is a function, it should take three arguments. The first
+argument specifies the frame whose windows have been restored. The
+third argument is the symbol `configuration' if the windows are
+restored by `set-window-configuration' and the symbol `state' if the
+windows are restored by `window-state-put'.
+
+The second argument specifies a list of entries for all windows whose
+previous buffers have been found dead at the time
+`set-window-configuration' or `window-state-put' tried to restore them
+(minibuffer windows are excluded). This means that the function
+specified by this variable may also delete windows which were found to
+be alive by `set-window-configuration'.
+
+Each entry is a list of six values: the window whose buffer was found
+dead, the dead buffer or its name, the positions of window-start and
+window-point of the buffer in that window, the dedicated state of the
+window as reported by `window-dedicated-p', and a boolean -- t if the
+window was live when `set-window-configuration' tried to restore it,
+and nil otherwise. */);
+ window_restore_killed_buffer_windows = Qnil;
DEFVAR_LISP ("recenter-redisplay", Vrecenter_redisplay,
doc: /* Non-nil means `recenter' redraws entire frame.
diff --git a/src/xdisp.c b/src/xdisp.c
index d03769e2a31..140d71129f3 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -4353,7 +4353,7 @@ compute_stop_pos (struct it *it)
an automatic composition, limit the search of composable
characters to that position. */
if (it->bidi_p && it->bidi_it.scan_dir < 0)
- stoppos = -1;
+ stoppos = bidi_level_start (it->bidi_it.resolved_level) - 1;
else if (!STRINGP (it->string)
&& it->cmp_it.stop_pos <= IT_CHARPOS (*it)
&& cmp_limit_pos > 0)
@@ -8712,9 +8712,8 @@ set_iterator_to_next (struct it *it, bool reseat_p)
ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
- /* Now we are scanning backward and don't know
- where to stop. */
- stop = -1;
+ /* Now we are scanning backward; figure out where to stop. */
+ stop = bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil, true);
}
@@ -8745,7 +8744,7 @@ set_iterator_to_next (struct it *it, bool reseat_p)
re-compute the stop position for composition. */
ptrdiff_t stop = it->end_charpos;
if (it->bidi_it.scan_dir < 0)
- stop = -1;
+ stop = bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, IT_CHARPOS (*it),
IT_BYTEPOS (*it), stop, Qnil,
true);
@@ -9190,7 +9189,9 @@ get_visually_first_element (struct it *it)
bytepos = IT_BYTEPOS (*it);
}
if (it->bidi_it.scan_dir < 0)
- stop = -1;
+ stop = STRINGP (it->string)
+ ? -1
+ : bidi_level_start (it->bidi_it.resolved_level) - 1;
composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, stop,
it->string, true);
}
@@ -9694,9 +9695,10 @@ next_element_from_buffer (struct it *it)
&& PT < it->end_charpos) ? PT : it->end_charpos;
}
else
- stop = it->bidi_it.scan_dir < 0 ? -1 : it->end_charpos;
- if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it),
- stop)
+ stop = it->bidi_it.scan_dir < 0
+ ? bidi_level_start (it->bidi_it.resolved_level) - 1
+ : it->end_charpos;
+ if (CHAR_COMPOSED_P (it, IT_CHARPOS (*it), IT_BYTEPOS (*it), stop)
&& next_element_from_composition (it))
{
return true;
diff --git a/src/xterm.c b/src/xterm.c
index c8a43785564..c0aef65ab66 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -7292,6 +7292,11 @@ x_sync_init_fences (struct frame *f)
&& dpyinfo->xsync_minor < 1))
return;
+ /* Suppress errors around XSyncCreateFence requests, since its
+ implementations on certain X servers erroneously reject valid
+ drawables, such as the frame's inner window. (bug#69762) */
+
+ x_catch_errors (dpyinfo->display);
output->sync_fences[0]
= XSyncCreateFence (FRAME_X_DISPLAY (f),
/* The drawable given below is only used to
@@ -7303,6 +7308,9 @@ x_sync_init_fences (struct frame *f)
= XSyncCreateFence (FRAME_X_DISPLAY (f),
FRAME_X_WINDOW (f),
False);
+ if (x_had_errors_p (dpyinfo->display))
+ output->sync_fences[1] = output->sync_fences[0] = None;
+ x_uncatch_errors_after_check ();
XChangeProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
dpyinfo->Xatom_net_wm_sync_fences, XA_CARDINAL,
@@ -32536,38 +32544,45 @@ Android does not support scroll bars at all. */);
DEFSYM (Qreally_fast, "really-fast");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
- doc: /* Which keys Emacs uses for the ctrl modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `ctrl' means use the Ctrl_L and Ctrl_R keysyms.
-The default is nil, which is the same as `ctrl'. */);
+ doc: /* Which modifer value Emacs reports when Ctrl is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Ctrl modifier (i.e. the keysym Ctrl_L or Ctrl_R) depressed, with nil or
+any other value equivalent to `ctrl'. */);
Vx_ctrl_keysym = Qnil;
DEFVAR_LISP ("x-alt-keysym", Vx_alt_keysym,
- doc: /* Which keys Emacs uses for the alt modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `alt' means use the Alt_L and Alt_R keysyms.
-The default is nil, which is the same as `alt'. */);
+ doc: /* Which modifer value Emacs reports when Alt is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Alt modifier (e.g. the keysym Alt_L or Alt_R, if the keyboard features a
+dedicated key for Meta) depressed, with nil or any other value
+equivalent to `alt'. */);
Vx_alt_keysym = Qnil;
DEFVAR_LISP ("x-hyper-keysym", Vx_hyper_keysym,
- doc: /* Which keys Emacs uses for the hyper modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `hyper' means use the Hyper_L and Hyper_R
-keysyms. The default is nil, which is the same as `hyper'. */);
+ doc: /* Which modifer value Emacs reports when Hyper is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Hyper modifier (i.e. the keysym Hyper_L or Hyper_R) depressed, with nil
+or any other value equivalent to `hyper'. */);
Vx_hyper_keysym = Qnil;
DEFVAR_LISP ("x-meta-keysym", Vx_meta_keysym,
- doc: /* Which keys Emacs uses for the meta modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `meta' means use the Meta_L and Meta_R keysyms.
-The default is nil, which is the same as `meta'. */);
+ doc: /* Which modifer value Emacs reports when Meta is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Meta modifier (e.g. the keysym Alt_L or Alt_R, when the keyboard does
+not feature a dedicated key for Meta) depressed, with nil or any other
+value equivalent to `meta'. */);
Vx_meta_keysym = Qnil;
DEFVAR_LISP ("x-super-keysym", Vx_super_keysym,
- doc: /* Which keys Emacs uses for the super modifier.
-This should be one of the symbols `ctrl', `alt', `hyper', `meta',
-`super'. For example, `super' means use the Super_L and Super_R
-keysyms. The default is nil, which is the same as `super'. */);
+ doc: /* Which modifer value Emacs reports when Super is depressed.
+This should be one of the symbols `ctrl', `alt', `hyper', `meta', or
+`super', representing a modifier to be reported for key events with the
+Super modifier (i.e. the keysym Super_L or Super_R) depressed, with nil
+or any other value equivalent to `super'. */);
Vx_super_keysym = Qnil;
DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout,
diff --git a/src/xwidget.c b/src/xwidget.c
index 58910459142..389c48ca7f5 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -22,7 +22,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "coding.h"
#include "xwidget.h"
-
#include "lisp.h"
#include "blockinput.h"
#include "dispextern.h"
@@ -379,6 +378,8 @@ fails. */)
/* Enable the developer extras. */
settings = webkit_web_view_get_settings (WEBKIT_WEB_VIEW
(xw->widget_osr));
g_object_set (G_OBJECT (settings), "enable-developer-extras", TRUE,
NULL);
+ g_object_set (G_OBJECT (settings), "enable-javascript",
+ (gboolean) (!xwidget_webkit_disable_javascript), NULL);
}
gtk_widget_set_size_request (GTK_WIDGET (xw->widget_osr), xw->width,
@@ -3972,6 +3973,13 @@ syms_of_xwidget (void)
doc: /* List of all xwidget views. */);
Vxwidget_view_list = Qnil;
+ DEFVAR_BOOL ("xwidget-webkit-disable-javascript",
xwidget_webkit_disable_javascript,
+ doc: /* If non-nil, disable execution of JavaScript in xwidget WebKit
widgets.
+Modifications to this setting do not take effect in existing WebKit
+widgets; kill all xwidget-webkit buffers for changes in this setting
+to take effect. */);
+ xwidget_webkit_disable_javascript = false;
+
Fprovide (intern ("xwidget-internal"), Qnil);
id_to_xwidget_map = CALLN (Fmake_hash_table, QCtest, Qeq,
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 7d3af25ea49..39ad735a789 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -68,7 +68,7 @@
(with-temp-buffer
(insert diary-string)
(icalendar-export-region (point-min) (point-max) file))
- (with-current-buffer (get-buffer "*icalendar-errors*")
+ (with-current-buffer "*icalendar-errors*"
(buffer-string))))
;; ======================================================================
diff --git a/test/lisp/emacs-lisp/comp-cstr-tests.el
b/test/lisp/emacs-lisp/comp-cstr-tests.el
index 991ab1f40eb..b823a190d5a 100644
--- a/test/lisp/emacs-lisp/comp-cstr-tests.el
+++ b/test/lisp/emacs-lisp/comp-cstr-tests.el
@@ -232,9 +232,8 @@ The arg is an alist of: type specifier -> expected type
specifier."
;; 92
((or string char-table bool-vector vector cons symbol number) .
(or number sequence symbol))
- ;; 93?
- ;; FIXME: I get `cons' rather than `list'?
- ;;((or null cons) . list)
+ ;; 93
+ ((or list (not null)) . t)
))
;;; comp-cstr-tests.el ends here
diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el
index b663fb365a8..7f7c798cde8 100644
--- a/test/lisp/emacs-lisp/pp-tests.el
+++ b/test/lisp/emacs-lisp/pp-tests.el
@@ -36,4 +36,34 @@
(ert-deftest test-indentation ()
(ert-test-erts-file (ert-resource-file "code-formats.erts")))
+(defun pp-tests--dimensions ()
+ (save-excursion
+ (let ((width 0)
+ (height 0))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (end-of-line)
+ (setq height (1+ height))
+ (setq width (max width (current-column)))
+ (forward-char 1))
+ (cons width height))))
+
+(ert-deftest pp-tests--cut-before ()
+ (with-temp-buffer
+ (lisp-data-mode)
+ (pp '(1 (quite-a-long-package-name
+ . [(0 10 0) ((avy (0 5 0))) "Quickly switch windows." tar
+ ((:url . "https://github.com/abo-abo/ace-window";)
+ (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com")
+ (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com"))
+ (:keywords "window" "location"))]))
+ (current-buffer))
+ ;; (message "Filled:\n%s" (buffer-string))
+ (let ((dimensions (pp-tests--dimensions)))
+ (should (< (car dimensions) 80))
+ (should (< (cdr dimensions) 8)))
+ (goto-char (point-min))
+ (while (search-forward "." nil t)
+ (should (not (eolp))))))
+
;;; pp-tests.el ends here.
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index a2fb0392727..d4b5919a1cc 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -243,7 +243,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
@@ -264,7 +264,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
@@ -289,7 +289,7 @@
(delete-region (point) (point-max))
(insert "/dcc get -")
(call-interactively #'completion-at-point)
- (with-current-buffer (get-buffer "*Completions*")
+ (with-current-buffer "*Completions*"
(goto-char (point-min))
(search-forward "-s")
(search-forward "-t"))
diff --git a/test/lisp/erc/erc-goodies-tests.el
b/test/lisp/erc/erc-goodies-tests.el
index c8fb0544a72..7cbaa39d3f7 100644
--- a/test/lisp/erc/erc-goodies-tests.el
+++ b/test/lisp/erc/erc-goodies-tests.el
@@ -167,15 +167,13 @@
'(fg:erc-color-face1 bg:erc-color-face1))
;; Masked in all black.
(erc-goodies-tests--assert-face
- 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1)
- '(erc-control-default-fg erc-control-default-bg))
+ 20 "BlackOnBlack" '(fg:erc-color-face1 bg:erc-color-face1) nil)
;; Explicit "default" code ignoerd.
(erc-goodies-tests--assert-face
- 34 "Default" '(erc-control-default-fg erc-control-default-bg)
+ 34 "Default" '(erc-default-face)
'(fg:erc-color-face1 bg:erc-color-face1))
(erc-goodies-tests--assert-face
- 43 "END" 'erc-default-face
- '(erc-control-default-bg erc-control-default-fg))))
+ 43 "END" 'erc-default-face nil)))
(when noninteractive
(erc-tests-common-kill-buffers)))
@@ -214,17 +212,124 @@
nil)
;; The inverse of `default' because reverse still in effect.
(erc-goodies-tests--assert-face
- 32 "ReversedDefault" '(erc-inverse-face erc-control-default-fg
- erc-control-default-bg)
+ 32 "ReversedDefault" '(erc-inverse-face erc-default-face)
'(fg:erc-color-face3 bg:erc-color-face13))
(erc-goodies-tests--assert-face
- 49 "NormalDefault" '(erc-control-default-fg
- erc-control-default-bg)
+ 49 "NormalDefault" '(erc-default-face)
'(erc-inverse-face fg:erc-color-face1 bg:erc-color-face1))
(erc-goodies-tests--assert-face
64 "END" 'erc-default-face
- '( erc-control-default-fg erc-control-default-bg
- fg:erc-color-face0 bg:erc-color-face0))))
+ '(fg:erc-color-face0 bg:erc-color-face0))))
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+;; This is meant to assert two behavioral properties:
+;;
+;; 1) The background is preserved when only a new foreground is
+;; defined, in accordance with this bit from the spec: "If only the
+;; foreground color is set, the background color stays the same."
+;; https://modern.ircdocs.horse/formatting#color
+;;
+;; 2) The same holds true for a new, lone foreground of 99. Rather
+;; than prepend `erc-default-face', this causes the removal of an
+;; existing foreground face and likewise doesn't clobber the
+;; existing background.
+(ert-deftest erc-controls-highlight/default-foreground ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c99 BlackOnYellow "
+ "\C-o END")
+ nil t)))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BlackOnYellow END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 36 (font-lock-face (bg:erc-color-face8
+ erc-default-face))
+ 36 40 (font-lock-face (erc-default-face)))))
+ (should (search-forward "BlackOnYellow"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil (cdr faces))
+ "yellow")))
+
+ ;; Redefine background color alongside default foreground.
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c99,07 BlackOnOrange "
+ "\C-o END")
+ nil t)))
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BlackOnOrange END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 36 (font-lock-face (bg:erc-color-face7
+ erc-default-face))
+ 36 40 (font-lock-face (erc-default-face)))))
+ (should (search-forward "BlackOnOrange"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil (cdr faces))
+ "orange")))) ; as opposed to white or black
+ (when noninteractive
+ (erc-tests-common-kill-buffers)))
+
+;; This merely asserts our current interpretation of "default faces":
+;; that they reflect the foreground and background exhibited by normal
+;; chat messages before any control-code formatting is applied (rather
+;; than, e.g., some sort of negation or no-op).
+(ert-deftest erc-controls-highlight/default-background ()
+ (should (eq t erc-interpret-controls-p))
+ (erc-tests-common-make-server-buf)
+ (with-current-buffer (erc--open-target "#chan")
+ (setq-local erc-interpret-mirc-color t)
+ (defvar erc-fill-column)
+ (let ((erc-fill-column 90))
+ (erc-display-message nil nil (current-buffer)
+ (erc-format-privmessage
+ "bob" (concat "BEGIN "
+ "\C-c03,08 GreenOnYellow "
+ "\C-c05,99 BrownOnWhite "
+ "\C-o END")
+ nil t)))
+ (forward-line -1)
+ (should (search-forward "<bob> " nil t))
+ (should (erc-tests-common-equal-with-props
+ (erc--remove-text-properties
+ (buffer-substring (point) (line-end-position)))
+ #("BEGIN GreenOnYellow BrownOnWhite END"
+ 0 6 (font-lock-face erc-default-face)
+ 6 21 (font-lock-face (fg:erc-color-face3
+ bg:erc-color-face8
+ erc-default-face))
+ 21 35 (font-lock-face (fg:erc-color-face5
+ erc-default-face))
+ 35 39 (font-lock-face (erc-default-face)))))
+ ;; Ensure the background is white or black, rather than yellow.
+ (should (search-forward "BrownOnWhite"))
+ (let ((faces (get-text-property (point) 'font-lock-face)))
+ (should (equal (face-background (car faces) nil `(,@(cdr faces) default))
+ (face-background 'default)))))
(when noninteractive
(erc-tests-common-kill-buffers)))
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 90b8aa99741..0d8861f2167 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -1349,7 +1349,7 @@
(should-not
(erc-server-process-alive
(should (get-buffer "#chan/irc.foonet.org"))))
- (with-current-buffer (get-buffer "#chan/irc.foonet.org")
+ (with-current-buffer "#chan/irc.foonet.org"
(should-not erc-server-connected)
(should (eq erc-server-process old-proc))
(erc-with-server-buffer
diff --git a/test/lisp/erc/erc-scenarios-services-misc.el
b/test/lisp/erc/erc-scenarios-services-misc.el
index ab4a97c5724..47d0bcff41a 100644
--- a/test/lisp/erc/erc-scenarios-services-misc.el
+++ b/test/lisp/erc/erc-scenarios-services-misc.el
@@ -186,7 +186,7 @@
(funcall expect 10 "Last login from")
(funcall expect 10 "Your new nickname is tester")))
- (with-current-buffer (get-buffer "#test")
+ (with-current-buffer "#test"
(funcall expect 10 "tester ")
(funcall expect 10 "was created on"))))
diff --git a/test/lisp/erc/erc-stamp-tests.el b/test/lisp/erc/erc-stamp-tests.el
index a49173ffa2f..5fee21ec28f 100644
--- a/test/lisp/erc/erc-stamp-tests.el
+++ b/test/lisp/erc/erc-stamp-tests.el
@@ -168,11 +168,11 @@
(put-text-property 0 (length msg) 'wrap-prefix 10 msg)
(erc-display-message nil nil (current-buffer) msg)))
(goto-char (point-min))
- ;; Space not added (treated as opaque string).
- (should (search-forward "msg one[" nil t))
- ;; Field covers stamp alone
+ ;; Leading space added as part of the stamp's field.
+ (should (search-forward "msg one [" nil t))
+ ;; Field covers stamp and space.
(should (eql ?e (char-before (field-beginning (point)))))
- ;; Vanity props extended
+ ;; Vanity props extended.
(should (get-text-property (field-beginning (point)) 'wrap-prefix))
(should (get-text-property (1+ (field-beginning (point))) 'wrap-prefix))
(should (get-text-property (1- (field-end (point))) 'wrap-prefix))
@@ -183,10 +183,10 @@
(erc-timestamp-right-column 20))
(let ((msg (erc-format-privmessage "bob" "tttt wwww oooo" nil t)))
(erc-display-message nil nil (current-buffer) msg)))
- ;; No hard wrap
- (should (search-forward "oooo[" nil t))
- ;; Field starts at format string (right bracket)
- (should (eql ?\[ (char-after (field-beginning (point)))))
+ ;; No hard wrap.
+ (should (search-forward "oooo [" nil t))
+ ;; Field starts at managed space before format string.
+ (should (eql ?\s (char-after (field-beginning (point)))))
(should (eql ?\n (char-after (field-end (point)))))))))
;; This concerns a proposed partial reversal of the changes resulting
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index 6809d9db41d..3e8ddef3731 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -382,7 +382,7 @@
(should-not (search-forward (rx (or "9" "10") ">") nil t)))))
(ert-info ("Query buffer")
- (with-current-buffer (get-buffer "bob")
+ (with-current-buffer "bob"
(goto-char erc-insert-marker)
(should (looking-at-p "bob@ServNet 14>"))
(goto-char erc-input-marker)
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
index 3c32719a052..6ff7af218c0 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-01-start.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<alic [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
index e2064b914c4..7d9822c80bc 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-02-right.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<alic [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero. [07:00]\n<al [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
index feaba85ec90..2d0e5a5965f 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<bob> [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
diff --git
a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
index ed1488c8595..e019e60bb26 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-post-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<bob> [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
diff --git
a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
index a3530a6c44d..615de982b1e 100644
--- a/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
+++ b/test/lisp/erc/resources/fill/snapshots/merge-wrap-indicator-pre-01.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero.[07:00]\n<bob> [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n\n[Sat Apr 1
2023]\n<bob> zero. [07:00]\n<bo [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
index c94629cf357..0228e716731 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-01-start.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc- [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
index 127c0b29bc9..9ab89041b53 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-02-right.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc- [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
index a9f3f1d1904..87ea4692d9d 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-03-left.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc- [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
index c94629cf357..0228e716731 100644
--- a/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
+++ b/test/lisp/erc/resources/fill/snapshots/monospace-04-reset.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc- [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n" 2 3 (erc--msg
datestamp erc--ts 0 field erc [...]
\ No newline at end of file
diff --git a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
index 754d7989cea..ae364accdea 100644
--- a/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
+++ b/test/lisp/erc/resources/fill/snapshots/spacing-01-mono.eld
@@ -1 +1 @@
-#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect.[00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This
buffer is for text.\n*** one two th [...]
\ No newline at end of file
+#("\n\n\n[Thu Jan 1 1970]\n*** This server is in debug mode and is logging
all user I/O. If you do not wish for everything you send to be readable by the
server owner(s), please disconnect. [00:00]\n<alice> bob: come, you are a
tedious fool: to the purpose. What was done to Elbow's wife, that he hath cause
to complain of? Come me to what was done to her.\n<bob> alice: Either your
unparagoned mistress is dead, or she's outprized by a trifle.\n<bob> This
buffer is for text.\n*** one two t [...]
\ No newline at end of file
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 7035c8b7773..1beeb77640c 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -48,12 +48,12 @@ Return first line of the output of (describe-function-1
FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-built-in ()
- (let ((regexp "a built-in function in .C source code")
+ (let ((regexp "a primitive-function in .C source code")
(result (help-fns-tests--describe-function 'mapcar)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-interactive-built-in ()
- (let ((regexp "an interactive built-in function in .C source code")
+ (let ((regexp "an interactive primitive-function in .C source code")
(result (help-fns-tests--describe-function 're-search-forward)))
(should (string-match regexp result))))
@@ -64,13 +64,13 @@ Return first line of the output of (describe-function-1
FUNC)."
(ert-deftest help-fns-test-lisp-defun ()
(let ((regexp (if (featurep 'native-compile)
- "a native-compiled Lisp function in .+subr\\.el"
- "a byte-compiled Lisp function in .+subr\\.el"))
+ "a subr-native-elisp in .+subr\\.el"
+ "a compiled-function in .+subr\\.el"))
(result (help-fns-tests--describe-function 'last)))
(should (string-match regexp result))))
(ert-deftest help-fns-test-lisp-defsubst ()
- (let ((regexp "a byte-compiled Lisp function in .+subr\\.el")
+ (let ((regexp "a compiled-function in .+subr\\.el")
(result (help-fns-tests--describe-function 'posn-window)))
(should (string-match regexp result))))
diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el
index 80142d6d6de..6a5f03e38a0 100644
--- a/test/lisp/image-tests.el
+++ b/test/lisp/image-tests.el
@@ -153,4 +153,148 @@
(image-rotate -154.5)
(should (equal image '(image :rotation 91.0)))))
+;;;; Transforming maps
+
+(ert-deftest image-create-image-with-map ()
+ "Test that `create-image' correctly adds :map and/or :original-map."
+ (skip-unless (display-images-p))
+ (let ((data "foo")
+ (map '(((circle (1 . 1) . 1) a)))
+ (original-map '(((circle (2 . 2) . 2) a)))
+ (original-map-other '(((circle (3 . 3) . 3) a))))
+ ;; Generate :original-map from :map.
+ (let* ((image (create-image data 'svg t :map map :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map)))
+ ;; Generate :map from :original-map.
+ (let* ((image (create-image
+ data 'svg t :original-map original-map :scale 0.5))
+ (got-map (image-property image :map)))
+ (should (equal got-map map)))
+ ;; Use :original-map if both it and :map are specified.
+ (let* ((image (create-image
+ data 'svg t :map map
+ :original-map original-map-other :scale 0.5))
+ (got-original-map (image-property image :original-map)))
+ (should (equal got-original-map original-map-other)))))
+
+(defun image-tests--map-equal (a b &optional tolerance)
+ "Return t if maps A and B have the same coordinates within TOLERANCE.
+Since image sizes calculations vary on different machines, this function
+allows for each image map coordinate in A to be within TOLERANCE to the
+corresponding coordinate in B. When nil, TOLERANCE defaults to 5."
+ (unless tolerance (setq tolerance 5))
+ (catch 'different
+ (cl-labels ((check-tolerance
+ (coord-a coord-b)
+ (unless (>= tolerance (abs (- coord-a coord-b)))
+ (throw 'different nil))))
+ (dotimes (i (length a))
+ (pcase-let ((`((,type-a . ,coords-a) ,_id ,_plist) (nth i a))
+ (`((,type-b . ,coords-b) ,_id ,_plist) (nth i b)))
+ (unless (eq type-a type-b)
+ (throw 'different nil))
+ (pcase-exhaustive type-a
+ ('rect
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cadr coords-a) (cadr coords-b))
+ (check-tolerance (cddr coords-a) (cddr coords-b)))
+ ('circle
+ (check-tolerance (caar coords-a) (caar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b))
+ (check-tolerance (cdar coords-a) (cdar coords-b)))
+ ('poly
+ (dotimes (i (length coords-a))
+ (check-tolerance (aref coords-a i) (aref coords-b i))))))))
+ t))
+
+(ert-deftest image--compute-map-and-original-map ()
+ "Test `image--compute-map' and `image--compute-original-map'."
+ (skip-unless (display-images-p))
+ (let* ((svg-string "<?xml version=\"1.0\" encoding=\"UTF-8\"
standalone=\"no\"?><svg width=\"125pt\" height=\"116pt\" viewBox=\"0.00 0.00
125.00 116.00\" xmlns=\"http://www.w3.org/2000/svg\";
xmlns:xlink=\"http://www.w3.org/1999/xlink\";><g transform=\"scale(1 1)
rotate(0) translate(4 112)\"><polygon fill=\"white\" stroke=\"transparent\"
points=\"-4,4 -4,-112 121,-112 121,4 -4,4\"/><a xlink:href=\"a\"><ellipse
fill=\"none\" stroke=\"black\" cx=\"27\" cy=\"-90\" rx=\"18\" ry=\"18\"/><text
[...]
+ (original-map
+ '(((circle (41 . 29) . 24) "a" (help-echo "A"))
+ ((rect (5 . 101) 77 . 149) "b" (help-echo "B"))
+ ((poly . [161 29 160 22 154 15 146 10 136 7 125 5 114 7 104 10 96
15 91 22 89 29 91 37 96 43 104 49 114 52 125 53 136 52 146 49 154 43 160 37])
"c" (help-echo "C"))))
+ (scaled-map
+ '(((circle (82 . 58) . 48) "a" (help-echo "A"))
+ ((rect (10 . 202) 154 . 298) "b" (help-echo "B"))
+ ((poly . [322 58 320 44 308 30 292 20 272 14 250 10 228 14 208 20
192 30 182 44 178 58 182 74 192 86 208 98 228 104 250 106 272 104 292 98 308 86
320 74]) "c" (help-echo "C"))))
+ (flipped-map
+ '(((circle (125 . 29) . 24) "a" (help-echo "A"))
+ ((rect (89 . 101) 161 . 149) "b" (help-echo "B"))
+ ((poly . [5 29 6 22 12 15 20 10 30 7 41 5 52 7 62 10 70 15 75 22
77 29 75 37 70 43 62 49 52 52 41 53 30 52 20 49 12 43 6 37]) "c" (help-echo
"C"))))
+ (rotated-map
+ '(((circle (126 . 41) . 24) "a" (help-echo "A"))
+ ((rect (6 . 5) 54 . 77) "b" (help-echo "B"))
+ ((poly . [126 161 133 160 140 154 145 146 148 136 150 125 148 114
145 104 140 96 133 91 126 89 118 91 112 96 106 104 103 114 102 125 103 136 106
146 112 154 118 160]) "c" (help-echo "C"))))
+ (scaled-rotated-flipped-map
+ '(((circle (58 . 82) . 48) "a" (help-echo "A"))
+ ((rect (202 . 10) 298 . 154) "b" (help-echo "B"))
+ ((poly . [58 322 44 320 30 308 20 292 14 272 10 250 14 228 20 208
30 192 44 182 58 178 74 182 86 192 98 208 104 228 106 250 104 272 98 292 86 308
74 320]) "c" (help-echo "C"))))
+ (image (create-image svg-string 'svg t :map scaled-rotated-flipped-map
+ :scale 2 :rotation 90 :flip t)))
+ ;; Test that `image--compute-original-map' correctly generates
+ ;; original-map when creating an already transformed image.
+ (should (image-tests--map-equal (image-property image :original-map)
+ original-map))
+ (setf (image-property image :flip) nil)
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :scale) 2)
+ (should (image-tests--map-equal (image--compute-map image)
+ scaled-map))
+ (setf (image-property image :scale) 1)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-equal (image--compute-map image)
+ rotated-map))
+ (setf (image-property image :rotation) 0)
+ (setf (image-property image :flip) t)
+ (should (image-tests--map-equal (image--compute-map image)
+ flipped-map))
+ (setf (image-property image :scale) 2)
+ (setf (image-property image :rotation) 90)
+ (should (image-tests--map-equal (image--compute-map image)
+ scaled-rotated-flipped-map))
+
+ ;; Uncomment to test manually by interactively transforming the
+ ;; image and checking the map boundaries by hovering them.
+
+ ;; (with-current-buffer (get-buffer-create "*test image map*")
+ ;; (erase-buffer)
+ ;; (insert-image image)
+ ;; (goto-char (point-min))
+ ;; (pop-to-buffer (current-buffer)))
+ ))
+
+(ert-deftest image-transform-map ()
+ "Test functions related to transforming image maps."
+ (let ((map '(((circle (4 . 3) . 2) "circle")
+ ((rect (3 . 6) 8 . 8) "rect")
+ ((poly . [6 11 7 13 2 14]) "poly")))
+ (width 10)
+ (height 15))
+ (should (equal (image--scale-map (copy-tree map t) 2)
+ '(((circle (8 . 6) . 4) "circle")
+ ((rect (6 . 12) 16 . 16) "rect")
+ ((poly . [12 22 14 26 4 28]) "poly"))))
+ (should (equal (image--rotate-map (copy-tree map t) 90 `(,width . ,height))
+ '(((circle (12 . 4) . 2) "circle")
+ ((rect (7 . 3) 9 . 8) "rect")
+ ((poly . [4 6 2 7 1 2]) "poly"))))
+ (should (equal (image--flip-map (copy-tree map t) t `(,width . ,height))
+ '(((circle (6 . 3) . 2) "circle")
+ ((rect (2 . 6) 7 . 8) "rect")
+ ((poly . [4 11 3 13 8 14]) "poly"))))
+ (let ((copy (copy-tree map t)))
+ (image--scale-map copy 2)
+ ;; Scale size because the map has been scaled.
+ (image--rotate-map copy 90 `(,(* 2 width) . ,(* 2 height)))
+ ;; Swap width and height because the map has been flipped.
+ (image--flip-map copy t `(,(* 2 height) . ,(* 2 width)))
+ (should (equal copy
+ '(((circle (6 . 8) . 4) "circle")
+ ((rect (12 . 6) 16 . 16) "rect")
+ ((poly . [22 12 26 14 28 4]) "poly")))))))
+
;;; image-tests.el ends here
diff --git a/test/lisp/net/eww-tests.el b/test/lisp/net/eww-tests.el
index bd00893d503..b83435e0bd9 100644
--- a/test/lisp/net/eww-tests.el
+++ b/test/lisp/net/eww-tests.el
@@ -33,7 +33,7 @@ body.")
"Evaluate BODY with a mock implementation of `eww-retrieve'.
This avoids network requests during our tests. Additionally, prepare a
temporary EWW buffer for our tests."
- (declare (indent 1))
+ (declare (indent 0))
`(cl-letf (((symbol-function 'eww-retrieve)
(lambda (url callback args)
(with-temp-buffer
@@ -48,6 +48,24 @@ temporary EWW buffer for our tests."
;;; Tests:
+(ert-deftest eww-test/display/html ()
+ "Test displaying a simple HTML page."
+ (eww-test--with-mock-retrieve
+ (let ((eww-test--response-function
+ (lambda (url)
+ (concat "Content-Type: text/html\n\n"
+ (format "<html><body><h1>Hello</h1>%s</body></html>"
+ url)))))
+ (eww "example.invalid")
+ ;; Check that the buffer contains the rendered HTML.
+ (should (equal (buffer-string) "Hello\n\n\nhttp://example.invalid/\n";))
+ (should (equal (get-text-property (point-min) 'face)
+ '(shr-text shr-h1)))
+ ;; Check that the DOM includes the `base'.
+ (should (equal (pcase (plist-get eww-data :dom)
+ (`(base ((href . ,url)) ,_) url))
+ "http://example.invalid/";)))))
+
(ert-deftest eww-test/history/new-page ()
"Test that when visiting a new page, the previous one goes into the history."
(eww-test--with-mock-retrieve
@@ -176,5 +194,54 @@ This sets `eww-before-browse-history-function' to
"http://one.invalid/";)))
(should (= eww-history-position 0)))))
+(ert-deftest eww-test/readable/toggle-display ()
+ "Test toggling the display of the \"readable\" parts of a web page."
+ (eww-test--with-mock-retrieve
+ (let* ((shr-width most-positive-fixnum)
+ (shr-use-fonts nil)
+ (words (string-join
+ (make-list
+ 20 "All work and no play makes Jack a dull boy.")
+ " "))
+ (eww-test--response-function
+ (lambda (_url)
+ (concat "Content-Type: text/html\n\n"
+ "<html><body>"
+ "<a>This is an uninteresting sentence.</a>"
+ "<div>"
+ words
+ "</div>"
+ "</body></html>"))))
+ (eww "example.invalid")
+ ;; Make sure EWW renders the whole document.
+ (should-not (plist-get eww-data :readable))
+ (should (string-prefix-p
+ "This is an uninteresting sentence."
+ (buffer-substring-no-properties (point-min) (point-max))))
+ (eww-readable 'toggle)
+ ;; Now, EWW should render just the "readable" parts.
+ (should (plist-get eww-data :readable))
+ (should (string-match-p
+ (concat "\\`" (regexp-quote words) "\n*\\'")
+ (buffer-substring-no-properties (point-min) (point-max))))
+ (eww-readable 'toggle)
+ ;; Finally, EWW should render the whole document again.
+ (should-not (plist-get eww-data :readable))
+ (should (string-prefix-p
+ "This is an uninteresting sentence."
+ (buffer-substring-no-properties (point-min) (point-max)))))))
+
+(ert-deftest eww-test/readable/default-readable ()
+ "Test that EWW displays readable parts of pages by default when applicable."
+ (eww-test--with-mock-retrieve
+ (let* ((eww-test--response-function
+ (lambda (_url)
+ (concat "Content-Type: text/html\n\n"
+ "<html><body>Hello there</body></html>")))
+ (eww-readable-urls '("://example\\.invalid/")))
+ (eww "example.invalid")
+ ;; Make sure EWW uses "readable" mode.
+ (should (plist-get eww-data :readable)))))
+
(provide 'eww-tests)
;; eww-tests.el ends here
diff --git a/test/lisp/net/shr-resources/blockquote.html
b/test/lisp/net/shr-resources/blockquote.html
new file mode 100644
index 00000000000..412caf8bae6
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.html
@@ -0,0 +1,2 @@
+<blockquote>Citation.</blockquote>
+<div>Reply.</div>
diff --git a/test/lisp/net/shr-resources/blockquote.txt
b/test/lisp/net/shr-resources/blockquote.txt
new file mode 100644
index 00000000000..8ed610b8ea2
--- /dev/null
+++ b/test/lisp/net/shr-resources/blockquote.txt
@@ -0,0 +1,3 @@
+ Citation.
+
+Reply.
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index 0c6e2c091bf..17138053450 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -29,30 +29,62 @@
(declare-function libxml-parse-html-region "xml.c")
-(defun shr-test (name)
- (with-temp-buffer
- (insert-file-contents (format (concat (ert-resource-directory) "/%s.html")
name))
- (let ((dom (libxml-parse-html-region (point-min) (point-max)))
- (shr-width 80)
- (shr-use-fonts nil))
- (erase-buffer)
- (shr-insert-document dom)
- (cons (buffer-substring-no-properties (point-min) (point-max))
- (with-temp-buffer
- (insert-file-contents
- (format (concat (ert-resource-directory) "/%s.txt") name))
- (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
- (replace-match (string (string-to-number (match-string 1) 16))
- t t))
- (buffer-string))))))
+(defun shr-test--rendering-check (name &optional context)
+ "Render NAME.html and compare it to NAME.txt.
+Raise a test failure if the rendered buffer does not match NAME.txt.
+Append CONTEXT to the failure data, if non-nil."
+ (let ((text-file (file-name-concat (ert-resource-directory) (concat name
".txt")))
+ (html-file (file-name-concat (ert-resource-directory) (concat name
".html")))
+ (description (if context (format "%s (%s)" name context) name)))
+ (with-temp-buffer
+ (insert-file-contents html-file)
+ (let ((dom (libxml-parse-html-region (point-min) (point-max)))
+ (shr-width 80)
+ (shr-use-fonts nil))
+ (erase-buffer)
+ (shr-insert-document dom)
+ (let ((result (buffer-substring-no-properties (point-min) (point-max)))
+ (expected
+ (with-temp-buffer
+ (insert-file-contents text-file)
+ (while (re-search-forward "%\\([0-9A-F][0-9A-F]\\)" nil t)
+ (replace-match (string (string-to-number (match-string 1)
16))
+ t t))
+ (buffer-string))))
+ (unless (equal result expected)
+ (ert-fail (list description result expected))))))))
+
+(defconst shr-test--rendering-extra-configs
+ '(("blockquote"
+ ;; Make sure blockquotes remain indented even when filling is
+ ;; disabled (bug#69555).
+ . ((shr-fill-text . nil))))
+ "Extra customizations which can impact rendering.
+This is a list of (NAME . SETTINGS) pairs. NAME is the basename of a
+set of txt/html files under shr-resources/, as passed to `shr-test'.
+SETTINGS is a list of (OPTION . VALUE) pairs that are interesting to
+validate for the NAME testcase.
+
+The `rendering' testcase will test NAME once without altering any
+settings, then once more for each (OPTION . VALUE) pair.")
(ert-deftest rendering ()
(skip-unless (fboundp 'libxml-parse-html-region))
(dolist (file (directory-files (ert-resource-directory) nil "\\.html\\'"))
- (let* ((name (replace-regexp-in-string "\\.html\\'" "" file))
- (result (shr-test name)))
- (unless (equal (car result) (cdr result))
- (should (not (list name (car result) (cdr result))))))))
+ (let* ((name (string-remove-suffix ".html" file))
+ (extra-options (alist-get name shr-test--rendering-extra-configs
+ nil nil 'string=)))
+ ;; Test once with default settings.
+ (shr-test--rendering-check name)
+ ;; Test once more for every extra option for this specific NAME.
+ (pcase-dolist (`(,option-sym ,option-val)
+ extra-options)
+ (let ((option-old (symbol-value option-sym)))
+ (set option-sym option-val)
+ (unwind-protect
+ (shr-test--rendering-check
+ name (format "with %s %s" option-sym option-val))
+ (set option-sym option-old)))))))
(ert-deftest use-cookies ()
(let ((shr-cookie-policy 'same-origin))
diff --git a/test/lisp/progmodes/csharp-mode-resources/indent.erts
b/test/lisp/progmodes/csharp-mode-resources/indent.erts
new file mode 100644
index 00000000000..a676ecc9728
--- /dev/null
+++ b/test/lisp/progmodes/csharp-mode-resources/indent.erts
@@ -0,0 +1,19 @@
+Code:
+ (lambda ()
+ (csharp-mode)
+ (indent-region (point-min) (point-max)))
+
+Point-Char: |
+
+Name: Don't consider closed statements as object initializers. (bug#69571)
+
+=-=
+public class Foo {
+ void Bar () {
+ var x = new X(); // [1]
+ for (;;) {
+ x();
+ } // [2]
+ }
+}
+=-=-=
diff --git a/test/lisp/progmodes/csharp-mode-tests.el
b/test/lisp/progmodes/csharp-mode-tests.el
new file mode 100644
index 00000000000..f50fabf5836
--- /dev/null
+++ b/test/lisp/progmodes/csharp-mode-tests.el
@@ -0,0 +1,30 @@
+;;; csharp-mode-tests.el --- Tests for CC Mode C# mode -*- lexical-binding:
t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+(require 'csharp-mode)
+
+(ert-deftest csharp-mode-test-indentation ()
+ (ert-test-erts-file (ert-resource-file "indent.erts")))
+
+(provide 'csharp-mode-tests)
+;;; csharp-mode-tests.el ends here
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 1ceee690cfb..e11440cdb5b 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -4783,6 +4783,7 @@ def foo():
(python-tests-with-temp-buffer-with-shell
""
(python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims)
(insert "import abc")
(comint-send-input)
(python-tests-shell-wait-for-prompt)
@@ -4797,6 +4798,7 @@ def foo():
""
(python-shell-completion-native-turn-on)
(python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims)
(insert "import abc")
(comint-send-input)
(python-tests-shell-wait-for-prompt)
@@ -4883,11 +4885,14 @@ def foo():
(python-tests-with-temp-buffer-with-shell
""
(python-shell-with-shell-buffer
- (python-shell-completion-native-turn-on)
- (skip-unless (string= python-shell-readline-completer-delims ""))
- (python-tests--completion-module)
- (python-tests--completion-parameters)
- (python-tests--completion-extra-context)))))
+ (skip-unless (string= python-shell-readline-completer-delims ""))
+ (python-shell-completion-native-turn-off)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-shell-completion-native-turn-on)
+ (python-tests--completion-module)
+ (python-tests--completion-parameters)
+ (python-tests--completion-extra-context)))))
(ert-deftest python-shell-completion-at-point-ipython ()
"Check if Python shell completion works for IPython."
@@ -4924,6 +4929,8 @@ def foo():
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(goto-char (point-max))
@@ -4940,6 +4947,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(python-shell-with-shell-buffer
@@ -4959,6 +4968,8 @@ pdb.set_trace()
print('Hello')
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
(goto-char (point-max))
@@ -4975,6 +4986,8 @@ import time
time.sleep(3)
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-send-buffer)
(goto-char (point-max))
(insert "time.")
@@ -4987,6 +5000,8 @@ time.sleep(3)
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -5004,6 +5019,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -5020,6 +5037,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
@@ -5036,6 +5055,8 @@ import abc
import abc
"
(let ((inhibit-message t))
+ (python-shell-with-shell-buffer
+ (skip-unless python-shell-readline-completer-delims))
(python-shell-completion-native-turn-on)
(python-shell-send-buffer)
(python-tests-shell-wait-for-prompt)
diff --git a/test/lisp/sqlite-tests.el b/test/lisp/sqlite-tests.el
new file mode 100644
index 00000000000..d4892a27efc
--- /dev/null
+++ b/test/lisp/sqlite-tests.el
@@ -0,0 +1,51 @@
+;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'sqlite)
+
+(ert-deftest with-sqlite-transaction ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (sqlite-execute db "create table test (a)")
+ (should
+ (eql 42 (with-sqlite-transaction db
+ (sqlite-execute db "insert into test values (1)")
+ (should (equal '((1)) (sqlite-select db "select * from test")))
+ 42)))
+ ;; Body runs exactly once.
+ (should (equal '((1)) (sqlite-select db "select * from test")))))
+
+(ert-deftest with-sqlite-transaction/rollback ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (sqlite-execute db "create table test (a)")
+ (should (equal '(sqlite-error
+ ("SQL logic error" "no such function: fake" 1 1))
+ (should-error
+ (with-sqlite-transaction db
+ (sqlite-execute db "insert into test values (1)")
+ (sqlite-execute db "insert into test values (fake(2))")
+ 42))))
+ ;; First insertion (a=1) rolled back.
+ (should-not (sqlite-select db "select * from test"))))
+
+;;; sqlite-tests.el ends here
diff --git a/test/lisp/vc/vc-git-tests.el b/test/lisp/vc/vc-git-tests.el
index c52cd9c5875..bbf0c4277dd 100644
--- a/test/lisp/vc/vc-git-tests.el
+++ b/test/lisp/vc/vc-git-tests.el
@@ -24,6 +24,8 @@
;;; Code:
+(require 'ert-x)
+(require 'vc)
(require 'vc-git)
(ert-deftest vc-git-test-program-version-general ()
@@ -81,4 +83,49 @@
(should-not (vc-git-annotate-time))
(should-not (vc-git-annotate-time))))
+(defmacro vc-git-test--with-repo (name &rest body)
+ "Initialize a repository in a temporary directory and evaluate BODY.
+
+The current directory will be set to the top of that repository; NAME
+will be bound to that directory's file name. Once BODY exits, the
+directory will be deleted.
+
+Some dummy environment variables will be set for the duration of BODY to
+allow 'git commit' to determine identities for authors and committers."
+ (declare (indent 1))
+ `(ert-with-temp-directory ,name
+ (let ((default-directory ,name)
+ (process-environment (append '("EMAIL=john@doe.ee"
+ "GIT_AUTHOR_NAME=A"
+ "GIT_COMMITTER_NAME=C")
+ process-environment)))
+ (vc-create-repo 'Git)
+ ,@body)))
+
+(defun vc-git-test--run (&rest args)
+ "Run git ARGS…, check for non-zero status, and return output."
+ (with-temp-buffer
+ (apply 'vc-git-command t 0 nil args)
+ (buffer-string)))
+
+(ert-deftest vc-git-test-dir-track-local-branch ()
+ "Test that `vc-dir' works when tracking local branches. Bug#68183."
+ (skip-unless (executable-find vc-git-program))
+ (vc-git-test--with-repo repo
+ ;; Create an initial commit to get a branch started.
+ (write-region "hello" nil "README")
+ (vc-git-test--run "add" "README")
+ (vc-git-test--run "commit" "-mFirst")
+ ;; Get current branch name lazily, to remain agnostic of
+ ;; init.defaultbranch.
+ (let ((upstream-branch
+ (string-trim (vc-git-test--run "branch" "--show-current"))))
+ (vc-git-test--run "checkout" "--track" "-b" "hack" upstream-branch)
+ (vc-dir default-directory)
+ (pcase-dolist (`(,header ,value)
+ `(("Branch" "hack")
+ ("Tracking" ,upstream-branch)))
+ (goto-char (point-min))
+ (re-search-forward (format "^%s *: %s$" header value))))))
+
;;; vc-git-tests.el ends here
diff --git a/test/src/comp-resources/comp-test-funcs.el
b/test/src/comp-resources/comp-test-funcs.el
index dc4abf50767..54f339f6373 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -559,6 +559,9 @@
(let ((time (make-comp-test-time :unix (time-convert (current-time)
'integer))))
(comp-test-67239-0-f "%F" time)))
+(defun comp-test-67883-1-f ()
+ '#1=(1 . #1#))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index ad3b2071254..daa49e671b5 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -838,4 +838,39 @@ comparing the subr with a much slower Lisp implementation."
(dolist (sym (list nil t 'xyzzy (make-symbol "")))
(should (eq sym (bare-symbol (position-symbol sym 0)))))))
+(require 'cl-extra) ;For `cl--class-children'.
+
+(ert-deftest data-tests--cl-type-of ()
+ ;; Make sure that `cl-type-of' returns the most precise type.
+ ;; Note: This doesn't work for list/vector structs since those types
+ ;; are too difficult/unreliable to detect (so `cl-type-of' only says
+ ;; it's a `cons' or a `vector').
+ (dolist (val (list -2 10 (expt 2 128) nil t 'car
+ (symbol-function 'car)
+ (symbol-function 'progn)
+ (position-symbol 'car 7)))
+ (let* ((type (cl-type-of val))
+ (class (cl-find-class type))
+ (alltypes (cl--class-allparents class))
+ ;; FIXME: Our type DAG is affected by `symbols-with-pos-enabled'.
+ ;; (e.g. `symbolp' returns nil on a sympos if that var is nil).
+ (symbols-with-pos-enabled t))
+ (dolist (parent alltypes)
+ (should (cl-typep val parent))
+ (dolist (subtype (cl--class-children (cl-find-class parent)))
+ (unless (memq subtype alltypes)
+ (unless (memq subtype
+ ;; FIXME: Some types don't have any associated
+ ;; predicate,
+ '( font-spec font-entity font-object
+ finalizer condvar terminal
+ native-comp-unit interpreted-function
+ tree-sitter-compiled-query
+ tree-sitter-node tree-sitter-parser
+ ;; `functionp' also matches things of type
+ ;; `symbol' and `cons'.
+ function))
+ (should-not (cl-typep val subtype)))))))))
+
+
;;; data-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index fd0647275a0..052fd83dc85 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -315,7 +315,7 @@ local reference."
(replace-match "`src/emacs-module-resources/"))
(should (equal
(buffer-substring-no-properties 1 (point-max))
- (format "a module function in
`src/emacs-module-resources/mod-test%s'.
+ (format "a module-function in
`src/emacs-module-resources/mod-test%s'.
(mod-test-sum a b)